home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / MacMETH 3.2.4 / More Examples / Mandelbrot.MOD < prev    next >
Encoding:
Text File  |  1996-06-20  |  6.3 KB  |  211 lines  |  [TEXT/MEDT]
  1. MODULE Mandelbrot; (* HS 29-Jan-90 *)
  2.    
  3. FROM Terminal IMPORT BusyRead;
  4. FROM InOut IMPORT Read, ReadInt, ReadReal, WriteReal,
  5.                   WriteString, WriteLn, Write, Done;
  6. FROM GraphicWindows IMPORT Window, Mode, OpenGraphicWindow, CloseGraphicWindow,
  7.                  Circle, Clear, SetMode, SetPen, MoveTo, Dot, IdentifyPos;
  8. FROM CursorMouse IMPORT GetMouse;
  9. FROM FileSystem IMPORT File, Response, Lookup, Close, WriteChar;
  10. FROM Conversions IMPORT IntToString, LongIntToString;
  11. IMPORT Windows;
  12.  
  13.                           
  14. CONST NrPixels = 196;
  15.     
  16.      (* colours *)
  17.      white     = 449;
  18.      red       = 193;
  19.      yellow    = 65;
  20.      green     = 321;
  21.      zyan      = 257;
  22.      blue      = 385;
  23.      magenta   = 129;
  24.      black     = 1;
  25.     
  26.  
  27. VAR ch             : CHAR;
  28.     w,v            : Window;
  29.     ix,iy,ox,oy,dx : INTEGER;
  30.     ux,uux,uy,uuy  : REAL;
  31.     rinic,iinic    : REAL;
  32.     sizec,step     : REAL;
  33.     sizex          : REAL;
  34.     rinix,iinix    : REAL;
  35.     lim            : INTEGER;
  36.     colour         : ARRAY [0 .. 2048] OF INTEGER;
  37.     
  38.  
  39.   PROCEDURE ForeColour    (c : LONGINT); CODE 0A862H;
  40.   PROCEDURE BackColour    (c : LONGINT); CODE 0A863H;
  41.   
  42.   PROCEDURE GetPos(VAR i,j: INTEGER);
  43.   CONST ML = 15;
  44.   VAR mouse : BITSET; x,y : INTEGER;
  45.   BEGIN mouse := {};
  46.     REPEAT GetMouse(mouse,x,y) UNTIL NOT(ML IN mouse);
  47.     REPEAT GetMouse(mouse,x,y) UNTIL ML IN mouse;
  48.     REPEAT GetMouse(mouse,x,y) UNTIL NOT(ML IN mouse);
  49.     IdentifyPos(w,x,y);
  50.     i := x; j := y;
  51.   END GetPos;
  52.  
  53.   PROCEDURE Mandel(cx0, cy0, sz0: REAL);
  54.   VAR ix, iy, k  : INTEGER; x, y, xx, yy, cx, cy : REAL;
  55.   BEGIN (* z := z*z + c *)
  56.     FOR ix := 0 TO NrPixels DO
  57.       cx := cx0 + (FLOAT(ix) * sz0) / FLOAT(NrPixels);
  58.       FOR iy := 0 TO NrPixels DO
  59.         cy := cy0 + (FLOAT(iy) * sz0) / FLOAT(NrPixels);
  60.         x  := 0.0;  y  := 0.0; 
  61.         xx := 0.0;  yy := 0.0;
  62.         k := 0;
  63.         REPEAT
  64.           y  := 2.0*x*y + cy;
  65.           x  := xx - yy + cx;
  66.           xx := x*x;
  67.           yy := y*y;
  68.           INC (k);
  69.         UNTIL ((xx + yy) > 4.0) OR (k >= lim);
  70.         IF k >= lim THEN        
  71.           Windows.SetWindow(w);
  72.           IF (cx = 0.0) OR (cy = 0.0) THEN ForeColour(yellow)
  73.           ELSIF (cx = 0.25) & (ABS(cy) < 0.1) THEN ForeColour(yellow)
  74.           ELSE ForeColour(zyan) END;
  75.           Dot(w,ix,iy);
  76.           Windows.ResetWindow;
  77.         END;         
  78.       END (* For *);
  79.       BusyRead(ch);
  80.       IF ch = 177C THEN ix := NrPixels END;
  81.     END (* For *);
  82.   END Mandel;
  83.  
  84.  PROCEDURE Fractal(cx0, cy0, x0, y0, sz0 : REAL);
  85.   VAR ix, iy, k  : INTEGER; x, y, xx, yy, delta : REAL;
  86.   BEGIN (* z := z*z + c *)
  87.     FOR ix := 0 TO NrPixels DO
  88.       FOR iy := 0 TO NrPixels DO
  89.         x := x0 + (FLOAT(ix) * sz0 / FLOAT(NrPixels));
  90.         y := y0 + (FLOAT(iy) * sz0 / FLOAT(NrPixels));
  91.         xx := x*x; yy := y*y;
  92.         k := 0;
  93.         REPEAT
  94.           y  := 2.0*x*y  + cy0;
  95.           x  := xx - yy  + cx0;
  96.           xx := x*x;
  97.           yy := y*y;
  98.           INC (k);
  99.         UNTIL ((xx + yy) > 10.0) OR (k >= lim);
  100.         IF k >= lim THEN        
  101.           Windows.SetWindow(v);
  102.           ForeColour(red);
  103.           Dot(v,ix,iy);
  104.           Windows.ResetWindow;
  105.         END;         
  106.       END (* For *);
  107.       BusyRead(ch);
  108.       IF ch = 177C THEN ix := NrPixels END;
  109.     END (* For *);
  110.   END Fractal;
  111.   
  112.  
  113.   PROCEDURE SetColours(lim : INTEGER);
  114.   VAR n, int : INTEGER;
  115.   BEGIN
  116.     int := lim DIV 12;
  117.     FOR n := 0 TO lim DO colour[n] := blue END;
  118.     colour[lim] := red; 
  119.   END SetColours;
  120.  
  121.  
  122. BEGIN
  123.   
  124.   rinic := -2.25;
  125.   iinic := -1.5;
  126.   sizec := 3.0;
  127.   lim   := 100;
  128.   
  129.   OpenGraphicWindow(w,100,40,NrPixels,NrPixels+20,"Mandelbrot",Clear);
  130.   SetColours(lim);
  131.   
  132.   LOOP      
  133.     WriteString ('drawing Mandelbrot set.'); WriteLn;
  134.     Mandel(rinic, iinic, sizec); ch := 0C;
  135.     WriteString ('zoom requested Y/N:');
  136.     Read(ch); Write(CAP(ch)); WriteLn;
  137.     IF CAP(ch) # "Y" THEN EXIT END;
  138.     WriteString("nr. iterations: "); ReadInt(lim); WriteLn;
  139.     WriteString ('define window !'); WriteLn;
  140.     step := sizec / FLOAT(NrPixels);  
  141.     GetPos(ix,iy);
  142.     ox := ix; oy := iy;
  143.     ux := rinic + FLOAT(ix)*step;     
  144.     uy := iinic + FLOAT(iy)*step;
  145.     GetPos(ix,iy);
  146.     dx := ABS(ix-ox);        
  147.     uux := rinic + FLOAT(ix)*step;    
  148.     uuy := iinic + FLOAT(iy)*step;
  149.     rinic := ux;
  150.     iinic := uy;
  151.     sizec := ABS(uux - ux); 
  152.           Windows.SetWindow(w);
  153.           ForeColour(black);
  154.           SetPen(w,ox,oy);    MoveTo(w,ix,oy);
  155.           SetPen(w,ix,oy);    MoveTo(w,ix,oy+dx);
  156.           SetPen(w,ix,oy+dx); MoveTo(w,ox,oy+dx);
  157.           SetPen(w,ox,oy+dx); MoveTo(w,ox,oy);
  158.           Windows.ResetWindow;
  159.     GetPos(ix,iy); (* wait for mouse click *)
  160.     Clear(w);
  161.   END;
  162.  
  163.   OpenGraphicWindow(v,360,40,NrPixels,NrPixels+20,"Julia Set",Clear);
  164.   LOOP      
  165.     WriteString ('give c for julia set'); WriteLn;
  166.     WriteString ('define mouse-point !'); WriteLn;
  167.     GetPos(ix,iy);
  168.     ox := ix; oy := iy;
  169.     ux := rinic + (FLOAT(ix)*sizec / FLOAT(NrPixels));   
  170.     uy := iinic + (FLOAT(iy)*sizec / FLOAT(NrPixels));
  171.           Windows.SetWindow(w);
  172.           ForeColour(black);
  173.           SetPen(w,ox,oy); Dot(w,ox,oy);
  174.           SetPen(w,ox,oy); MoveTo(w, ox+2, oy);
  175.           SetPen(w,ox,oy); MoveTo(w, ox-2, oy);
  176.           SetPen(w,ox,oy); MoveTo(w, ox, oy+2);
  177.           SetPen(w,ox,oy); MoveTo(w, ox, oy-2);
  178.           Windows.ResetWindow;
  179.     GetPos(ix,iy); (* wait for mouse click *)
  180.     Clear(v);
  181.     WriteString ('drawing Julia Set.'); WriteLn;
  182.     lim := 100;
  183.     SetColours(lim);
  184.     Fractal(ux, uy, -2.25, -2.25, 4.5);
  185.           ox := TRUNC( ((ux + 2.25) * FLOAT(NrPixels) / 4.5)  );
  186.           oy := TRUNC( ((uy + 2.25) * FLOAT(NrPixels) / 4.5)  );
  187.           Windows.SetWindow(v);
  188.           ForeColour(zyan);
  189.           SetPen(v,ox+1,oy); MoveTo(v, ox+3, oy);
  190.           SetPen(v,ox-1,oy); MoveTo(v, ox-3, oy);
  191.           SetPen(v,ox,oy+1); MoveTo(v, ox, oy+3);
  192.           SetPen(v,ox,oy-1); MoveTo(v, ox, oy-3);
  193.           ForeColour(black);
  194.           ox := NrPixels DIV 2; oy := ox;
  195.           SetPen(v,ox+1,oy); MoveTo(v, ox+3, oy);
  196.           SetPen(v,ox-1,oy); MoveTo(v, ox-3, oy);
  197.           SetPen(v,ox,oy+1); MoveTo(v, ox, oy+3);
  198.           SetPen(v,ox,oy-1); MoveTo(v, ox, oy-3);
  199.           Windows.ResetWindow;
  200.     WriteString ('continue Y/N:');
  201.     Read(ch); Write(CAP(ch)); WriteLn;
  202.     IF CAP(ch) # "Y" THEN EXIT END;
  203.   END;
  204.  
  205.   CloseGraphicWindow(w);
  206.   CloseGraphicWindow(v);
  207.  
  208.  
  209. END Mandelbrot.
  210.  
  211.