home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / TUGU10.ZIP / FRACTAL.PAS < prev    next >
Pascal/Delphi Source File  |  1995-04-04  |  16KB  |  616 lines
  1. {$N+,E+}
  2.  
  3. Program FractalExplorer;
  4.  
  5. Uses tugu,jmouse,crt;
  6.  
  7. Label Beginning;
  8.  
  9. Const
  10.   mandtype = 2; { what power? }
  11.  
  12.  
  13. Type
  14.   unreal = extended;
  15.  
  16. Var
  17.   ftype : integer;
  18.   paltype : integer;
  19.   stdpal : palarray;
  20.   itterations : integer;
  21.   achar : char;
  22.  
  23.   xorg,yorg,xlim,ylim,
  24.   newxo,newyo,newxl,newyl : unreal;
  25.   xstart,ystart : unreal;           { used for julia set }
  26.  
  27.   mousexo,mouseyo,mousexl,mouseyl,
  28.   oldmxl,oldmyl,oldmxo,oldmyo : word;
  29.   tempxo,tempyo : word;
  30.  
  31.   i,j : integer;
  32.   a,b : word;
  33.   temp : byte;
  34.   stuff : string;
  35.   font : pointer;
  36.   waitfor0,waitfor1 : boolean;
  37.   rec : array [1..4,0..319] of byte;
  38.  
  39.   backcolor : byte;              { mouse variables }
  40.   curwidth, curheight : word;
  41.  { cursorptr,}lcursor : pointer;
  42.   buttons : byte;
  43.  
  44.   zoomout : array [0..10] of record
  45.               order : byte; { indicates # of zooms back }
  46.               ptr : pointer; { points to screen shot of picture }
  47.               x1,x2,y1,y2 : unreal; { coords for zoom window }
  48.             End;
  49.   zn : byte;  { indicates which zoom is being used }
  50.   maxzooms : integer;
  51.  
  52.   redrawfractal : boolean;
  53.   palnum : integer;
  54.   colnum : integer;
  55.   firstfractal : boolean;
  56.   pickjuliapoint : boolean;
  57.   fv : file;
  58.  
  59. Procedure SquareComplex(Var x,y,xp,yp : unreal); { xp,yp = current position }
  60.                                                  { in graph }
  61. Var
  62.                            { (x + yi)^2 = x^2 - y^2 + 2xyi }
  63. temp : unreal;
  64.  
  65. Begin
  66.   temp := x*x - y*y + xp;
  67.   y := 2 * x * y + yp;
  68.   x := temp;
  69. End;
  70.  
  71. Procedure ThirdComplex(Var x,y,xp,yp : unreal);
  72.  
  73. Var
  74.  
  75. temp : unreal;
  76.  
  77. Begin
  78.   temp := x*x*x - 3*y*y*x + xp;
  79.   y := -y*y*y + 3*x*x*y + yp;
  80.   x := temp;
  81. End;
  82.  
  83. Procedure ForthComplex(Var x,y,xp,yp : unreal); { xp,yp = current position }
  84.                                                 { on graph }
  85. Var
  86.                            { (x + yi)^4 = x^4 + y^4 - 6(x^2)(y^2) + }
  87. temp : unreal;             {              4(x^3)(y)i - 4(x)(y^3)i }
  88.  
  89. Begin
  90.   temp := x*x*x*x + y*y*y*y - 6*x*x*y*y + xp;
  91.   y := 4*x*x*x*y - 4*x*y*y*y + yp;
  92.   x := temp;
  93. End;
  94.  
  95. Procedure FifthComplex(Var x,y,xp,yp : unreal);
  96.  
  97. Var
  98.  
  99. temp : unreal;
  100.  
  101. Begin
  102.   temp := x*x*x*x*x - 10*x*x*x*y*y + 5*x*y*y*y*y + xp;
  103.   y := 5*x*x*x*x*y - 10*x*x*y*y*y + y*y*y*y*y + yp;
  104.   x := temp;
  105. End;
  106.  
  107. Procedure SixthComplex(Var x,y,xp,yp : unreal);
  108.  
  109. Var
  110.   temp : unreal;
  111.  
  112. Begin
  113.   temp := (x*x*x*x*x*x) + (15*x*x*y*y*y*y) - (15*x*x*x*x*y*y) - (y*y*y*y*y*y) + xp;
  114.   y := (6*x*y*y*y*y*y) - (20*x*x*x*y*y*y) + (6*x*x*x*x*x*y) + yp;
  115.   x := temp;
  116. End;
  117.  
  118. Procedure SeventhComplex(Var x,y,xp,yp : unreal);
  119.  
  120. Var
  121.  
  122. temp : unreal;
  123.  
  124. Begin
  125.   temp := x*x*x*x*x*x*x - 21*x*x*x*x*x*y*y + 35*x*x*x*y*y*y*y - 7*x*y*y*y*y*y*y + xp;
  126.   y := 7*x*x*x*x*x*x*y - 35*x*x*x*x*y*y*y + 21*x*x*y*y*y*y*y - y*y*y*y*y*y*y + yp;
  127.   x := temp;
  128. End;
  129.  
  130. Procedure EighthComplex(Var x,y,xp,yp : unreal);
  131.  
  132. Var
  133.   temp : unreal;
  134.  
  135. Begin
  136.   temp := (x*x*x*x*x*x*x*x) - (28*x*x*x*x*x*x*y*y);
  137.   temp := temp + (70*x*x*x*x*y*y*y*y) - (28*y*y*y*y*y*y*x*x) + (y*y*y*y*y*y*y*y) + xp;
  138.   y := (8*x*x*x*x*x*x*x*y) - (56*x*x*x*x*x*y*y*y) + (56*x*x*x*y*y*y*y*y) - (8*x*y*y*y*y*y*y*y) + yp;
  139.   x := temp;
  140. End;
  141.  
  142. Procedure DisplayMandelbrot(xorg,yorg,xlim,ylim : unreal; maxittr : word; ftype : integer);
  143.  
  144. Var
  145.   xstep,ystep : unreal; { distance between pixels }
  146.   xpos,ypos : unreal;   { current pixel evaluation position }
  147.   done : boolean;
  148.   steps : word;
  149.   xiter,yiter : unreal; { itterated values of x,y }
  150.   temp : unreal;
  151.  
  152. Begin
  153.   xstep := (xlim-xorg)/320;
  154.   ystep := (ylim-yorg)/200;
  155.   ypos := yorg;
  156.   for i := 0 to ymax do
  157.   Begin
  158.     xpos := xorg;
  159.     for j := 0 to xmax do
  160.     Begin
  161.       color := 1;
  162.       putpix(j,i);
  163.       xiter := 0;
  164.       yiter := 0;
  165.       steps := 0;
  166.       done := false;
  167.       if ftype = 2 then
  168.       Begin
  169.         xiter := xpos;
  170.         yiter := ypos;
  171.       End;
  172.       Repeat
  173.         steps := steps + 1;
  174.         if ftype = 1 then
  175.         Begin
  176.           xstart := xpos;
  177.           ystart := ypos;
  178.         End;
  179.         Case mandtype of
  180.           2 : SquareComplex(xiter,yiter,xstart,ystart);
  181.           3 : ThirdComplex(xiter,yiter,xstart,ystart);
  182.           4 : ForthComplex(xiter,yiter,xstart,ystart);
  183.           5 : FifthComplex(xiter,yiter,xstart,ystart);
  184.           6 : SixthComplex(xiter,yiter,xstart,ystart);
  185.           7 : SeventhComplex(xiter,yiter,xstart,ystart);
  186.           8 : EighthComplex(xiter,yiter,xstart,ystart);
  187.         End;
  188.         if sqr(xiter)+sqr(yiter) >= 9 then done := true;
  189.  
  190.         if steps > maxittr then done := true;
  191.       Until done;
  192.       steps := steps - 1;
  193.       color := steps mod 196;
  194.       if color = 0 then color := 196;
  195.       if steps < maxittr then putpix(j,i);
  196.       if steps >= maxittr then
  197.       Begin
  198.         color := 0;
  199.         putpix(j,i);
  200.       End;
  201.  
  202.       xpos := xpos + xstep;
  203.     End;
  204.     ypos := ypos + ystep;
  205.   End;
  206. End;
  207.  
  208.  
  209.  
  210. Procedure TwoColor(num,num2 : integer);
  211.  
  212. Var
  213.   bright,bright2 : integer;
  214.  
  215. Begin
  216.   num := num mod 12;
  217.   num2 := num2 mod 12;
  218.   if num < 6 then bright := 47 else bright := 63;
  219.   if num2 < 6 then bright2 := 47 else bright2 := 63;
  220.  
  221.   num := num mod 6;
  222.   num2 := num2 mod 6;
  223.   pal[1,1] := bright*abs(((num-3) div 2));
  224.   pal[1,2] := bright*abs(abs(((num-2) div 2))-1);
  225.   pal[1,3] := bright*(num div 3);
  226.  
  227.   pal[98,1] := bright2*abs(((num2-3) div 2));
  228.   pal[98,2] := bright2*abs(abs(((num2-2) div 2))-1);
  229.   pal[98,3] := bright2*(num2 div 3);
  230.  
  231.   pal[196,1] := bright*abs(((num-3) div 2));
  232.   pal[196,2] := bright*abs(abs(((num-2) div 2))-1);
  233.   pal[196,3] := bright*(num div 3);
  234.  
  235.   smoothblend(pal,1,98);
  236.   smoothblend(pal,98,196);
  237.  
  238.   setrgbpal(pal);
  239. End;
  240.  
  241.  
  242.  
  243. Procedure DarkRainbow(num : byte);
  244.  
  245. Begin
  246.   pal[1,(num mod 3)+1] := 63;
  247.   pal[1,((num+1) mod 3)+1] := 0;
  248.   pal[1,((num+2) mod 3)+1] := 0;
  249.  
  250.   pal[64,(num mod 3)+1] := 0;
  251.   pal[64,((num+1) mod 3)+1] := 63;
  252.   pal[64,((num+2) mod 3)+1] := 0;
  253.  
  254.   pal[128,(num mod 3)+1] := 0;
  255.   pal[128,((num+1) mod 3)+1] := 0;
  256.   pal[128,((num+2) mod 3)+1] := 63;
  257.  
  258.   pal[196,(num mod 3)+1] := 63;
  259.   pal[196,((num+1) mod 3)+1] := 0;
  260.   pal[196,((num+2) mod 3)+1] := 0;
  261.  
  262.   smoothblend(pal,1,64);
  263.   smoothblend(pal,64,128);
  264.   smoothblend(pal,128,196);
  265.  
  266.   setrgbpal(pal);
  267. End;
  268.  
  269.  
  270. Procedure StandardPal;
  271.  
  272. Begin
  273.   SetRGBPal(stdpal);
  274. End;
  275.  
  276.  
  277.  
  278. Begin
  279.   ChgMouseColor(cursorptr,197);
  280.   lcursor := NIL;
  281.   randomize;
  282.   paltype := 2;
  283.   writeln('# of itterations (0-1024) (386dx try 128, 486dx try 256)');
  284.   readln(itterations);
  285.   if keypressed then achar := readkey;
  286.  
  287.   vgamode;
  288.   GetRGBPal(pal);
  289.   for i := 1 to 3 do
  290.   Begin
  291.     pal[0,i] := 0;
  292.     pal[197,i] := 63;
  293.     pal[213,i] := 0;
  294.   End;
  295.   smoothblend(pal,197,213);
  296.   stdpal := pal;
  297.   SetRGBPal(pal);
  298.  
  299.   palnum := 0;
  300.  
  301.   loadfont(font,'fractal.tf');
  302.   if paltype = 2 then { rainbow palette }
  303.     darkrainbow(1);
  304.   xorg := -1.6295234671;
  305.   xlim := -1.6295234666;
  306.   yorg := -0.0051268052382;
  307.   ylim := -0.0051268047045;
  308.  
  309.   xorg := -0.74401626712;
  310.   xlim := -0.74401604109;
  311.   yorg := 0.14716055214;
  312.   ylim := 0.14716077093;
  313.  
  314.   i := 0;
  315.   Repeat
  316.     getmem(zoomout[i].ptr,64000);
  317.     i := i + 1;
  318.   Until memavail < 70000;
  319.   maxzooms := i - 1;
  320.  
  321. beginning:
  322.   ftype := 1;
  323.  
  324.   xorg := -2.2;
  325.   xlim := 2.2;
  326.   yorg := -1.5;
  327.   ylim := 1.5;
  328.  
  329.   xstart := 0.4;
  330.   ystart :=-0.35;
  331.   clrbuf(0);
  332.  
  333.   for i := 0 to maxzooms do
  334.     zoomout[i].order := maxzooms + 1; { indicates unused }
  335.   zoomout[0].order := 0;
  336.   zn := 0;
  337.   zoomout[0].x1 := xorg;
  338.   zoomout[0].x2 := xlim;
  339.   zoomout[0].y1 := yorg;
  340.   zoomout[0].y2 := ylim;
  341.  
  342.   redrawfractal := true;
  343.  
  344.   colnum := random(12);
  345.   assign(fv,'mandel.pcx');
  346.   {$I-}
  347.   reset(fv);
  348.   {$I+}
  349.   if (mandtype = 2) and (ioresult = 0) then
  350.     PCXLoad('mandel.pcx',pal,0,0)
  351.   else
  352.     DisplayMandelbrot(xorg,yorg,xlim,ylim,itterations,ftype);
  353.  
  354.   firstfractal := true;
  355.  
  356.   pickjuliapoint := false;
  357.  
  358.   achar := #0;
  359.   Repeat
  360.     if not(firstfractal) then begin
  361.       if redrawfractal then DisplayMandelbrot(xorg,yorg,xlim,ylim,itterations,ftype)
  362.       else
  363.         BuftoScreen(zoomout[zn].ptr);
  364.     End;
  365.     firstfractal := false;
  366.  
  367.     if pickjuliapoint then begin
  368.       Repeat
  369.         MouseStatus(i,j,buttons);
  370.       Until buttons mod 2 = 0;
  371.       repeat
  372.         MoveMouseA(cursorptr,buttons,0,lcursor);
  373.         MoveMouseb(cursorptr,buttons,0,lcursor);
  374.       Until buttons = 1;
  375.       xstart := (mousex/SW)*(zoomout[zn].x2-zoomout[zn].x1) + zoomout[zn].x1;
  376.       ystart := (mousey/SH)*(zoomout[zn].y2-zoomout[zn].y1) + zoomout[zn].y1;
  377.       firstfractal := false;
  378.       ftype := 2;
  379.       pickjuliapoint := false;
  380.       xorg := -2.2;
  381.       xlim := 2.2;
  382.       yorg := -1.5;
  383.       ylim := 1.5;
  384.       zoomout[0].x1 := xorg;
  385.       zoomout[0].x2 := xlim;
  386.       zoomout[0].y1 := yorg;
  387.       zoomout[0].y2 := ylim;
  388.       for i := 0 to maxzooms do begin
  389.         zoomout[i].order := maxzooms + 1; { indicates unused }
  390.       End;
  391.       zoomout[0].order := 0;
  392.       zn := 0;
  393.       DisplayMandelbrot(xorg,yorg,xlim,ylim,itterations,ftype);
  394.       resetmouse(cursorptr,lcursor);
  395.     End;
  396.  
  397.     newxo := xorg;
  398.     newxl := xlim;
  399.     newyo := yorg;
  400.     newyl := ylim;
  401.  
  402.     ScreentoBuf(zoomout[zn].ptr);
  403.  
  404.     mousexo := 10000;
  405.     mousexl := 10000;
  406.     Repeat
  407.       backcolor := 0;
  408.       curwidth := 5;
  409.       curheight := 10;
  410.  
  411.       MovemouseA(cursorptr,buttons,0,lcursor);  { first movemouse }
  412.  
  413.       if (waitfor1) and (buttons = 1) then      { image processing & stuff }
  414.       Begin                                     { | | | | | | | | | | | |  }
  415.         waitfor0 := true;                       { V V V V V V V V V V V V  }
  416.         waitfor1 := false;
  417.         newxo := xorg + (xlim-xorg)/320*mousex;
  418.         newyo := yorg + (ylim-yorg)/200*mousey;
  419.         oldmxo := mousexo;
  420.         oldmyo := mouseyo;
  421.         mousexo := mousex;
  422.         mouseyo := mousey;
  423.       End;
  424.       if (waitfor0) and (buttons = 0) then
  425.       Begin
  426.         waitfor0 := false;
  427.         waitfor1 := true;
  428.         newxl := xorg + (xlim-xorg)/320*mousex;
  429.         newyl := yorg + (ylim-yorg)/200*mousey;
  430.       End;
  431.  
  432.       if (waitfor0) and (buttons = 1) and ((mousecx <> 0) or (mousecy <> 0)) then
  433.       Begin
  434.         if mousex <= mousexo then mousex := mousexo;
  435.         if mousey <= mouseyo then mousey := mouseyo;
  436.         oldmxl := mousexl;
  437.         oldmyl := mouseyl;
  438.         mousexl := mousex;
  439.         mouseyl := mousey;
  440.         if oldmxl <> 10000 then
  441.         Begin
  442.           if oldmxo <> 10000 then begin
  443.             tempxo := oldmxo;
  444.             tempyo := oldmyo;
  445.           End
  446.           else begin
  447.             tempxo := mousexo;
  448.             tempyo := mouseyo;
  449.           End;
  450.           for i := tempyo to oldmyl do begin
  451.             color := rec[1,i];
  452.             putpix(tempxo,i);
  453.           End;
  454.           for i := tempxo+1 to oldmxl-1 do begin
  455.             color := rec[2,i];
  456.             putpix(i,tempyo);
  457.           End;
  458.           if oldmyl > tempyo then
  459.             for i := tempyo to oldmyl do begin
  460.               color := rec[3,i];
  461.               putpix(oldmxl,i);
  462.             End;
  463.           if oldmxl > tempxo+2 then
  464.             for i := tempxo+1 to oldmxl-1 do begin
  465.               color := rec[4,i];
  466.               putpix(i,oldmyl);
  467.             End;
  468.         End;
  469.         oldmxo := mousexo;
  470.         oldmyo := mouseyo;
  471.         for i := mouseyo to mouseyl do
  472.           rec[1,i] := getpix(mousexo,i);
  473.         for i := mousexo+1 to mousexl-1 do
  474.           rec[2,i] := getpix(i,mouseyo);
  475.         if mouseyl > mouseyo then
  476.           for i := mouseyo to mouseyl do
  477.             rec[3,i] := getpix(mousexl,i);
  478.         if mousexl > mousexo+2 then
  479.           for i := mousexo+1 to mousexl-1 do
  480.             rec[4,i] := getpix(i,mouseyl);
  481.         color := 197;
  482.       End;
  483.       color := 197;
  484.       if (mousecx <> 0) or (mousecy <> 0) then
  485.       Begin
  486.         getimage(mousex,mousey,mousex+curwidth-1,mousey+curheight-1,lcursor);
  487.         if (waitfor0) and (buttons = 1) then
  488.           rectangle(mousexo,mouseyo,mousexl,mouseyl);
  489.       End;
  490.  
  491.       MoveMouseB(cursorptr,buttons,0,lcursor);  { Second Movemouse }
  492.                                                 { Easy isn't it! :) }
  493.       if keypressed then achar := readkey;
  494.     Until ((buttons = 2) or (ord(achar) = 27));
  495.     putimage(mousex,mousey,lcursor);
  496.     resetmouse(cursorptr,lcursor);    { moved out a mouse loop, have to reset! }
  497.  
  498.     color := 203;
  499.     rectanglefill(0,0,78,17);
  500.     rectanglefill(79,0,148,17);
  501.     rectanglefill(149,0,217,17);
  502.     rectanglefill(218,0,287,17);
  503.     rectanglefill(0,18,78,34);
  504.     rectanglefill(79,18,148,34);
  505.  
  506.     color := 205;
  507.     rectanglefill(1,1,77,16);
  508.     rectanglefill(80,1,147,16);
  509.     rectanglefill(150,1,216,16);
  510.     rectanglefill(219,1,286,16);
  511.     rectanglefill(1,19,77,33);
  512.     rectanglefill(80,19,147,33);
  513.  
  514.     color := 197;
  515.     stuff := 'ZOOM OUT';
  516.     curbuf := vidptr;
  517.     textxy(font,stuff,4,4,1);
  518.     stuff := 'ZOOM IN';
  519.     textxy(font,stuff,83,4,1);
  520.     stuff := 'RESTART';
  521.     textxy(font,stuff,153,4,1);
  522.     stuff := 'PAL CHG';
  523.     textxy(font,stuff,222,4,1);
  524.     stuff := 'PCX SAVE';
  525.     textxy(font,stuff,4,21,1);
  526.     stuff := 'JULIA';
  527.     textxy(font,stuff,92,21,1);
  528.     Repeat
  529.       MovemouseA(cursorptr,buttons,0,lcursor);
  530.       MovemouseB(cursorptr,buttons,0,lcursor);
  531.       if keypressed then achar := readkey;
  532.     Until ((buttons = 1) or (ord(achar) = 27));
  533.     resetmouse(cursorptr,lcursor);
  534.     redrawfractal := false;
  535.     if ((mousey < 17) and (buttons = 1)) then begin
  536.       if mousex < 79 then begin           { ZOOM OUT }
  537.         temp := zn;
  538.         zn := maxzooms + 1;
  539.         for i := 0 to maxzooms do
  540.           if zoomout[i].order = 1 then zn := i;
  541.         if zn < (maxzooms+1) then
  542.         Begin
  543.           xorg := zoomout[zn].x1;
  544.           xlim := zoomout[zn].x2;
  545.           yorg := zoomout[zn].y1;
  546.           ylim := zoomout[zn].y2;
  547.           for i := 0 to maxzooms do
  548.           Begin
  549.             if zoomout[i].order <= maxzooms then
  550.               zoomout[i].order := zoomout[i].order - 1
  551.             else
  552.               zoomout[i].order := maxzooms + 1;
  553.             if zoomout[i].order = 0 then zn := i;
  554.           End;
  555.         End
  556.         else zn := temp;
  557.       End
  558.       else
  559.       if (mousex < 149) then              { ZOOM IN }
  560.       Begin
  561.         xorg := newxo;
  562.         yorg := newyo;
  563.         xlim := newxl;
  564.         ylim := newyl;
  565.         zn := 0;
  566.         While zoomout[zn].order < maxzooms do
  567.           zn := zn + 1;
  568.         for i := 0 to maxzooms do
  569.           zoomout[i].order := zoomout[i].order + 1;
  570.         zoomout[zn].order := 0;
  571.         zoomout[zn].x1 := xorg;
  572.         zoomout[zn].x2 := xlim;
  573.         zoomout[zn].y1 := yorg;
  574.         zoomout[zn].y2 := ylim;
  575.         redrawfractal := true;
  576.       End
  577.       else
  578.       if mousex < 218 then goto beginning  { RESTART }
  579.       else
  580.       if mousex < 288 then begin            { CHANGE PAL }
  581.         Repeat
  582.           i := random(12);
  583.         Until i <> colnum;
  584.         if palnum < 4 then
  585.           Twocolor(colnum,i);
  586.         if palnum = 5 then
  587.           DarkRainbow(colnum mod 3);
  588.         if palnum = 4 then
  589.           StandardPal;
  590.         if (palnum > 5) and (palnum < 10) then
  591.           TwoColor(colnum,i);
  592.         if palnum = 10 then
  593.           DarkRainbow(colnum mod 3);
  594.         if palnum < 10 then
  595.           palnum := palnum + 1
  596.         else
  597.           palnum := 0;
  598.         colnum := (colnum + 1) mod 12;
  599.         redrawfractal := false;
  600.       End;
  601.     End   { mousey < 17 }
  602.     else if ((mousey < 33) and (buttons = 1)) then begin
  603.       if mousex < 79 then begin                          { PCX SAVE }
  604.         curbuf := zoomout[zn].ptr;
  605.         PCXSave('fractal.pcx',pal,0,0,319,199);
  606.         curbuf := vidptr;
  607.       End
  608.       else if mousex < 149 then begin                    { JULIA }
  609.         if ftype = 1 then pickjuliapoint := true;
  610.       End;
  611.     End;  { mousey < 33 }
  612.   if keypressed then achar := readkey;
  613.   Until ord(achar) = 27;
  614.   setmode(3);               
  615. End.
  616.