[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]