home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / GFXFX2.ZIP / STARS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-14  |  2.1 KB  |  71 lines
  1.  
  2. program _stars; { STARS.PAS }
  3. { Starry sky, based on something someone posted sometime somewhere,
  4.   by Bas van Gaalen }
  5. uses u_vga,u_pal,u_kb;
  6. const
  7.   f=6;
  8.   nofstars=100;
  9.   bitmask:array[boolean,0..4,0..4] of byte=(
  10.     ((0,0,1,0,0),
  11.      (0,0,3,0,0),
  12.      (1,3,6,3,1),
  13.      (0,0,3,0,0),
  14.      (0,0,1,0,0)),
  15.     ((0,0,6,0,0),
  16.      (0,0,3,0,0),
  17.      (6,3,1,3,6),
  18.      (0,0,3,0,0),
  19.      (0,0,6,0,0)));
  20.  
  21. type
  22.   starstruc=record
  23.     xp,                 { coordinates }
  24.     yp:word;
  25.     phase,              { fase in which the star can be found (bitmask) }
  26.     col:byte;           { color }
  27.     dur:shortint;       { speed of succesive steps }
  28.     active:boolean;     { is the star currently active or not? }
  29.   end;
  30.  
  31. var
  32.   stars:array[1..nofstars] of starstruc;
  33.  
  34. var i,x,y:word;
  35. begin
  36.   setvideo($13);
  37.   for i:=1 to 10 do begin
  38.     setrgb(i,f*i,0,0); setrgb(21-i,f*i,0,0); setrgb(20+i,0,0,0);
  39.     setrgb(30+i,0,f*i,0); setrgb(51-i,0,f*i,0); setrgb(50+i,0,0,0);
  40.     setrgb(60+i,0,0,f*i); setrgb(81-i,0,0,f*i); setrgb(80+i,0,0,0);
  41.     setrgb(90+i,f*i,f*i,0); setrgb(111-i,f*i,f*i,0); setrgb(110+i,0,0,0);
  42.     setrgb(120+i,0,f*i,f*i); setrgb(141-i,0,f*i,f*i); setrgb(140+i,0,0,0);
  43.     setrgb(150+i,f*i,f*i,f*i); setrgb(171-i,f*i,f*i,f*i); setrgb(170+i,0,0,0);
  44.   end;
  45.   randomize;
  46.   for i:=1 to nofstars do with stars[i] do begin
  47.     xp:=0; yp:=0; col:=0; phase:=0;
  48.     dur:=random(20);
  49.     active:=false;
  50.   end;
  51.   repeat
  52.     vretrace; vretrace;
  53.     for i:=1 to nofstars do with stars[i] do begin
  54.       dec(dur);
  55.       if (not active) and (dur<0) then begin
  56.         active:=true; phase:=0; col:=30*random(6);
  57.         xp:=random(315); yp:=random(195);
  58.       end;
  59.     end;
  60.     for i:=1 to nofstars do with stars[i] do
  61.       if active then begin
  62.         for x:=0 to 4 do for y:=0 to 4 do
  63.           if bitmask[(phase>10),x,y]>0 then
  64.             mem[u_vidseg:(yp+y)*320+xp+x]:=bitmask[(phase>10),x,y]+col+phase;
  65.         inc(phase);
  66.         if phase=21 then begin active:=false; dur:=random(20); end;
  67.       end;
  68.   until keypressed;
  69.   setvideo(u_lm);
  70. end.
  71.