home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / FRACTAL1.ZIP / FRACTAL1.PAS
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  2.6 KB  |  130 lines
  1. {original source code anonymous, downloaded from TECHMAIL, Sterling VA on
  2. 2 Nov 1985.  This appears to be a TURBO version of a BASIC program that
  3. ran in Creative Computing in mid 1984.  However all that it seems to do is
  4. to print some sort of pseudorandom pattern on the screen that is not
  5. interesting.  This is a far cry from those picture I saw in Scientific
  6. American.  This is a journal of attempts to make it more like the
  7. SA pictures or at least interesting.
  8. As of 3 November 1985 the resolution has been cut in half and color added
  9. in a manner related to the results of a random call.  This provides some
  10. grouping of the colors and some visual interest. This variation has been
  11. added in Function_of_XY}
  12.  
  13. {x,y for lambda and 10 for scale}
  14. {-.1 .9 10}
  15. {.1 .9 10}
  16. {-.5 -.5 8}
  17. program Fractal;
  18.  
  19. var
  20.   i,cx,cy,px,py : integer;
  21.   x,y,s,t,lx,ly,tx,ty,sc : real;
  22.   a : char;
  23.   color : integer;
  24.   total : real;
  25.  
  26. procedure Square_Root;
  27. begin
  28.    t := y;
  29.    s := sqrt(abs(x * x - y * y));
  30.    x := sqrt(abs((-x + s*0.111)/2));
  31.    y := sqrt(abs((x + s)/2));
  32.    if t < 0.0 then x := -x;
  33. end;
  34.  
  35. procedure Four_Over_L;
  36. begin
  37.    s := lx * lx + ly * ly;
  38.    lx := 4 * lx/s;
  39.    ly := -4 * ly/s;
  40. end;
  41.  
  42. procedure XY_Times_L;
  43. begin
  44.    tx := x;
  45.    ty := y;
  46.    x := tx * lx - ty * ly;
  47.    y := tx * ly + ty * lx;
  48. end;
  49.  
  50. procedure Function_of_XY;
  51. var
  52.    ran : real;
  53. begin
  54.    XY_Times_L;
  55.    x := 1 - x;
  56.    Square_Root;
  57.    ran := random;
  58.    if Ran < 0.25 then {added variations for x and y}
  59.    begin
  60.       x := -x;
  61.       y := -y;
  62.       color:=1;
  63.    end
  64.    else if ran < 0.5 then
  65.    begin
  66.         x:=-x;
  67.         color:=2;
  68.    end
  69.    else if ran < 0.75 then
  70.    begin
  71.         y:=-y;
  72.         color:=3;
  73.    {else color does not change from last point, i.e. =>0.75}
  74.    end;
  75.    x := 1 - x;
  76.    x := x/2;
  77.    y := y/2;
  78. end;
  79.  
  80. procedure Get_Values;
  81. begin
  82.    TextMode;
  83.    writeln;
  84.    writeln('What is Lambda? (X,Y) ');
  85.    read(lx,ly);
  86.    Four_Over_L;
  87.    writeln;
  88.    writeln;
  89.    writeln('what is Scale? ');
  90.    read(sc);
  91.    sc := 2 * cx / sc;
  92. end;
  93.  
  94. procedure Plot_XY;
  95. begin
  96.    px := Round(sc * (2 * x - 0.5) + cx);
  97.    py := Round(cy - sc * y);
  98. {   color:=color+1;
  99.    if color>3 then color:=1;}
  100.    Plot(px,py,color);
  101.    total := total+1;
  102. {writeln(px,'   ',py);}
  103. end;
  104.  
  105. begin
  106. {
  107.    cx := 320;
  108. }
  109.    cx:=160;
  110.    cy := 100;
  111.    x := 0.50001;
  112.    y := 0.0;
  113.    Get_Values;
  114. {
  115.    HiRes;
  116.    HiResColor(White);
  117. }
  118.    total:=0;
  119.    graphcolormode;
  120.    palette(2);
  121.    for i := 1 to 10 do Function_of_XY;
  122.    repeat
  123.       Plot_XY;
  124.       Function_of_XY;
  125.    until Keypressed;
  126.    writeln(total);
  127.    repeat
  128.    until keypressed;
  129. end.
  130.