home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / wormhole.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-28  |  2KB  |  66 lines
  1. {$r-,q-}
  2. program wormhole;
  3. { Wormhole (a-la '2nd Reality'), by Bas van Gaalen, Holland, PD }
  4. uses crt;
  5. const vidseg:word=$a000; divd=128; astep=5; xst=4; yst=5;
  6. var
  7.   sintab:array[0..449] of integer;
  8.   stab,ctab:array[0..255] of integer;
  9.   virscr:pointer;
  10.   virseg:word;
  11.   lstep:byte;
  12.  
  13. procedure setpal(col,r,g,b : byte); assembler; asm
  14.   mov dx,03c8h; mov al,col; out dx,al; inc dx; mov al,r
  15.   out dx,al; mov al,g; out dx,al; mov al,b; out dx,al; end;
  16.  
  17. procedure drawpolar(xo,yo,r,a:word; c:byte; lvseg:word);
  18. var x,y:word;
  19. begin
  20.   x:=160+xo+(r*sintab[90+a]) div (divd-20);
  21.   y:=100+yo+(r*sintab[a]) div divd;
  22.   if (x<320) and (y<200) then mem[lvseg:320*y+x]:=c;
  23. end;
  24.  
  25. procedure cls(lvseg:word); assembler; asm
  26.   mov es,[lvseg]; xor di,di; xor ax,ax; mov cx,320*200/2; rep stosw; end;
  27.  
  28. procedure flip(src,dst:word); assembler; asm
  29.   push ds; mov ax,[dst]; mov es,ax; mov ax,[src]; mov ds,ax
  30.   xor si,si; xor di,di; mov cx,320*200/2; rep movsw; pop ds; end;
  31.  
  32. var x,y,i,j:word; c:byte;
  33. begin
  34.   asm mov ax,13h; int 10h; end;
  35.   for i:=0 to 255 do begin
  36.     ctab[i]:=round(cos(pi*i/128)*60);
  37.     stab[i]:=round(sin(pi*i/128)*45);
  38.   end;
  39.   for i:=0 to 449 do sintab[i]:=round(sin(2*pi*i/360)*divd);
  40.   getmem(virscr,64000);
  41.   virseg:=seg(virscr^);
  42.   cls(virseg);
  43.   x:=30; y:=90;
  44.   repeat
  45.     {while (port[$3da] and 8) <> 0 do;
  46.     while (port[$3da] and 8) = 0 do;}
  47.     c:=19; lstep:=2; j:=10;
  48.     while j<220 do begin
  49.       i:=0;
  50.       while i<360 do begin
  51.         drawpolar(ctab[(x+(200-j)) mod 255],stab[(y+(200-j)) mod 255],j,i,c,virseg);
  52.         inc(i,astep);
  53.       end;
  54.       inc(j,lstep);
  55.       if (j mod 3)=0 then begin inc(lstep); inc(c); if c>31 then c:=31; end;
  56.     end;
  57.     x:=xst+x mod 255;
  58.     y:=yst+y mod 255;
  59.     flip(virseg,vidseg);
  60.     cls(virseg);
  61.   until keypressed;
  62.   while keypressed do readkey;
  63.   freemem(virscr,64000);
  64.   textmode(lastmode);
  65. end.
  66.