home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / sinmap.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-21  |  1KB  |  52 lines
  1.  
  2. program sinmap;
  3. { Source by Bas van Gaalen, Holland, PD }
  4. uses crt;
  5. const
  6.   gseg : word = $a000;
  7.   spd = 2; size = 3; curve = 125;
  8.   xmax = 150 div size;
  9.   ymax = 100 div size;
  10.   sofs = 50; samp = 10; slen = 255;
  11. var stab : array[0..slen] of word;
  12.  
  13. procedure csin; var i : byte; begin
  14.   for I := 0 to slen do stab[i] := round(sin(i*4*pi/slen)*samp)+sofs; end;
  15.  
  16. procedure displaymap;
  17. type scrarray = array[0..xmax,0..ymax] of byte;
  18. var
  19.   postab : array[0..xmax,0..ymax] of word;
  20.   bitmap : scrarray;
  21.   x,y,xp,yp,sidx : word;
  22. begin
  23.   fillchar(bitmap,sizeof(bitmap),0);
  24.   sidx := 0;
  25.   for x := 0 to xmax do
  26.     for y := 0 to (ymax div 3) do bitmap[x,y] := lightred;
  27.   for x := 0 to xmax do
  28.     for y := (ymax div 3) to 2*(ymax div 3) do bitmap[x,y] := white;
  29.   for x := 0 to xmax do
  30.     for y := 2*(ymax div 3) to ymax do bitmap[x,y] := lightblue;
  31.   repeat
  32.     while (port[$3da] and 8) <> 0 do;
  33.     while (port[$3da] and 8) = 0 do;
  34.     for x := 0 to xmax do
  35.       for y := ymax downto 0 do begin
  36.         mem[gseg:postab[x,y]] := 0;
  37.         xp := size*x+stab[(sidx+curve*x+curve*y) mod slen];
  38.         yp := size*y+stab[(sidx+4*x+curve*y+y) mod slen];
  39.         postab[x,y] := xp+yp*320;
  40.         mem[gseg:postab[x,y]] := bitmap[x,y];
  41.       end;
  42.     sidx := (sidx+spd) mod slen;
  43.   until keypressed;
  44. end;
  45.  
  46. begin
  47.   csin;
  48.   asm mov ax,13h; int 10h; end;
  49.   displaymap;
  50.   textmode(lastmode);
  51. end.
  52.