[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{$G+}
{ Simulador de Campo de Estrellas. Starfield Simulator
-------------------------------------|----------------------------
Tomas Laurenzo - tlaure@lsa.lsa.com.uy
Montevideo - Uruguay
DISCLAIMER: Same as usual, use it at your own risk.
COPYRIGHT: Use it freely, just remember _I_ coded it, BTW the '*' (Big
Bang Flower) routine will be in a demo i'm coding, and it's
dedicated to a girl nicknamed Kash, so if you use it, name
us in the credits, thanks. :)
DESCRIPTION:
This is a simple starfield simulator, with two or three simple routines
in it, press '?' for help (if you can actually read it >;) ), or just try
'4','5','0','+','-','*'.. i think that's all, check the code anyway.
I do use some routines that i've collected for quite awhile.
I think most of'em are from the SWAG files, and from the Asphyxia VGA
Trainer by Denthor... which helped me a lot, time ago.
Sorry, it's not fully optimized, but there are some routines that I do
not wont to make public yet ;)
Oh, the Big Bang flower in radar mode has a bug... some boxes appear where
they shouldn't.. help.
The 'speed < -2' bug is easily fixeable, but I like the 'good bye mon TV'
effect, and if fixed, the '*' routine would disappear :)
Any comments, suggestions, whatever, _please_ mail.
Sal£,
Tom.
P.S. Sorry again, it's not very commented, the procedural names are self
descriptive, but most of them are in spanish.
Anyway I think the code should be easy to understand. O:)
And please oversee my tarzan-style english ;)
^`§:;,.,;:§'^`§:;,.,;:§'^`§:;,.,;:§'^`§:;,.,;:§'^`§:;,.,;:§'^`§:;,.,;:§'^`§:;,.
}
PROGRAM Startrek; { Yeah, God save the enterprise! }
USES Crt;
CONST CantStars = 1000; { # of stars }
TYPE
Observador = RECORD
X : Word;
Y : Word;
Z : Word;
END;
Colores = (Blanco, Amarillo, Celeste, Violeta);
Estrella = RECORD
X,Y,Z : Word;
END;
Stars = ARRAY [0..CantStars] OF Estrella;
CONST
VGA = $A000;
Obs : Observador = (
X : 0;
Y : 0;
Z : 60
);
VAR
CosTable : ARRAY [0..1024] of Integer;
Color : Colores;
AnguloZ : Integer;
Vel : ShortInt;
I : Byte;
Campo : Stars;
Tecla : Char;
RotoZ,
Termina,
Borro : Boolean;
Cola : ARRAY [0..CantStars] OF RECORD
X1,Y1,
X2,Y2 : Integer;
END;
{............................................................................}
FUNCTION Coseno (Angulo : Integer): Integer; Assembler;
ASM
mov ax,Seg CosTable
mov es,ax
mov di,Offset CosTable
mov dx,Angulo
shl dx,1
add di,dx
mov ax,es:[di]
END;
{............................................................................}
PROCEDURE Proyecta (X, Y, Z :Integer;
VAR Xscr, Yscr : Word;
XCentro, YCentro : Integer);
BEGIN
IF Z >= Obs.Z THEN BEGIN
Xscr := 319;
Yscr := 200;
END
ELSE BEGIN
Xscr := XCentro + ((Obs.X * Z - X * Obs.Z) div (Z - Obs.Z));
Yscr := YCentro + ((Obs.Y * Z - Y * Obs.Z) div (Z - Obs.Z));
END;
END;
{............................................................................}
PROCEDURE MakeCosTable;
VAR
CntVal : Word;
CntAng : Real;
IncDeg : Real;
BEGIN
IncDeg := 2*PI/1024;
CntAng := IncDeg;
CntVal := 0;
REPEAT
CosTable [CntVal] := Round(255*cos(CntAng));
CntAng := CntAng+IncDeg;
Inc (CntVal);
UNTIL CntVal > 1024;
END;
{...........................................................................}
FUNCTION Seno (Angulo : Integer): Integer; Assembler;
ASM
mov ax,Seg CosTable
mov es,ax
mov di,Offset CosTable
mov dx,Angulo
mov bx,1024
add dx,256
cmp dx,bx
jle @@Ok
sub dx,1024
@@Ok:
shl dx,1
add di,dx
mov ax,es:[di]
END;
{............................................................................}
PROCEDURE Modo13h; Assembler;
ASM
MOV AX, 13h
INT 10h
{ MOV ah,0fh Si se quiere que el procedimiento devuelva un errcode
INT 10h se le agrega esto, se cambia el proc a func : word
XOR ah,ah y si no devuelve 13h ($13) es que no tiene VGA }
END;
{............................................................................}
PROCEDURE ModoTexto; Assembler;
ASM
MOV ax,03h
INT 10h
END;
{...........................................................................-}
PROCEDURE Retraso; Assembler;
ASM
mov dx,3DAh
@@1:
in al,dx
and al,08h
jnz @@1
@@2:
in al,dx
and al,08h
jz @@2
END;
{
BEGIN
WHILE (PORT[$3da] AND 8)<>0 DO;
WHILE (PORT[$3da] AND 8)=0 DO; { sta es la implementaci¢n pascal }
{ END;}
{............................................................................}
PROCEDURE Cls (Col : Byte; Where:word); assembler;
ASM
push es
mov cx, 32000;
mov es,[where]
xor di,di
mov al,[col]
mov ah,al
rep stosw
pop es
END;
{............................................................................}
PROCEDURE PutDot (X,Y : Integer; Color : Byte; SegDes:word); Assembler;
ASM
cmp X,0
jl @@END
cmp Y,0
jl @@END
cmp X,319
jg @@END
cmp Y,199
jg @@END
mov ax,SegDes
mov es,ax
mov al,Color
mov di,Y
mov bx,X
mov dx,di
xchg dh,dl
shl di,6
add di,dx
add di,bx
mov es:[di],al
@@END:
END;
{............................................................................}
PROCEDURE SeteaColor (Col,R,G,B : Byte); assembler;
ASM
mov dx,3c8h
mov al,[col]
out dx,al
inc dx
mov al,[r]
out dx,al
mov al,[g]
out dx,al
mov al,[b]
out dx,al
END;
{--------------------------------------------------------------------------}
PROCEDURE GeneroPaleta (Tipo : Colores);
VAR I : Byte;
BEGIN
SeteaColor (0,0,0,0);
CASE Tipo OF
Blanco : FOR I := 1 TO 255 DO SeteaColor (I,I,I,I);
Celeste : FOR I := 1 TO 255 DO SeteaColor (I,64,I,I);
Violeta : FOR I := 1 TO 255 DO SeteaColor (I,I,64,I);
Amarillo : FOR I := 1 TO 255 DO SeteaColor (I,I,I,64);
END;
END;
{--------------------------------------------------------------------------}
PROCEDURE GeneroEstrellas;
VAR J,
I : Integer;
BEGIN
FOR I := 0 TO CantStars DIV 6 DO BEGIN
Campo [I].X := Random (320)-160;
Campo [I].Y := Random (200)-100;
Campo [I].Z := 0;
Cola [I].X1 := Campo [I]. X;
Cola [I].Y1 := Campo [I]. Y;
END;
FOR I := 1 TO 5 DO
FOR J := (I * CantStars DIV 6) TO (CantStars DIV 6) * (I+1) -1
DO BEGIN
Campo [J].X := Random (320)-160;
Campo [J].Y := Random (200)-100;
Campo [J].Z := I * 10;
Cola [I].X1 := Campo [I]. X;
Cola [I].Y1 := Campo [I]. Y;
END;
END;
{--------------------------------------------------------------------------}
PROCEDURE EscriboEstrellas ;
VAR I : Integer;
X,Y : Word;
X1,Y1,Z1,
X2,Y2,Z2,
Xr,Yr,Zr : Integer;
BEGIN
CASE RotoZ OF
True : BEGIN
FOR I := 0 to CantStars DO BEGIN
X := Campo[I].X;
Y := Campo[I].Y;
Xr := (Coseno (AnguloZ) * X) div 256
-
(Seno (AnguloZ) * Y) div 256;
Yr := (Seno (AnguloZ) * X) div 256
+
(Coseno (AnguloZ) * Y) div 256;
{ Campo [I].X := Xr;
Campo [I].Y := Yr;}
Proyecta (Xr,
Yr,
Campo[I].Z,
X, Y,
160,100);
PutDot (X,Y,Campo[I].Z,VGA);
Cola [I].X1 := X;
Cola [I].Y1 := Y;
END;
IF AnguloZ > 1024 THEN AnguloZ := AnguloZ - 1024
ELSE Inc (AnguloZ,5);
END;
False : BEGIN
FOR I := 0 to CantStars DO BEGIN
Proyecta (Campo[I].X,
Campo[I].Y,
Campo[I].Z,
X, Y,
160,100);
PutDot (X,Y,Campo[I].Z,VGA);
Cola [I].X1 := X;
Cola [I].Y1 := Y;
END;
END;
END;
END;
{--------------------------------------------------------------------------}
PROCEDURE BorroEstrellas;
VAR I : Integer;
BEGIN
IF Borro THEN BEGIN
FOR I := 0 to CantStars DO BEGIN
PutDot (Cola [I].X1, Cola [I].Y1, 0, VGA);
PutDot (Cola [I].X2, Cola [I].Y2, 0, VGA);
END;
Borro := FALSE
END ELSE Borro := True;
END;
{--------------------------------------------------------------------------}
PROCEDURE MuevoEstrellas (Creo : Boolean);
VAR I : Integer;
BEGIN
FOR I := 0 TO CantStars DO BEGIN
Cola [I].X2 := Cola [I].X1;
Cola [I].Y2 := Cola [I].Y1;
{}IF Vel > 0 THEN BEGIN
IF (Cola [I].X1 > 0) and (Cola [I].Y1 > 0) and
(Cola [I].X1 < 320) and (Cola [I].Y1 < 200) and
(Campo [I].Z < Obs.Z) THEN Inc (Campo[I].Z,Vel)
ELSE BEGIN
IF Creo THEN BEGIN
Campo [I].X := Random (320)-160;
Campo [I].Y := Random (200)-100
END
ELSE BEGIN
Campo [I].X := 3000;
Campo [I].Y := 3000
END;
Campo [I].Z := 0;
END
{}END
ELSE BEGIN
IF Campo [I].Z > 0 THEN Inc (Campo[I].Z,Vel)
ELSE BEGIN
IF Creo THEN BEGIN
Campo [I].X := Random (320)-160;
Campo [I].Y := Random (200)-100
END
ELSE BEGIN
Campo [I].X := 3000;
Campo [I].Y := 3000
END;
Campo [I].Z := Obs.Z + 1
END
{}END
END
END;
{--------------------------------------------------------------------------}
PROCEDURE Bouncing; { Not really, it's the Big Bang Flower }
Var VT : ShortInt;
I : Byte;
J : Integer;
BEGIN
VT := Vel;
Vel := -1;
FOR I := 1 to 20 do BEGIN
FOR J := 0 to CantStars DO BEGIN
Campo [J].Z := Campo[J].Z -1 ;
END;
EscriboEstrellas;
END;
Vel := VT;
END;
{--------------------------------------------------------------------------}
PROCEDURE Lluvia; { Rain }
VAR J, I : Integer;
Pant : ARRAY [0..CantStars] OF RECORD X,Y,Z : Word; END;
FUNCTION HayPant : BOOLEAN;
VAR I : Integer; Hay : Boolean;
BEGIN
Hay := False;
FOR I := 0 to CantStars DO IF Pant[I].Y < 200 THEN Hay := True;
HayPant := Hay;
END;
PROCEDURE EscriboPant;
VAR I : Integer;
BEGIN FOR I := 0 to CantStars do PutDot (Pant[I].X,
Pant[I].Y,
Pant[I].Z,
VGA);
END;
PROCEDURE MuevoPant;
VAR I : Integer;
BEGIN FOR I := 0 to CantStars DO
IF Pant[I].Z > 10 THEN Pant[I].Y := Pant[I].Y + Pant[I].Z div 8
ELSE Pant[I].Y := Pant[I].Y +1 ;
END;
PROCEDURE BorroPant (Inc : ShortInt);
VAR I : Integer;
BEGIN FOR I := 0 to CantStars do PutDot (Pant[I].X,
Pant[I].Y+Inc,
0,
VGA);
END;
BEGIN
Cls (0,VGA);
FOR I := 0 to CantStars DO BEGIN
Proyecta (Campo[I].X,
Campo[I].Y,
Campo[I].Z,
Pant[I].X,
Pant[I].Y,
160,100);
Pant[I].Z := Campo[I].Z;
END;
WHILE HayPant DO BEGIN
EscriboPant;
Retraso;
BorroPant (0);
MuevoPant;
END;
END;
{--------------------------------------------------------------------------}
PROCEDURE Help;
PROCEDURE Escribo (S : String; Salto : Boolean);
VAR I : Byte;
BEGIN
GotoXY (40 - Length (S) DIV 2, WhereY);
FOR I := 1 TO Length (S) DO BEGIN
TextColor (Random (15)+1);
Write (S[I]);
END;
IF Salto THEN WriteLn;
END;
PROCEDURE Apagacursor; Assembler; { Sets the cursor off }
ASM
MOV AH, 02h
MOV BH, 0
MOV DH, 80
MOV DL, 25
INT 10h
END;
BEGIN
ModoTexto;
REPEAT
ClrScr;
Escribo ('Simulador de Campo de Estrellas',True);
Escribo ('(Starfield Simulator)',True);
Escribo ('---------------------------------',True);
Escribo ('1996 ú Tomas Laurenzo ú tlaure@lsa.lsa.com.uy',True);
WriteLn;
Escribo ('Teclas (keys):',True);
WriteLn;
Escribo (' ? : Esta pantalla ú This screen ',True);
Escribo (' + : Aumenta la velocidad ú Increases speed ',True);
Escribo (' - : Disminuye la velocidad ú Decreases speed ',True);
Escribo (' 0 : Rota los colores ú Rotate colors ',True);
Escribo (' 1 : Lluvia ú Rain ',True);
Escribo (' 5 : Modo radar ú Radar mode ',True);
Escribo (' 4 : Modo normal ú Normal mode ',True);
Escribo (' spc : Rebote ú Bounce ',True);
Escribo (' * : Flor de Big Bang ;) ú Big Bang Flower',True);
WriteLn;
Escribo ('Archivos (files):',True);
Escribo ('CAMPO.EXE | CAMPO.TXT',True);
WriteLn;
Escribo ('Tomas Laurenzo ú tlaure@lsa.lsa.com.uy ú Montevideo - Uruguay',True);
WriteLn; Escribo (' IF Speed < -1 THEN Quite_A_Bug (ON) a.k.a. Good Bye mon T.V.',True);
WriteLn;
Escribo ('^`§:;,.,;:§''^`§:;,.,;:§''^`§:;,.,;:§''^`§:;,.,;:§''^`§:;,.,;:§''^`§:;,.,;:§''^`§:;,.',False);
ApagaCursor;
Delay (500);
UNTIL keypressed;
ReadKey;
Modo13h;
GeneroPaleta (Color);
END;
{--------------------------------------------------------------------------
Principal
--------------------------------------------------------------------------}
{main}
BEGIN
Randomize;
MakeCosTable;
GeneroEstrellas;
AnguloZ := 0;
Modo13h;
GeneroPaleta (Blanco);
Cls (0,VGA);
Borro := False;
Vel := 1;
Termina := False;
REPEAT
EscriboEstrellas;
Retraso;
BorroEstrellas;
MuevoEstrellas(True);
IF KeyPressed THEN BEGIN
Tecla := ReadKey;
CASE Tecla OF
'?' : Help;
'+' : Inc (Vel);
'-' : Dec (Vel);
'0' : BEGIN
IF Color = Violeta THEN Color := Blanco
ELSE Inc (Color);
GeneroPaleta (Color)
END;
'1' : Lluvia;
'5' : RotoZ := True;
'4' : RotoZ := False;
' ' : Vel := - Vel;
'*' : BEGIN
WHILE NOT KEYPRESSED DO Bouncing;
CLS (0, VGA);
ReadKey;
END;
ELSE Termina := True;
END;
END;
UNTIL Termina;
IF Vel <> 0 THEN
FOR I := 0 TO 50 div Abs(Vel) DO BEGIN
EscriboEstrellas;
Retraso;
BorroEstrellas;
MuevoEstrellas(False);
END;
ModoTexto;
END.
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]