home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 03 / apfel.pas next >
Encoding:
Pascal/Delphi Source File  |  1987-02-03  |  1.1 KB  |  63 lines
  1. { Zeichnet Apfelmaenchen = Mandelbrot-Menge }
  2.  
  3. PROGRAM apfelman;
  4.  
  5. CONST
  6.   xres  = 560;
  7.   yres  = 200;
  8.   ak    = 2;
  9.   pmin  = -2.25;
  10.   pmax  = 0.75;
  11.   qmin  = -1.5;
  12.   qmax  = 1.5;
  13.   r_max = 50;
  14.   k_max = 50;
  15.  
  16. VAR
  17.   np, nq, k : INTEGER;
  18.   dp, dq,
  19.   p, q,
  20.   x, x_alt, y : REAL;
  21.  
  22. LABEL exit;
  23.  
  24. {---------------------------------------------------------}
  25.  
  26. PROCEDURE iterat (np, nq: INTEGER);
  27.  
  28. BEGIN
  29.   p := pmin + np * dp;
  30.   q := qmin + nq * dq;
  31.   k := 0;
  32.   x := 0;
  33.   y := 0;
  34.   REPEAT
  35.     x_alt := x;
  36.     x := x * x - y * y + p;
  37.     y := 2 * x_alt * y + q;
  38.     k := k + 1;
  39.   UNTIL (x * x + y * y > r_max) OR (k = k_max);
  40.   IF k = k_max THEN
  41.     k := 0;
  42.   Plot(np, yres - nq, k Mod ak);
  43. END;
  44.  
  45. {---------------------------------------------------------}
  46.  
  47. BEGIN
  48.   ClrScr;
  49.   HiRes;
  50.   HiResColor(15);
  51.   dp := (pmax - pmin) / xres;
  52.   dq := (qmax - qmin) / yres;
  53.   FOR np := 0 TO xres - 1 DO
  54.   BEGIN
  55.     FOR nq := 0 TO yres - 1 DO
  56.       iterat(np, nq);
  57.     IF KeyPressed THEN GOTO exit;
  58.   END;
  59.   REPEAT UNTIL KeyPressed;
  60. exit:
  61. END.
  62.  
  63.