home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / FRACTALS.ZIP / FRACTALS.PAS
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  1.4 KB  |  84 lines
  1. program Fractal;
  2.  
  3. var
  4.   i,cx,cy,px,py : integer;
  5.   x,y,s,t,lx,ly,tx,ty,sc : real;
  6.   a : char;
  7.  
  8. procedure Square_Root;
  9. begin
  10.    t := y;
  11.    s := sqrt(abs(x * x - y * y));
  12.    x := sqrt(abs((-x + s)/2));
  13.    y := sqrt(abs((x + s)/2));
  14.    if t < 0.0 then x := -x;
  15. end;
  16.  
  17. procedure Four_Over_L;
  18. begin
  19.    s := lx * lx + ly * ly;
  20.    lx := 4 * lx/s;
  21.    ly := -4 * ly/s;
  22. end;
  23.  
  24. procedure XY_Times_L;
  25. begin
  26.    tx := x;
  27.    ty := y;
  28.    x := tx * lx - ty * ly;
  29.    y := tx * ly + ty * lx;
  30. end;
  31.  
  32. procedure Function_of_XY;
  33. begin
  34.    XY_Times_L;
  35.    x := 1 - x;
  36.    Square_Root;
  37.    if Random < 0.5 then
  38.    begin
  39.       x := -x;
  40.       y := -y;
  41.    end;
  42.    x := 1 - x;
  43.    x := x/2;
  44.    y := y/2;
  45. end;
  46.  
  47. procedure Get_Values;
  48. begin
  49.    TextMode;
  50.    writeln;
  51.    writeln('What is Lambda? (X,Y) ');
  52.    read(lx,ly);
  53.    Four_Over_L;
  54.    writeln;
  55.    writeln;
  56.    writeln('what is Scale? ');
  57.    read(sc);
  58.    sc := 2 * cx / sc;
  59. end;
  60.  
  61. procedure Plot_XY;
  62. begin
  63.    px := Round(sc * (2 * x - 0.5) + cx);
  64.    py := Round(cy - sc * y);
  65.    Plot(px,py,1);
  66. end;
  67.  
  68. begin
  69.    cx := 320;
  70.    cy := 100;
  71.    x := 0.50001;
  72.    y := 0.0;
  73.    Get_Values;
  74.    HiRes;
  75.    HiResColor(White);
  76.    for i := 1 to 10 do Function_of_XY;
  77.    repeat
  78.       Plot_XY;
  79.       Function_of_XY;
  80.    until Keypressed;
  81. end.
  82.  
  83.  
  84.