{ 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.