home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 05 / t4_grf / apfel4.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-02-28  |  1.4 KB  |  72 lines
  1. { Zeichnet Apfelmaenchen = Mandelbrot-Menge }
  2.  
  3. PROGRAM apfelman;
  4.  
  5. USES Crt, Graph;
  6.  
  7. LABEL exit;
  8.  
  9. CONST
  10.   pmin  = -2.25;
  11.   pmax  = 0.75;
  12.   qmin  = -1.5;
  13.   qmax  = 1.5;
  14.   r_max = 50;
  15.   k_max = 50;
  16.  
  17. VAR
  18.   GraphDriver,
  19.   GraphMode,
  20.   GraphCode : INTEGER;
  21.   xres, yres, ak  : WORD;
  22.   np, nq, k : INTEGER;
  23.   dp, dq,
  24.   p, q,
  25.   x, x_alt, y : REAL;
  26.  
  27. {---------------------------------------------------------}
  28.  
  29. PROCEDURE iterat (np, nq: INTEGER);
  30.  
  31. BEGIN
  32.   p := pmin + np * dp;
  33.   q := qmin + nq * dq;
  34.   k := 0;
  35.   x := 0;
  36.   y := 0;
  37.   REPEAT
  38.     x_alt := x;
  39.     x := x * x - y * y + p;
  40.     y := 2 * x_alt * y + q;
  41.     k := k + 1;
  42.   UNTIL (x * x + y * y > r_max) OR (k = k_max);
  43.   IF k = k_max THEN
  44.     k := 0;
  45.   PutPixel(np, yres - nq, k Mod ak);
  46. END;
  47.  
  48. {---------------------------------------------------------}
  49.  
  50. BEGIN
  51.   GraphDriver := Detect;
  52.   InitGraph(GraphDriver,GraphMode,'');
  53.   GraphCode := GraphResult;
  54.   IF GraphCode <> grOk THEN BEGIN
  55.     WriteLn('Grafik-Fehler Nr. ',GraphCode);
  56.     Writeln('Programm abgebrochen...');
  57.     Halt;
  58.   END;
  59.   xres := GetMaxX;  yres := GetMaxY;  ak := GetMaxColor+1;
  60.   dp := (pmax - pmin) / xres;
  61.   dq := (qmax - qmin) / yres;
  62.   FOR np := 0 TO xres - 1 DO
  63.   BEGIN
  64.     FOR nq := 0 TO yres - 1 DO
  65.       iterat(np, nq);
  66.     IF KeyPressed THEN GOTO exit;
  67.   END;
  68.   REPEAT UNTIL KeyPressed;
  69. exit:
  70.   CloseGraph;
  71. END.
  72.