home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / fraczoom.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-18  |  2KB  |  77 lines
  1.  
  2. {$g+,n+,e-}
  3.  
  4. { Reals   :       -1     -0.1      0.3   -1.139
  5.   Complex :        0      0.8     -0.5    0.238 }
  6.  
  7. program Julia;
  8. { Julia Fractal, mode 13h. By Bas van Gaalen, Holland, PD
  9.   Compile it, and run from Dos. Let it calculate for a while, and then
  10.   enjoy the effect...
  11.   Make sure you have enough memory (384000 bytes) left! }
  12. uses
  13.   crt;
  14. const
  15.   max=6; { mem needed: 6*320*200=384000 bytes }
  16.   vidseg:word=$a000;
  17. type
  18.   real=double;
  19. var
  20.   virscr:array[0..max-1] of pointer;
  21.   virseg:array[0..max-1] of word;
  22.   heap:pointer;
  23.   cx,cy,xo,yo,x1,y1:real;
  24.   mx,my,a,b,i,orb:word;
  25.   zoom,n,dir:shortint;
  26.  
  27. procedure setpal(col,r,g,b : byte); assembler; asm
  28.   mov dx,03c8h; mov al,col; out dx,al; inc dx; mov al,r
  29.   out dx,al; mov al,g; out dx,al; mov al,b; out dx,al; end;
  30.  
  31. procedure retrace; assembler; asm
  32.   mov dx,03dah; @vert1: in al,dx; test al,8; jnz @vert1
  33.   @vert2: in al,dx; test al,8; jz @vert2; end;
  34.  
  35. begin
  36.   {write('Real part: '); readln(cx);} cx:=0.3;
  37.   {write('Imaginary part: '); readln(cy);} cy:=-0.5;
  38.   asm mov ax,13h; int 10h; end;
  39.   for i:=1 to 64 do setpal(i,10+i div 3,10+i div 3,15+round(i/1.306122449));
  40.   mark(heap);
  41.   for n:=0 to max-1 do begin
  42.     mx:=319; my:=199;
  43.     for a:=0 to mx do
  44.       for b:=0 to my do begin
  45.         zoom:=n-3;
  46.         xo:=-2-0.5*zoom+a/(mx/(4+zoom)); { x complex plane coordinate }
  47.         yo:=2+0.5*zoom-b/(my/(4+zoom)); { y complex plane coordinate }
  48.         orb:=0; i:=0;
  49.         repeat
  50.           x1:=xo*xo-yo*yo+cx;
  51.           y1:=2*xo*yo+cy;
  52.           xo:=x1;
  53.           yo:=y1;
  54.           inc(i);
  55.         until (i=64) or (x1*x1+y1*y1>4) or (abs(x1)>2) or (abs(y1)>2);
  56.         if i<>64 then orb:=i;
  57.         mem[vidseg:b*320+a]:=orb; { Plot orbit }
  58.       end;
  59.     getmem(virscr[n],320*200);
  60.     virseg[n]:=seg(virscr[n]^);
  61.     move(mem[vidseg:0],mem[virseg[n]:0],320*200);
  62.     {fillchar(mem[vidseg:0],320*200,0);}
  63.   end;
  64.  
  65.   { play ping pong }
  66.   n:=0; dir:=1;
  67.   repeat
  68.     retrace;
  69.     move(mem[virseg[n]:0],mem[vidseg:0],320*200);
  70.     inc(n,dir); if (n=max-1) or (n=0) then dir:=-dir;
  71.   until keypressed;
  72.  
  73.   while keypressed do readkey;
  74.   release(heap);
  75.   textmode(lastmode);
  76. end.
  77.