home *** CD-ROM | disk | FTP | other *** search
/ AMIGA PD 1 / AMIGA-PD-1.iso / Programme_zum_Heft / Programmieren / Kurztests / PascalPCQ / Examples / Mandel.p < prev    next >
Text File  |  1991-04-06  |  5KB  |  185 lines
  1. PROGRAM Mand;
  2.  
  3. {
  4.     Mandel.p is a Mandelbrot display program written by
  5.     Ralph Seguin, and included in the PCQ distribution with
  6.     his permission.  I don't know what the real and imaginary
  7.     components represent, but the following values produce a
  8.     reasonable image:
  9.         Real component     : 0.2
  10.         Imaginary comp    : 0.15
  11.         Zoom size    : 0.5
  12.         Iterations    : more than, say, 40
  13. }
  14.  
  15. {$I "Include:Exec/Ports.i"}
  16. {$I "Include:Intuition/Intuition.i"}
  17. {$I "Include:Graphics/Graphics.i"}
  18. {$I "Include:Graphics/Pens.i"}
  19. {$I "Include:Exec/Libraries.i"}
  20. {$I "Include:Graphics/View.i"}
  21. {$I "Include:Utils/Break.i"}
  22. {$I "Include:Utils/DateTools.i"}
  23.  
  24. VAR
  25.    H,V: INTEGER;        { Horizontal and vertical looping coordinates. }
  26.    K: INTEGER;          { Generic looping interger from Hell.  FOR K rules! }
  27.    W: WindowPtr;        { A pointer to our custom window after creation. }
  28.    S: Address;        { A pointer to our custom defined screen. }
  29.    RP: RastPortPtr;     { a pointer to a rastport structure (record) so we can do plotting in a rastport (window). }
  30.    CR,CI,T: REAL;       { Current real and imaginary and a temp real. }
  31.    ZR,ZI: REAL;         { Z-real and imaginary coordinates. }
  32.    B: BOOLEAN;          { Generic boolean from hell for loop breaking. }
  33.    MaxIter: INTEGER;    { Maximum number of iterations to perform. }
  34.    RealC,ImgC,Zoom: REAL;   { Coordinates for corner and zoom box size. }
  35.    HoriF,VertF: REAL;     { Horizontal and Vertical Factors. }
  36.  
  37.  
  38.  
  39.  
  40. PROCEDURE CleanExit(St:STRING; RC:INTEGER);
  41.  
  42. BEGIN
  43.    IF (W <> NIL) THEN
  44.       CloseWindow(W);
  45.  
  46.    IF (S <> NIL) THEN
  47.       CloseScreen(S);
  48.  
  49.    IF (GfxBase <> NIL) THEN
  50.       CloseLibrary(GfxBase);
  51.  
  52.    WRITELN(St);
  53.    Exit(RC);
  54. END;   { CleanExit() }
  55.  
  56.  
  57.  
  58.  
  59. PROCEDURE SetColors;
  60.  
  61. VAR
  62.    K: INTEGER;
  63.    VP: ADDRESS;
  64.  
  65. BEGIN
  66.    VP := ViewPortAddress(W);
  67.  
  68.    FOR K := 0 TO 31 DO
  69.       SetRGB4(VP,K,K DIV 2,K MOD 2, K MOD 11);   { Set color K to R,G,B values. }
  70.  
  71. END;
  72.  
  73.  
  74. PROCEDURE Init;
  75.  
  76. CONST
  77.    NW: NewWindow = (0,19,320,380,1,7,CLOSEWINDOW_f,
  78.                     WINDOWDRAG+WINDOWCLOSE+SMART_REFRESH+BORDERLESS+ACTIVATE,
  79.                     NIL,NIL,"<-- Click me to stop",NIL,NIL,0,0,0,0,CUSTOMSCREEN_f);
  80.  
  81.    NS: NewScreen = (0,0,320,400,5,1,7,4,CUSTOMSCREEN_f,NIL,
  82.                     "SmallMandel, by Ralph Seguin, ESC Inc.",
  83.                     NIL,NIL);    { Our NewScreen structure }
  84.  
  85.  
  86. BEGIN { Init }
  87.    GfxBase := OpenLibrary("graphics.library",0);   { Open up the graphics.library. }
  88. { The graphics.library contains routines to do all the basic graphics, lines, }
  89. { circles, etc.  If you plan to use any of these, it is necessary to open this }
  90. { Always remember to close a library after you are finished using it, otherwise }
  91. { you will make the system unsafe. }
  92.  
  93.  
  94.    IF (GfxBase = NIL) THEN
  95.       CleanExit("Mandel: Couldn't open graphics.library!",20);
  96.  
  97.    S := OpenScreen(Adr(NS));
  98.  
  99.    IF (S = NIL) THEN
  100.       CleanExit("Unable to open screen.",5);
  101.  
  102.    NW.Screen := S;   { We can't assign this dynamically }
  103.    W := OpenWindow(Adr(NW));
  104.  
  105.    IF (W = NIL) THEN
  106.       CleanExit("Unable to open window.",5);
  107.  
  108.    SetColors;
  109.    RP := W^.RPort;   { Get a pointer to the rastport for the window we opened. }
  110. { A rastport is required to do any sort of graphics rendering. }
  111.  
  112. END;  { Init }
  113.  
  114.  
  115. var
  116.     StartTime,
  117.     EndTime : DateDescription;
  118.  
  119.     Msg : MessagePtr;
  120.  
  121. BEGIN   { Main }
  122.  
  123.    WRITELN("       MandelHell 0.15, by Ralph Seguin.");
  124.    WRITELN;
  125.    WRITE("Enter real component: ");
  126.    READLN(RealC);
  127.    WRITE("Enter imaginary component: ");
  128.    READLN(ImgC);
  129.    WRITE("Enter zoom size: ");
  130.    READLN(Zoom);
  131.    WRITE("Maximum iteration count: ");
  132.    READLN(MaxIter);
  133.    Init;   { Initialize globals }
  134.    HoriF := Zoom / 320.0;
  135.    VertF := Zoom / 380.0;
  136.  
  137.    TimeDesc(StartTime);
  138.  
  139.    FOR V := 12 TO 380 DO BEGIN
  140.       CI := ImgC + VertF * Float(V);
  141.  
  142.       FOR H := 1 TO 320 DO BEGIN
  143.  
  144.          CR := HoriF * Float(H) + RealC;
  145.          ZR := 0.0;
  146.          ZI := 0.0;
  147.          B := TRUE;
  148.          K := 1;
  149.  
  150.          WHILE ((K <= MaxIter) AND B) DO BEGIN
  151.  
  152.             T := ZR;
  153.             ZR := Sqr(ZR) - Sqr(ZI) + CR;
  154.             ZI := 2.0 * T * ZI + CI;
  155.             K := SUCC(K);
  156.  
  157.             IF (Sqr(ZR) + Sqr(ZI) >= 4.0) THEN
  158.                B := FALSE;
  159.  
  160.          END;   { WHILE (K <= 100 AND B) }
  161.  
  162.          IF (K < MaxIter) THEN
  163.             SetAPen(RP,K MOD 31 + 1)
  164.          ELSE
  165.             SetAPen(RP,0);
  166.  
  167.          WritePixel(RP,H,V);
  168.       END;   { FOR H := 1 TO 100 }
  169.  
  170.       IF (CheckBreak() OR (GetMsg(W^.UserPort) <> NIL)) THEN BEGIN
  171.          WHILE (GetMsg(W^.UserPort) <> NIL) DO ;
  172.          CleanExit("Have a nice day.",0);
  173.       END;
  174.  
  175.    END;   { FOR V := 1 TO 80 }
  176.  
  177.    Msg := WaitPort(W^.UserPort);
  178.    repeat
  179.        Msg := GetMsg(W^.UserPort);
  180.        if Msg <> Nil then
  181.            ReplyMsg(Msg);
  182.    until Msg = Nil;
  183.    CleanExit("",0);
  184. END.
  185.