[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]

    { Updated EGAVGA.SWG on May 26, 1995 }

    (*
    From: denthor@goth.vironix.co.za (Grant Smith)

    Scott Stone (Scott.Stone@m.cc.utah.edu) wrote:

    Your code is not too bad .. here is my version which is quite a bit faster,
    but uses assembler to acheive this... the stars also move in smaller
    increments, which makes them slightly smoother.

    :   for i:=0 to 63999 do
    :   begin
    :     mem[seg(p3^):i]:=0;
    :   end;

    Ouch! Even   fillchar (mem[seg(p3^):0, 64000, 0) would be much faster...
    loops are generally a bad plan ... you could gain quite a big speedup by
    converting this.

    : Procedure SwapPages;
    : Begin
    :   move(mem[seg(p2^):0],mem[$A000:0],64000);
    :   move(mem[seg(p3^):0],mem[seg(p2^):0],64000);
    : End;
    :     {Moves the data from the imaginary "page 2" to the visible page #1,}
    :     {Then moves the blank page 3 over to page 2, to start over.  this}
    :     {is how you do smooth animation.}

    You ony need one virtual page ... sort of say
    cls (virtual screen)
    draw (virtual screen)
    flip (virtual screen, vga)

    Here goes ... this source is from my trainer series, available on
    ftp.eng.ufl.edu pub/msdos/demos/code/graph/tutor

    Byeeeeee....
      - Denthor
    *)

    {$X+}
    USES crt;

    CONST Num = 400;     { Number of stars }
          VGA = $A000;

    TYPE Star = Record
                  x,y,z:integer;
                End;     { Information on each star }
         Pos = Record
                 x,y:integer;
               End;      { Information on each point to be plotted }
         Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
         VirtPtr = ^Virtual;                  { Pointer to the virtual screen }

    VAR Stars : Array [1..num] of star;
        Clear : Array [1..2,1..num] of pos;
        Virscr : VirtPtr;                     { Our first Virtual screen }
        Vaddr  : word;                        { The segment of our virtual screen}

    {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
    Procedure SetUpVirtual;
       { This sets up the memory needed for the virtual screen }
    BEGIN
      GetMem (VirScr,64000);
      vaddr := seg (virscr^);
    END;

    {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
    Procedure ShutDown;
       { This frees the memory used by the virtual screen }
    BEGIN
      FreeMem (VirScr,64000);
    END;

    {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
    Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
    BEGIN
      asm
         mov        ax,0013h
         int        10h
      end;
    END;

    {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
    Procedure SetText;  { This procedure returns you to text mode.  }
    BEGIN
      asm
         mov        ax,0003h
         int        10h
      end;
    END;

    {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
    Procedure Cls (Where:word;Col : Byte); assembler;
       { This clears the screen to the specified color }
    asm
       push    es
       mov     cx, 32000;
       mov     es,[where]
       xor     di,di
       mov     al,[col]
       mov     ah,al
       rep     stosw
       pop     es
    End;

    {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
    procedure flip(source,dest:Word); assembler;
      { This copies the entire screen at "source" to destination }
    asm
      push    ds
      mov     ax, [Dest]
      mov     es, ax
      mov     ax, [Source]
      mov     ds, ax
      xor     si, si
      xor     di, di
      mov     cx, 32000
      rep     movsw
      pop     ds
    end;

    {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
    procedure WaitRetrace; assembler;
      {  This waits for a vertical retrace to reduce snow on the screen }
    label
      l1, l2;
    asm
        mov dx,3DAh
    l1:
        in al,dx
        and al,08h
        jnz l1
    l2:
        in al,dx
        and al,08h
        jz  l2
    end;

    {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
    Procedure Pal(Col,R,G,B : Byte); assembler;
      { This sets the Red, Green and Blue values of a certain color }
    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 Putpixel (X,Y : Integer; Col : Byte; where:word); assembler;
      { This puts a pixel on the screen by writing directly to memory. }
    Asm
      mov     ax,[where]
      mov     es,ax
      mov     bx,[X]
      mov     dx,[Y]
      mov     di,bx
      mov     bx, dx                  {; bx = dx}
      shl     dx, 8
      shl     bx, 6
      add     dx, bx                  {; dx = dx + bx (ie y*320)}
      add     di, dx                  {; finalise location}
      mov     al, [Col]
      stosb
    End;

    {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
    Procedure Init;
    VAR loop1,loop2:integer;
    BEGIN
      for loop1:=1 to num do
        Repeat
          stars[loop1].x:=random (400)-200;
          stars[loop1].y:=random (400)-200;
          stars[loop1].z:=loop1;
        Until (stars[loop1].x<>0) and (stars[loop1].y<>0);
          { Make sure no stars are heading directly towards the viewer }
      pal (32,00,00,30);
      pal (33,10,10,40);
      pal (34,20,20,50);
      pal (35,30,30,60);   { Pallette for the stars coming towards you }
    END;

    {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
    Procedure Calcstars;
      { This calculates the 2-d coordinates of our stars and saves these values
        into the variable clear }
    VAR loop1,x,y:integer;
    BEGIN
      For loop1:=1 to num do BEGIN
        x:=((stars[loop1].x shl 7) div stars[loop1].z)+160;
        y:=((stars[loop1].y shl 7) div stars[loop1].z)+100;
        clear[1,loop1].x:=x;
        clear[1,loop1].y:=y;
      END;
    END;

    {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
    Procedure Drawstars;
      { This draws the 2-d values stored in clear to the vga screen, with various
        colors according to how far away it is. }
    VAR loop1,x,y:integer;
    BEGIN
      For loop1:=1 to num do BEGIN
        x:=clear[1,loop1].x;
        y:=clear[1,loop1].y;
        if (x>0) and (x<320) and (y>0) and (y<200) then
          putpixel(x,y,35-stars[loop1].z shr 7,vaddr)
      END;
    END;

    {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
    Procedure Clearstars;
      { This clears the 2-d values from the virtual screen, which is faster then a
        cls (vaddr,0) }
    VAR loop1,x,y:integer;
    BEGIN
      For loop1:=1 to num do BEGIN
        x:=clear[2,loop1].x;
        y:=clear[2,loop1].y;
        if (x>0) and (x<320) and (y>0) and (y<200) then
          putpixel (x,y,0,vaddr);
      END;
    END;

    {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
    Procedure MoveStars (Towards:boolean);
      { If towards is True, then the z-value of each star is decreased to come
        towards the viewer, otherwise the z-value is increased to go away from
        the viewer }
    VAR loop1:integer;
    BEGIN
      If towards then
        for loop1:=1 to num do BEGIN
          stars[loop1].z:=stars[loop1].z-2;
          if stars[loop1].z<1 then stars[loop1].z:=stars[loop1].z+num;
        END
        else
        for loop1:=1 to num do BEGIN
          stars[loop1].z:=stars[loop1].z+2;
          if stars[loop1].z>num then stars[loop1].z:=stars[loop1].z-num;
        END;
    END;

    {ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
    Procedure Play;
      { This is our main procedure }
    VAR ch:char;
    BEGIN
      Calcstars;
      Drawstars;  { This draws our stars for the first time }
      ch:=#0;
      cls (vaddr,0);
      Repeat
        if keypressed then ch:=readkey;
        clear[2]:=clear[1];
        Calcstars;     { Calculate new star positions }
        waitretrace;
        Clearstars;    { Erase old stars }
        Drawstars;     { Draw new stars }
        flip (vaddr,vga);
        if ch=' ' then Movestars(False) else Movestars(True);
          { Move stars towards or away from the viewer }
      Until ch=#27;
        { Until the escape key is pressed }
    END;

    BEGIN
      clrscr;
      writeln ('Hello! Another effect for you, this one is on starfields, again by');
      writeln ('request.  In this sample program, a starfield will be coming towards');
      writeln ('you. Hit the space bar to have it move away from you, any other key');
      writeln ('to have it come towards you again. Hit [ESC] to end.');
      writeln;
      writeln ('The code is very easy to follow, and the documentation is as usual in the');
      writeln ('main text. Leave me mail with further ideas for future trainers.');

      writeln;
      writeln;
      write ('Hit any key to continue ...');
      readkey;
      randomize;
      setmcga;
      setupvirtual;
      init;
      Play;
      settext;
      shutdown;
      Writeln ('All done. This concludes the thirteenth sample program in the ASPHYXIA');
      Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
      Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS. I am also an avid');
      Writeln ('Connectix BBS user, and occasionally read RSAProg. E-mail me at :');
      Writeln ('    denthor@beastie.cs.und.ac.za');
      Writeln ('The numbers are available in the main text. You may also write to me at:');
      Writeln ('             Grant Smith');
      Writeln ('             P.O. Box 270');
      Writeln ('             Kloof');
      Writeln ('             3640');
      Writeln ('             Natal');
      Writeln ('             South Africa');
      Writeln ('I hope to hear from you soon!');
      Writeln; Writeln;
      Write   ('Hit any key to exit ...');
      readkey;
    END.

[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]