home *** CD-ROM | disk | FTP | other *** search
/ The Party 1994: Try This At Home / disk_image.bin / source / pixeltun / pixtun.pas < prev    next >
Pascal/Delphi Source File  |  1995-02-08  |  3KB  |  119 lines
  1.  
  2. {░▒▓████████████████████████████████████████████████████████████████▓▒░
  3. ░▒▓█                                                                █▓▒░
  4. ░▒▓█ PIXTUN.PAS - This source was coded by The Jerk of Hoaxers aka  █▓▒░
  5. ░▒▓█ Stian S¢reng in February 1995. If you have any questions about █▓▒░
  6. ░▒▓█ this source, email to: stians@interlink.no, 100% answer. (Bug  █▓▒░
  7. ░▒▓█ reports are welcome!) Boy, can this source be optimized !!!    █▓▒░
  8. ░▒▓█ Feel free to use it at any time, as long as you give me the    █▓▒░
  9. ░▒▓█ credits for it. Tested on 486SX/30: ok, 486DX2/66: fast and    █▓▒░
  10. ░▒▓█ 386SX/25 slow. Conclusion: Requires mcga and a 486.            █▓▒░
  11. ░▒▓█                                                         stians █▓▒░
  12.  ░▒▓████████████████████████████████████████████████████████████████▓▒░}
  13.  
  14. USES crt;
  15.  
  16. CONST Amount=30;        { number of circles }
  17.  
  18. VAR circles:array[1..360,1..Amount] of word;
  19.     ypts,xpts:array[1..90,1..Amount] of integer;
  20.     xsinus,ysinus:array[1..720] of integer;
  21.     sinptr,
  22.     xx,yy,
  23.     x,y,a:integer;
  24.     r:real;
  25.  
  26. PROCEDURE pal(c,r,g,b:byte);    { sets palette }
  27. begin
  28.      port[$3c8]:=c;
  29.      port[$3c9]:=r;
  30.      port[$3c9]:=g;
  31.      port[$3c9]:=b;
  32. end;
  33.  
  34. procedure sync;assembler;asm    { synchronize routine, wait for vblank }
  35.           mov dx,03dah
  36. @frame:   in al,dx
  37.           test al,8
  38.           jz @frame
  39. @besure:  in al,dx
  40.           test al,8
  41.           jnz @besure
  42.    end;
  43.  
  44. { ************************************************************************* }
  45.  
  46. BEGIN
  47.  
  48. { ** Precalculate circles ** }
  49.  
  50.      Writeln('Calculating, please wait..');
  51.  
  52.      for a:=1 to Amount do
  53.      begin
  54.      r:=0;
  55.           for x:=1 to 360 do
  56.           begin
  57.           r:=r+(0.0175)*4;
  58.           circles[x,a]:=round(sin(r)*(5+(a shl 2)))+(5+(a shl 2));
  59.           end;
  60.      end;
  61.  
  62. { ** Precalc x and y sinuses ** }
  63.  
  64.      r:=0;
  65.      for x:=1 to 720 do
  66.      begin
  67.           r:=r+0.0175;
  68.           xsinus[x]:=round(sin(r)*140)+140;
  69.           ysinus[x]:=round(cos(r)*90)+90;
  70.      end;
  71.  
  72. { ** Initialize 320x200x256 chunky mode ** }
  73.  
  74.      asm
  75.         mov ax,13h      { Using bitplanes, this routine would be MUCH }
  76.         int 10h         { faster, but a 256 colour pixtunnel is cooler }
  77.      end;
  78.  
  79. { ** Set grayscale palette ** }
  80.  
  81.      for a:=63 downto 0 do pal(a,a,a,a);
  82.      sinptr:=0;
  83.  
  84. { ** Main loop ** }
  85.  
  86.      repeat
  87.      sync;
  88.  
  89.      if sinptr>358 then sinptr:=0;      { loop sinus }
  90.      inc(sinptr,2);
  91.  
  92. { ** Draw and clear circles ** }
  93.  
  94.      for a:=1 to Amount do
  95.      for x:=1 to 90 do
  96.      begin
  97.          xx:=xpts[x,a];                 { store old pts }
  98.          yy:=ypts[x,a];
  99.          mem[$a000:xx+yy*320]:=0;       { clear old }
  100.          xx:=(circles[x,a]+xsinus[(a shl 3)+sinptr])-a*4;       { new pos }
  101.          yy:=(circles[x+23,a]+ysinus[sinptr+90+(a shl 2)])-(a*4);
  102.          if ((xx>0) AND (xx<319)) then           { check if inside bounds }
  103.          if ((yy>0) AND (yy<199)) then
  104.          begin
  105.          mem[$a000:xx+yy*320]:=a+5;             { put pixel }
  106.          xpts[x,a]:=xx;
  107.          ypts[x,a]:=yy;
  108.          end;
  109.      end;
  110.  
  111.      until keypressed;       { loop }
  112.  
  113. { ** Back to text mode ** }
  114.  
  115.      asm
  116.         mov ax,3h
  117.         int 10h
  118.      end;
  119. end.