home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / GFXFX2.ZIP / SPRITES1.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-14  |  2KB  |  69 lines
  1.  
  2. program testsprites; { SPRITES1.PAS }
  3. { Sprites demo, version 1, by Bas van Gaalen }
  4. uses u_vga,u_pal,u_kb;
  5.  
  6. const
  7.   nofsprites=100;
  8.   spr:array[0..8*8-1] of byte=(
  9.     0,0,0,1,1,0,0,0,
  10.     0,1,1,2,2,1,1,0,
  11.     0,1,2,2,2,2,1,0,
  12.     1,2,2,2,2,2,2,1,
  13.     1,2,2,2,2,2,2,1,
  14.     0,1,2,2,2,2,1,0,
  15.     0,1,1,2,2,1,1,0,
  16.     0,0,0,1,1,0,0,0);
  17.  
  18. var
  19.   stab1,stab2:array[0..255] of integer;
  20.   virscr,bckscr:pointer;
  21.  
  22. procedure createsprite(nr:byte);
  23. begin
  24.   with sprite[nr] do begin
  25.     xpos:=0; ypos:=0;
  26.     xsize:=8; ysize:=8;
  27.     buf:=@spr;
  28.     seethru:=0;
  29.     transparant:=false;
  30.   end;
  31. end;
  32.  
  33. var idxarr1,idxarr2:array[1..maxsprites] of byte; i,j:word;
  34. begin
  35.   setvideo($13);
  36.   setrgb(1,20,20,30); setrgb(2,30,30,40);
  37.   for i:=3 to 252 do setrgb(i,i div 4,5+i div 5,10+i div 6);
  38.   for i:=1 to nofsprites do begin
  39.     createsprite(i);
  40.     idxarr1[i]:=i*4; idxarr2[i]:=50-i*6;
  41.   end;
  42.   for i:=0 to 255 do begin
  43.     stab1[i]:=round(sin(i*2*pi/255)*100)+100;
  44.     stab2[i]:=round(cos(i*2*pi/255)*50)+50;
  45.   end;
  46.   getmem(virscr,64000); cls(virscr,64000);
  47.   getmem(bckscr,64000); cls(bckscr,64000);
  48.   for i:=0 to 319 do for j:=0 to 199 do
  49.     mem[seg(bckscr^):j*320+i]:=3+(i+j) mod 250;
  50.   flip(bckscr,virscr,64000);
  51.   destenation:=virscr;
  52.   {u_border:=true;}
  53.   repeat
  54.     for i:=1 to nofsprites do begin
  55.       movesprabs(i,stab1[idxarr1[i]]+stab2[idxarr2[i]],20+(stab2[idxarr1[i]]+stab1[idxarr2[i]]) shr 1);
  56.       inc(idxarr1[i],1); inc(idxarr2[i],3);
  57.     end;
  58.     vretrace;
  59.     setborder(2);
  60.     for i:=1 to nofsprites do putback(bckscr,virscr,i);
  61.     for i:=1 to nofsprites do putsprite(i);
  62.     setborder(0);
  63.     flip(virscr,vidptr,64000);
  64.   until keypressed;
  65.   freemem(virscr,64000); freemem(bckscr,64000);
  66.   clearkeybuf;
  67.   setvideo(u_lm);
  68. end.
  69.