jac@paul.rutgers.edu (Jonathan A. Chandross) (02/11/91)
Submitted-by: Henry Throop
Posting-number: Volume 1, Source:26
Archive-name: games/mandel/pascal/throop
Architecture: ONLY_2gs
Version-number: 1.00
This is a little Mandelbrot generator I started about a year ago, but
because of compiler problems (summary: don't buy TML Pascal II) haven't
quite been able to complete it. However, this version does compile and
run, though maybe not with all the features I had intended.
=Read.Me
-
- MandelNET gs
-
-This is a little Mandelbrot generator I started about a year ago, but
-because of compiler problems (summary: don't buy TML Pascal II) haven't
-quite been able to complete it. However, this version does compile and
-run, though maybe not with all the features I had intended.
-
-The program is in two parts:
- - first compile "part_1" (creates a unit file in memory)
- - then compile "part_2" (the main program).
-
-This should work with some modification on ORCA/Pascal or MPW, but I
-haven't tried it.
-
-The indentation looks funny because TML's default font is proportional,
-which causes problems -> monospaced. Sorry.
-
-Mail me with questions about the algorithms or anything.
-
-Version 1.00
-
-Henry Throop
-Oregon State University
-Computer Science Deptartment
-throoph@jacobs.cs.orst.edu
-
=part_1
-
-
-{
- Henry Throop
- Oregon State University
- Computer Science Deptartment
- throoph@jacobs.cs.orst.edu
-}
-
-
-Unit Mandelstuf;
-
-INTERFACE
-
-USES Types, { GS Toolbox Units }
-
- Locator, { Tool 1 }
- Memory, { Tool 2 }
- MiscTool, { Tool 3 }
- QuickDraw, { Tool 4 }
- QDAux,
-
- Events, { Tool 6 }
- Desk, { Tool 5 }
- IntMath, { Tool 11 }
-
- Controls, { Tool 16 }
- Windows, { Tool 14 }
- Menus, { Tool 15 }
- LineEdit,
- Dialogs, { Tool 21 }
- StdFile, { Tool 23 }
-
- GSOS, { OS }
- Resources, { Resource Mgr }
- TMLUtils;
-
-TYPE
- complex = record
- x, y : extended
- end;
-
- plane = record {complex plane}
- x : extended;
- y : extended;
- minx : extended;
- maxx : extended;
- miny : extended;
- maxy : extended;
- incx : extended;
- incy : extended;
- sizex : integer;
- sizey : integer;
- countx : integer;
- county : integer;
- pprx : integer;
- ppry : integer;
- level : integer;
- ZoomRect : rect;
- end;
-
- SaveStuff = record
- data : plane;
- hndl : handle
- end;
-
-CONST { Resource IDs }
- kStartStopResID = 1;
- kMenuBarResID = 1;
-
- { Menu / Menu item IDs }
- kAppleMenuID = 300;
- kAboutItem = 301;
-
- kFileMenuID = 400;
- kOpenItem = 401;
- kCloseItem = 402;
- kQuitItem = 403;
-
- kMandelMenuID =500;
- kStartItem =501;
- kStopItem =502;
- kContItem =503;
- kZoomItem =505;
- kUnzoomItem =506;
- kIncLevItem =507;
- kSetItem =504;
- kEraseItem =508;
- kLev8Item =509;
-
- kNetworkMenuID =600;
- kNodeItem =601;
- kServerItem =602;
-
- kPaletteMenuID =700;
- kPal1Item =701;
- kPal2Item =702;
- kPal3Item =703;
- kPal4Item =704;
- kPal5Item =705;
- kPal6Item =706;
- kPal7Item =707;
- kCycleInItem =708;
- kCycleOutItem =709;
-
- { Window IDs }
- kWindow1ResID = 1000;
-
- kSTop =14; {coords for screen}
- kSBot =142;
- kSLeft =32;
- kSRight =288;
- kSWidth =256;
- kSHeight =128;
-
- kLN4 =1.386294;
- kLN2 =0.69314718;
-
-
-VAR gMyMemoryID: Integer;
- gStartStopRef: Ref;
-
- gMainEvent: EventRecord;
- gDone: Boolean;
-
- gMainWindow: WindowPtr;
- gMainRect: rect;
-
- gAppleMenu: str255;
- gFileMenu: str255;
- gMandelMenu: str255;
- gNetworkMenu: str255;
- gPaletteMenu: str255;
-
- gPlane: plane; {complex coords of screen}
- gLastPlane: array [1..20] of SaveStuff;
- gNumPlanes: integer;
-
- gMaxIterations: integer;
- gMirror: boolean; {if x-axis is in center}
-
- gPlotting: boolean;
-
- gZoomed: boolean; {gZoomRect currently
- displayed?}
- gLastCount: integer;
-
- TmpSaveHndl : handle;
- SHRPtr: ptr;
- PictPtr: ptr;
-
- gMaxIter : integer;
- gColorInc : integer; {number of values/color}
- gDwell : integer; {square of escape distance}
- gEventRecord : EventRecord;
- gNetwork : boolean;
-
- modem : text;
-
-procedure DoAbout; FORWARD;
-procedure DoOpen; FORWARD;
-procedure DoClose; FORWARD;
-procedure DoQuit; FORWARD;
-procedure SetUpMenus; FORWARD;
-procedure SetUpWindows; FORWARD;
-function DoCalc (origx, origy : extended) : integer; FORWARD;
-procedure DoErase; FORWARD;
-procedure DrawContentProc1; FORWARD;
-function B2I (b : boolean) : integer; FORWARD;
-procedure InitPalettes; FORWARD;
-procedure DoCycleIn; FORWARD;
-procedure DoCycleOut; FORWARD;
-procedure PlotPoint (cycles : integer; x, y : extended); FORWARD;
-procedure GetZoom; FORWARD;
-procedure DoZoom; FORWARD;
-procedure SetPalette (palette : integer); FORWARD;
-procedure DoLev8; FORWARD;
-procedure SaveScreen (desthndl : handle); FORWARD;
-procedure RestoreScreen (srchndl : handle); FORWARD;
-procedure SavePic (desthndl : handle); FORWARD;
-procedure RestorePic (srchndl : handle); FORWARD;
-
-IMPLEMENTATION
-
-procedure SaveScreen {(desthndl : handle)};
-begin
- HideCursor;
- MoveLeft (SHRPtr^, desthndl^^, 32768);
- ShowCursor
-end;
-
-procedure RestoreScreen {(srchndl : handle)};
-begin
- HideCursor;
- MoveLeft (srchndl^^, SHRPtr^, 32768);
- ShowCursor
-end;
-
-procedure SavePic {(desthndl : handle)};
-begin
- HideCursor;
- MoveLeft (PictPtr^, desthndl^^, 128*160);
- ShowCursor
-end;
-
-procedure RestorePic {(srchndl : handle)};
-begin
- HideCursor;
- MoveLeft (srchndl^^, PictPtr^, 128*160);
- ShowCursor
-end;
-
-procedure IncLev; external;
-
-procedure DoCycleOut;
-var i, temp : integer;
-begin
- repeat
- temp := GetColorEntry (0, 1);
- for i := 2 to 14 do
- SetColorEntry (0, i-1, GetColorEntry (0, i));
- SetColorEntry (0, 14, temp);
- for i := 1 to 6000 do;
- until (Button (0));
- {i := GetNextEvent;}
-end;
-
-procedure DoCycleIn;
-var i, temp : integer;
-begin
- repeat
- temp := GetColorEntry (0, 14);
- for i := 13 downto 1 do
- SetColorEntry (0, i+1, GetColorEntry (0, i));
- SetColorEntry (0, 1, temp);
- for i := 1 to 6000 do;
- until (Button (0));
-{ i := GetNextEvent;}
-end;
-procedure DoAbout;
-var ignore: Integer;
- aboutDlog : DialogPtr;
- r : rect;
-
-begin
- SetRect (r, 60, 30, 235, 170);
- aboutDlog := NewModalDialog (r, true, 0);
- SetPort (aboutDlog);
- SetRect (r, 130, 110, 165, 125);
- NewDItem (aboutDlog, 1, r, 10, @'OK', 0, 0, nil);
- SetForeColor (0);
- SetBackColor (15);
- MoveTo (20, 15); DrawString ('MandelNET v0.3')
- MoveTo (20, 35); DrawString ('A Mandlebrot set');
- MoveTo (20, 46); DrawString ('generator utilizing');
- MoveTo (20, 57); DrawString ('parallel processing');
- MoveTo (20, 76); DrawString ('throoph@jacobs.cs.orst.edu.');
- ignore := ModalDialog (nil);
- CloseDialog (aboutDlog);
- SetPort (gMainWindow);
- SetPortRect (gMainWindow^.portRect);
-end;
-
-
-procedure DoErase;
-var r : rect;
-begin
- SetRect (r, kSLeft, kSTop, kSRight+1, kSBot);
- EraseRect (r);
-end;
-
-function B2I {(b : boolean) : integer};
-begin
- if b = true then
- B2I := 1
- else
- B2I := 0
-end;
-
-procedure DoClose;
-var theWindow: WindowPtr;
-begin
- theWindow := FrontWindow;
- if theWindow <> nil then
- if GetWKind (theWindow) <> 0 then
- CloseNDAByWinPtr (theWindow)
- else
- begin
- CloseWindow(theWindow);
- gPlotting := false;
- DisableMItem (kStartItem);
- DisableMItem (kStopItem);
- DisableMItem (kContItem);
- DisableMItem (kIncLevItem);
- DisableMItem (kSetItem);
- DisableMItem (kCloseItem);
- DisableMItem (kZoomItem);
- EnableMItem (kOpenItem)
- end;
-end;
-
-
-procedure DoQuit;
-begin
- {DoClose;}
- gDone := true;
-end;
-
-procedure PlotPoint {(cycles : integer; x, y: extended)};
-var r: rect;
- temp : integer;
- sx, sy : integer; {screen x/y coords for UL corner of pt}
- oldpt : point;
- by : integer; {bottom coords}
-begin
- sx := kSLeft + round (((x-gPlane.minx)/(gPlane.maxx-gPlane.minx))*kSWidth);
- sy := kSTop + round (((y-gPlane.miny)/(gPlane.maxy-gPlane.miny))*kSHeight);
- SetSolidPenPat((cycles div gColorInc) mod 14 + 1);
- if cycles = gMaxIter then
- SetSolidPenPat (0);
- SetPenSize (1, gPlane.sizey);
- if gPlane.countx = 0 then MoveTo (sx, sy);
- GetPen (oldpt);
- SetPenMode (modeXOR);
- LineTo (sx, sy);
- SetPenMode (modeCopy);
- MoveTo (oldpt.h, oldpt.v);
- LineTo (sx, sy);
- if gMirror then
- begin
- if gPlane.y >= 0 then
- begin
- with gPlane do begin
- countx := 600; county := 600; {SetPenSize (0,0);} end;
- end
- else
- begin
- by := kSTop+(ksBot-(oldpt.v+gPlane.sizey));
- SetPenMode (modeXOR);
- MoveTo (oldpt.h, by);
- LineTo (sx, by);
- SetPenMode (modeCopy);
- LineTo (oldpt.h, by);
- MoveTo (sx, sy)
- end;
- end;
-end;
-
-procedure GetZoom;
-var r : rect;
- OldLoc, NewLoc, Temp : point;
- temp2 : boolean;
- option : integer;
-begin
- if gZoomed then FrameRect (gPlane.ZoomRect); {clear old rect}
- GetMouse (OldLoc);
- NewLoc := OldLoc;
- SetSolidPenPat ($f);
- SetPenSize (1,1);
- SetPenMode (modeXOR);
- while (StillDown(0)) do
- begin
- r.top := OldLoc.v*B2I(OldLoc.v<NewLoc.v)+NewLoc.v*
- B2I(OldLoc.v>NewLoc.v);
- r.bottom := OldLoc.v*B2I(NewLoc.v<OldLoc.v)+NewLoc.v*
- B2I(NewLoc.v>OldLoc.v);
- r.left := OldLoc.h*B2I(OldLoc.h<NewLoc.h)+NewLoc.h*
- B2I(OldLoc.h>NewLoc.h);
- r.right := OldLoc.h*B2I(NewLoc.h<OldLoc.h)+NewLoc.h*
- B2I(NewLoc.h>OldLoc.h);
- if r.right > kSRight then r.right := kSRight;
- if r.left < kSLeft then r.left := kSLeft;
- if r.top < kSTop then r.top := kSTop;
- if r.bottom > kSBot then r.bottom := kSBot;
- {now test for all cases and adjust rect so horizontal is 2x vertical
- size so magnifications isn't distorted}
- temp2 := GetNextEvent (-1, gEventRecord);
- option := BAND (optionkey, gEventRecord.modifiers);
- if option <> optionKey then {if option isn't down then constrain rect}
- begin
- if ((newloc.h>oldloc.h)and(newloc.v>oldloc.v)) then {bottom right}
- if 2*(r.bottom-r.top)>(r.right-r.left) then
- r.bottom := r.top+round(0.5*(r.right-r.left))
- else r.right := r.left+round(2*(r.bottom-r.top))
- else if ((newloc.h>oldloc.h)and(newloc.v<oldloc.v)) then {upper right}
- if 2*(r.bottom-r.top)>(r.right-r.left) then
- r.top := r.bottom-round(0.5*(r.right-r.left))
- else r.right := r.left+round(2*(r.bottom-r.top))
- else if ((newloc.h<oldloc.h)and(newloc.v<oldloc.v)) then {upper left}
- if 2*(r.bottom-r.top)>(r.right-r.left) then
- r.top := r.bottom-round(0.5*(r.right-r.left))
- else r.left := r.right-round(2*(r.bottom-r.top))
- else if ((newloc.h<oldloc.h)and(newloc.v>oldloc.v)) then {lower left}
- if 2*(r.bottom-r.top)>(r.right-r.left) then
- r.bottom := r.top+round(0.5*(r.right-r.left))
- else r.left := r.right-round(2*(r.bottom-r.top))
- end;
- FrameRect(r);
- repeat
- GetMouse (Temp)
- until ((Temp.h <> NewLoc.h) or (Temp.v <> NewLoc.v) or
- (not Button(0)));
- NewLoc := Temp;
- FrameRect(r);
- end;
- if ((r.right > r.left) and (r.bottom > r.top))
- then {if it's a valid rect}
- begin
- gPlane.ZoomRect := r;
- FrameRect (gPlane.ZoomRect);
- EnableMItem (kZoomItem);
- EnableMItem (kContItem);
- gPlotting := false;
- gZoomed := true
- end
- else
- begin
- gZoomed := false;
- DisableMItem (kZoomItem)
- end;
-end;
-
-procedure DoZoom;
-var height, width, oldx, oldy : extended;
-begin
- if gNumPlanes < 20 then {save current plane for UnZoom}
- begin
- gLastPlane[gNumPlanes+1].data := gPlane;
- gNumPlanes := gNumPlanes + 1;
- EnableMItem (kUnzoomItem);
- FrameRect (gPlane.ZoomRect); {xor out old rect}
- gLastPlane[gNumPlanes].hndl := NewHandle (128*160, gMyMemoryID,
- attrNoPurge, nil);
- SavePic (gLastPlane[gNumplanes].hndl);
- end;
- DisableMItem (kZoomItem);
- with gPlane do
- begin
- oldx := minx;
- oldy := miny;
- width := maxx - minx;
- height := maxy - miny;
- minx := oldx + width*((gPlane.ZoomRect.left-kSLeft)/kSWidth);
- maxx := oldx + width*((gPlane.ZoomRect.right-kSLeft)/kSWidth);
- miny := oldy + height*((gPlane.ZoomRect.top-kSTop)/kSHeight);
- maxy := oldy + height*((gPlane.ZoomRect.bottom-kSTop)/kSHeight);
- level := 0;
- end;
- gPlotting := true;
- gZoomed := false;
- IncLev; {initializes for new level}
- EnableMItem (kIncLevItem);
- if gPlane.miny <> -(gPlane.maxy) then
- gMirror := false
- else
- gMirror := true;
- EraseRect (gMainRect);
-end;
-
-procedure SetUpMenus;
-var height : integer;
-begin
- gAppleMenu := concat ('>>@\XN300\0',
- '==About MandelNET...\N301\0',
- '==-\N999D\0.');
- gFileMenu := concat ('>> File \N400\0',
- '==Open\N401*Oo\0',
- '==Close\N402*Ww\0',
- '==Quit\N403*Qq\0.');
- gMandelMenu := concat ('>> Mandel \N500\0',
- '==Start\N501*Tt\0',
- '==Stop\N502*. \0',
- '==Continue\N503*Cc\0',
- '==Zoom\N505*Zz\0',
- '==Unzoom\N506*Uu\0',
- '==Next Level\N507*Nn\0',
- '==Level 8\N509*8 \0',
- '==Erase\N508*Ee\0',
- '==-\N999D\0',
- '==Settings...\N504*Ee\0.');
- gNetworkMenu := concat ('>> Network \N600\0',
- '==Node...\N601D\0',
- '==Server...\N602\0.');
- gPaletteMenu := concat ('>> Palettes \N700\0',
- '==#1\N701*1 \0',
- '==#2\N702*2 \0',
- '==#3\N703*3 \0',
- '==#4\N704*4 \0',
- '==#5\N705*5 \0',
- '==#6\N706*6 \0',
- '==#7\N707*7 \0',
- '==-\N999D\0',
- '==Cycle in\N708\0',
- '==Cycle out\N709\0.');
-
- SetMTitleStart (10);
- InsertMenu(NewMenu(@gPaletteMenu[1]),0);
- InsertMenu(NewMenu(@gNetworkMenu[1]),0);
- InsertMenu(NewMenu(@gMandelMenu[1]),0);
- InsertMenu(NewMenu(@gFileMenu[1]),0);
- InsertMenu(NewMenu(@gAppleMenu[1]),0);
- FixAppleMenu (kAppleMenuID);
- height := FixMenuBar;
- DrawMenuBar;
-end;
-
-procedure SetUpWindows;
-begin
- gMainWindow := NewWindow2 (nil, 0,@DrawContentProc1, nil,
- refIsResource, Ref(kWindow1ResID), rWindParam1);
- SetPort (gMainWindow);
- SetPortRect (gMainWindow^.portRect);
- TmpSaveHndl := NewHandle (32768, gMyMemoryID, attrNoPurge, nil);
- SHRPtr := pointer ($e12000);
- PictPtr := pointer ($e12000+38*160)
-end;
-
-procedure DrawContentProc1;
-begin
- {MoveRight (savehand^^, e1^, 32768)}
-end;
-procedure DoSettings; begin end;
-procedure DoSave; begin end;
-Procedure DoOpen;
-var theReply: SFReplyRec2;
- nameC1OutputStr: ResultBuf255Hndl;
- pathC1OutputStr: ResultBuf255Hndl;
- pFileNameHndl: String255Hndl;
- parmsOpen : OpenRecGS;
- parmsRead : IORecGS;
- parmsClose : RefNumRecGS;
- pict : handle;
- TypeList : SFTypeList2;
- prompt : Str255;
- i : integer;
-begin
- SaveScreen (TmpSaveHndl);
- prompt := 'Load what pic?';
- theReply.nameDesc := refIsNewHandle;
- theReply.pathDesc := refIsNewHandle;
- TypeList.numEntries := 1;
- TypeList.fileTypeEntries[1].flags := $8000;
- TypeList.fileTypeEntries[1].fileType := $00C1;
- TypeList.fileTypeEntries[1].auxType := $00000000;
- SFGetFile2 (20, 20, RefIsPointer, Ref (@prompt), nil, @TypeList, theReply);
- if theReply.good then
- begin
- WaitCursor;
- nameC1OutputStr := ResultBuf255Hndl (theReply.nameRef.refIsNewHandle);
- pathC1OutputStr := ResultBuf255Hndl (theReply.pathRef.refIsNewHandle);
- pFileNameHndl := String255Hndl (NewHandle (
- nameC1OutputStr^^.bufstring.length+1,
- gMyMemoryID, attrNoCross+attrLocked, Ptr (0)));
- GS2PString (nameC1OutputStr^^.bufstring, pFileNameHndl^^);
- parmsOpen.pCount := 2;
- parmsOpen.pathname := @pathC1OutputStr^^.bufstring;
- OpenGS (parmsOpen);
- if _ToolErr <> noerror then begin i := _ToolErr; GrafOff;
- writeln ('open ', i); readln; Grafon end;
- {gTempHandle := NewHandle ($00008000, gMyMemoryID, attrlocked, nil);
- }parmsRead.pCount := 4;
- parmsRead.refnum := parmsOpen.refnum;
- parmsRead.databuffer := TmpSaveHndl^;
- parmsRead.requestCount := $00007dc8;
- ReadGS (parmsRead);if _ToolErr <> noerror then begin i := _ToolErr; GrafOff;
- writeln ('read ', i); readln; Grafon end;
-
-
- parmsClose.pCount := 1;
- parmsClose.refnum := parmsOpen.refnum;
- CloseGS (parmsClose);
- if _ToolErr <> noerror then begin i := _ToolErr; GrafOff;
- writeln ('close ', i); readln; Grafon end;
-
- DisposeHandle (Handle (nameC1OutputStr));
- DisposeHandle (handle (pathC1OutputStr));
- DisposeHandle (handle (pFileNameHndl));
-
- InitCursor; gPlotting := false;{
- if (FrontWindow <> nil) then CloseWindow (gMainWindow);
- gMainWindow := NewWindow2
- (@theReply.filename,0, @DrawContentProc1,
- nil, refIsResource, Ref(kWindow1ResID), rWindParam1);
- SetPort (gMainWindow);
- EraseRect (gMainRect);}
- EnableMItem (kCloseItem);
- EnableMItem (kStartItem);
- end; RestoreScreen (TmpSaveHndl);
-end;
-
-procedure InitPalettes;
-var temp : ColorTable;
-begin
- StuffHex (pointer($E19F20), {RAINBOW}
- '0000D00FB00F900F400F000F080F0F0F0F0B0F070F008F00F004F00BF00FFF0F');
- StuffHex (pointer($E19F40), {SUNSET}
- '0000E80EB00F800E510E310E120D140D170D2A0E3D0E4E0C4E0A5E086F07FF0F');
- StuffHex (pointer($E19F60), {ABALONE}
- '0000F40FE309D202B602AA0159000800190329063A094B0C6A0D8A0EAA0FFF0F');
- StuffHex (pointer($E19F80), {PARROT}
- '0000D200B400960078005A003C000F000D020B0409060708050A030C010EFF0F');
- StuffHex (pointer($E19FA0), {TUT}
- '000059054804270215010400100320043005400640076108720A930DC50FFF0F');
- StuffHex (pointer($E19FC0), {GREY SCALE}
- '0000110122023303440455056606770788089909AA0ABB0BCC0CDD0DEE0EFF0F');
- StuffHex (pointer($E19FE0), {RED SCALE}
- '0000000100020003000400050006000700080009000A000B000C000D000E000F');
- GetColorTable (9, temp);
- SetColorTable (0, temp);
- (*
- StuffHex (pointer($E19E00), '0000770741082C070F008000700F000D');
- StuffHex (pointer($E19E10), 'A90FF00FE000DF04AF0D8F07CC0CFF0F');
- StuffHex (pointer($E19E20), '0000FD00EF007F000F060F0A0F0E080F');
- StuffHex (pointer($E19E30), '000F500FA00FF00FF008D200CA00FF0F');
- StuffHex (pointer($E19EA0), '0000E80ECA0C8D0C8F096F039E009D03');
- StuffHex (pointer($E19EB0), '7B055A074208400B820D800EF40FFF0F');
- StuffHex (pointer($E19EC0), '0000B00F500E010D050C0A0D0D0B0E07');
- StuffHex (pointer($E19ED0), '2E048E04DE07FD09FD0CFB0DFB0FFF0F');
- StuffHex (pointer($E19F20), '00001101220233034404550566067707')
- *)
-end;
-
-procedure SetPalette {(palette : integer)};
-var i : integer;
-temp : colortable;
-begin
- for i := kPal1Item to kPal7Item do
- CheckMItem (false, i);
- GetColorTable (palette-kPal1Item+9, temp);
- SetColorTable (0, temp);
- CheckMItem (true, palette);
-end;
-
-
-procedure DoLev8;
-begin
- gPlane.level := 7;
- IncLev;
- gPlotting := true;
-end;
-
-
-Function DoCalc (origx, origy : extended) : integer;
-var i : integer;
- xo, yo, xi, yi, temp : longint;
-begin
- xo := round (origx*1024); xi := xo;
- yo := round (origy*1024); yi := yo;
- i := 0;
- while (((xi*xi+yi*yi)<2097152) and (i <= 50)) do
- begin
- temp := (xi*xi) div 1024 - (yi*yi) div 1024;
- yi := (2*yi*xi) div 1024;
- xi := temp;
- i := i + 1;
- end;
- DoCalc := i;
-end;
-
-end.
-
=part_2
-
-
-{
- Henry Throop
- Oregon State University
- Computer Science Deptartment
- throoph@jacobs.cs.orst.edu
-}
-
-
-PROGRAM Mandel;
-
-USES TYPES, { GS Toolbox Units }
-
- Locator, { Tool 1 }
- Memory, { Tool 2 }
- MiscTool, { Tool 3 }
- QuickDraw, { Tool 4 }
-
- Events, { Tool 6 }
- Desk, { Tool 5 }
- IntMath, { Tool 11 }
-
- Controls, { Tool 16 }
- Windows, { Tool 14 }
- Menus, { Tool 15 }
-
- LineEdit, { Tool 20 }
- Dialogs, { Tool 21 }
-
- StdFile, { Tool 23 }
-
- GSOS, { OS }
- Resources, { Resource Mgr }
- QDAux,
- TMLUtils,
- mandelstuf;
-
-TYPE
- CursorType = record
- height : integer;
- width : integer;
- data : array [1..9] of packed array [1..8] of byte;
- mask : array [1..9] of packed array [1..8] of byte;
- HotSpot : point;
- end;
- (*
- complex = record
- x, y : extended
- end;
-
- plane = record {complex plane}
- x : extended;
- y : extended;
- minx : extended;
- maxx : extended;
- miny : extended;
- maxy : extended;
- incx : extended;
- incy : extended;
- sizex : integer;
- sizey : integer;
- countx : integer;
- county : integer;
- pprx : integer;
- ppry : integer;
- level : integer;
- end;
-
-CONST { Resource IDs }
- kStartStopResID = 1;
- kMenuBarResID = 1;
-
- { Menu / Menu item IDs }
- kAppleMenuID = 300;
- kAboutItem = 301;
- kFileMenuID = 400;
- kOpenItem = 401;
- kCloseItem = 402;
- kQuitItem = 403;
-
- kMandelMenuID =500;
- kStartItem =501;
- kStopItem =502;
- kContItem =503;
- kZoomItem =505;
- kUnzoomItem =506;
- kIncLevItem =507;
- kSetItem =504;
-
- kNetworkMenuID =600;
- kNodeItem =601;
- kServerItem =602;
-
- kPaletteMenuID =700;
- kPal1Item =701;
- kPal2Item =702;
- kPal3Item =703;
- kPal4Item =704;
- kPal5Item =705;
- kPal6Item =706;
- kPal7Item =707;
-
- { Window IDs }
- kWindow1ResID = 1000;
-
- kSTop =10; {coords for screen}
- kSBot =138;
- kSLeft =32;
- kSRight =288;
- kSWidth =256;
- kSHeight =128;
-
- kLN4 =1.386294;
- kLN2 =0.69314718;
-
-
-VAR gMyMemoryID: Integer;
- gStartStopRef: Ref;
-
- gMainEvent: EventRecord;
- gDone: Boolean;
-
- gMainWindow: WindowPtr;
-
- gAppleMenu: str255;
- gFileMenu: str255;
- gMandelMenu: str255;
- gNetworkMenu: str255;
- gPaletteMenu: str255;
-
- gPlane: plane; {complex coords of screen}
- gLastPlane: array [1..20] of plane;
- gNumPlanes: integer;
-
- gMaxIterations: integer;
- gMirror: boolean; {if x-axis is in center}
-
- gPlotting: boolean;
-
- gZoomRect: rect;
- gZoomed: boolean; {gZoomRect currently
- displayed?}
- gLastCount: integer;
-
-
- *)
-var gOffScreenPort : GrafPortPtr;
- gOffScreenPixImage : ptr;
- gOnScreenPixImage : ptr;
- gOffScreenLocInfo : locInfo;
- gOnScreenLocInfo : LocInfo;
- gOldsy : integer;
- gZoomCursor : CursorType;
- gInZoom : boolean; {cursor in drawing region?}
- gUseLevels : boolean;
-
-procedure DoStart; FORWARD;
-procedure DoStop; FORWARD;
-procedure DoCont; FORWARD;
-procedure DoUnzoom; FORWARD;
-procedure IncLev; FORWARD;
-procedure DoSettings; FORWARD;
-
-procedure InitializeGlobals; FORWARD;
-procedure MainEventLoop; FORWARD;
-procedure HandleMenu; FORWARD;
-procedure DoNextPoint; FORWARD;
-procedure SetUpCursor; FORWARD;
-procedure CheckCursor; FORWARD;
-procedure SetNetwork; FORWARD;
-procedure DoNextLine; FORWARD;
-procedure PlotLine; FORWARD;
-
-procedure SetUpCursor;
-begin
- gZoomCursor.height := 9;
- gZoomCursor.width := 4;
- gZoomCursor.Hotspot.v := 6;
- gZoomCursor.Hotspot.h := 6;
-
- StuffHex(@gZoomCursor.Data[1], '0000000000000000');
- StuffHex(@gZoomCursor.Data[2], '0000000000000000');
- StuffHex(@gZoomCursor.Data[3], '0000000000000000');
- StuffHex(@gZoomCursor.Data[4], 'F000000000F00000');
- StuffHex(@gZoomCursor.Data[5], '0000000000000000');
- StuffHex(@gZoomCursor.Data[6], 'F0000F0000F00000');
- StuffHex(@gZoomCursor.Data[7], '00000F0000000000');
- StuffHex(@gZoomCursor.Data[8], '00000F0000000000');
- StuffHex(@gZoomCursor.Data[9], '0000FFF000000000');
- StuffHex(@gZoomCursor.Mask[1], '00000F0000000000');
- StuffHex(@gZoomCursor.Mask[2], '00000F0000000000');
- StuffHex(@gZoomCursor.Mask[3], '00000F0000000000');
- StuffHex(@gZoomCursor.Mask[4], '00000F0000000000');
- StuffHex(@gZoomCursor.Mask[5], 'FFFFF0FFFFF00000');
- StuffHex(@gZoomCursor.Mask[6], '00000F0000000000');
- StuffHex(@gZoomCursor.Mask[7], '00000F0000000000');
- StuffHex(@gZoomCursor.Mask[8], '00000F0000000000');
- StuffHex(@gZoomCursor.Mask[9], '00000F0000000000');
- gInZoom := false;
-
- gUseLevels := true;
- gNetwork := true;
- CheckMItem (false, kServerItem);
- rewrite (modem, '.DEV4');{
- writeln (modem, 'ato0');}
- writeln (modem, chr (3));
- writeln (modem, 'a.out');
- readln (modem);
-end;
-
-procedure SetNetwork;
-begin
- gNetwork := not gNetwork;
- CheckMItem (gNetwork, kServerItem);
-end;
-
-procedure DoUnzoom;
-begin
- gPlotting := true;
- gZoomed := false;
- gPlane.level := 1;
- EnableMItem (kZoomItem);
- gPlane := gLastPlane [gNumPlanes].data;
- if gPlane.miny = -(gPlane.maxy) then
- gMirror := true
- else
- gMirror := false;
- gNumPlanes := gNumPlanes - 1 ;
- if gNumPlanes = 0 then DisableMItem (kUnZoomItem);
- RestorePic (gLastPlane[gNumPlanes+1].hndl);
- DisposeHandle (gLastPlane[gNumPlanes+1].hndl);
- gZoomed := true;
- EnableMItem (kContItem);
- gPlotting := false;
- SetPenMode (modeXOR);
- SetPenSize (1,1);
- SetSolidPenPat ($f);
- FrameRect (gPlane.ZoomRect);
- MoveTo (0, 155); write (gPlane.minx:4:4);
- MoveTo (140, 9); write (gPlane.miny:4:4);
- MoveTo (250, 155); write (gPlane.maxx:4:4);
- MoveTo (140, 160); write (gPlane.maxy:4:4);
- MoveTo (0, 171); write ('Level: ',gPlane.level);
- MoveTo (
- kSLeft + round (((gPlane.x-gPlane.minx)/(gPlane.maxx-gPlane.minx))*kSWidth) ,
- kSTop + round (((gPlane.y-gPlane.miny)/(gPlane.maxy-gPlane.miny))*kSHeight ));
-end;
-
-procedure InitializeGlobals;
-begin
- with gPlane do
- begin
- minx := -2.0; {complex coords}
- maxx := 1.0;
- miny := -1.25;
- maxy := 1.25;
- level := 0;
- end;
-
- gZoomed := false;
- SetRect (gMainRect , kSLeft, kSTop, kSRight+1, kSBot);
- gMaxIter := 20;
- gDwell := 2;
- gColorInc := 1;
- gPlotting := false;
- if gPlane.miny = -gPlane.maxy then
- gMirror := true;
-
- gNumPlanes := 0;
- SetPalette (kPal1Item);
- IncLev;
- DisableMItem (kUnzoomItem);
- DisableMItem (kZoomItem);
- DisableMItem (kContItem);
- EnableMItem (kOpenItem);
- EnableMItem (kIncLevItem);
- CheckMItem (true, kPal1Item)
-end;
-
-procedure CheckCursor;
-var r : rect;
- loc : point;
-
-begin
- SetRect (r, kSLeft, kSTop, kSRight, kSBot);
- GetMouse (loc);
- if ((PtInRect (loc, r)) and (not gInZoom)) then
- begin
- {SetCursor (CursorPtr (@gZoomCursor)^);
- }gInZoom := true
- end
- else if (not (PtInRect (loc, r)) and (gInZoom)) then
- begin
- InitCursor;
- gInZoom := false
- end;
-end;
-procedure MainEventLoop;
-var code: Integer;
-begin
- gMainEvent.wmTaskMask := $001FFFFF;
- gDone := false;
-
- repeat
- code := TaskMaster($FFFF,gMainEvent);
- case code of
- wInGoAway: DoClose;
- wInSpecial,
- wInMenuBar: HandleMenu;
- wInContent: if gPlane.level > 1 then GetZoom;
- end;
- if gPlotting then
- if gNetwork then DoNextLine
- else DoNextPoint;
- until gDone;
-end;
-
-function s2r (s : str255) : extended;
-const kLN10 = 2.30258509299;
-var i : integer;
- decimal : boolean;
- expo : boolean;
- negative : boolean;
- ans : extended;
- level : integer;
- len : integer;
-begin
- len := length (s);
- i := 1;
- decimal := false;
- expo := false;
- negative := false;
- ans := 0;
- while ((i <= len) and (not decimal)) do
- begin
- if s[i] in ['0'..'9'] then
- ans := ans * 10 + ord (s[i])-48;
- if s[i] = '-' then negative := true;
- i := i + 1;
- if s[i] = '.' then decimal := true;
- end;
- level := i;
- i := i + 1;
- while ((i <= len) and (not expo)) do
- begin
- if s[i] in ['0'..'9'] then
- begin
- ans := ans + (ord (s[i])-48)*exp ((level - i)*kLN10);
- end;
- if s[i] = 'e' then expo := true;
- i := i + 1;
- end;
- if expo then
- case s[i] of
- '+' : ans := ans * exp((ord (s[i+1])-48)*kLN10);
- '-' : ans := ans * exp(-(ord (s[i+1])-48)*kLN10)
- end;
- if negative then ans := -ans;
- S2R := ans;
- end;
-procedure DoSettings;
-var r : rect;
- setDlog : DialogPtr;
- itemHit : integer;
- iterations : str255;
- minx, maxx, miny, maxy : str255;
- redraw : boolean;
- minxo, maxxo, minyo, maxyo : str255;
- dwell : str255;
- colorinc : str255;
- level, levelo : str255;
-
-begin
- SaveScreen (TmpSaveHndl);
- redraw := false;
- minx := real2string (gPlane.minx); minxo := minx;
- miny := real2string (gPlane.miny); minyo := miny;
- maxy := real2string (gPlane.maxy); maxyo := maxy;
- maxx := real2string (gPlane.maxx); maxxo := maxx;
- iterations := int2string (gMaxIter);
- colorinc := int2string (gColorInc);
- level := int2string (gPlane.level); levelo := level;
- dwell := int2string (gDwell);
- SetRect (r, 16, 20, 300, 190);
- setDlog := NewModalDialog (r, true, 0);
- SetPort (windowPtr(Ord4(setDlog)));
- SetRect (r, 50, 142, 0,0);
- NewDItem (setDlog, 1, r, 10, @'OK', 0, 0, nil);
- SetRect (r, 130, 142, 0,0);
- NewDItem (setDlog, 2, r, 10, @'Cancel', 0, 0, nil);
- SetRect (r, 20, 10, 140, 21);
- NewDItem (setDlog, 3, r, 15, @'Left coord', 0, 0, nil);
- SetRect (r, 20, 21, 140, 35);
- NewDItem (setDlog, 4, r, 15, @'Top coord', 0, 0, nil);
- SetRect (r, 20, 35, 140, 49);
- NewDItem (setDlog, 5, r, 15, @'Right coord', 0, 0, nil);
- SetRect (r, 20, 49, 140, 63);
- NewDItem (setDlog, 6, r, 15, @'Bottom coord', 0, 0, nil);
- SetRect (r, 20, 67, 140, 81);
- NewDItem (setDlog, 7, r, 15, @'Iteration limit', 0, 0, nil);
- SetRect (r, 145, 67, 195, 81);
- NewDItem (setDlog, 8, r, 17, @iterations, 3, 0, nil);
- SetRect (r, 145, 10, 275, 21);
- NewDItem (setDlog, 9, r, 17, @minx, 255, 0, nil);
- SetRect (r, 145, 21, 275, 35);
- NewDItem (setDlog, 10, r, 17, @miny, 255, 0, nil);
- SetRect (r, 145, 35, 275, 49);
- NewDItem (setDlog, 11, r, 17, @maxx, 255, 0, nil);
- SetRect (r, 145, 49, 275, 63);
- NewDItem (setDlog, 12, r, 17, @maxy, 255, 0, nil);
- SetRect (r, 20, 124, 200,137);
- NewDItem (setDlog, 13, r, 11, @'Use Levels', ord (gUseLevels), 0, nil);
- SetRect (r, 20, 81, 140, 95);
- NewDItem (setDlog, 14, r, 15, @'Color increment', 0, 0, nil);
- SetRect (r, 20, 95, 140, 109);
- NewDItem (setDlog, 15, r, 15, @'Dwell', 0, 0, nil);
- SetRect (r, 145, 81, 195, 95);
- NewDItem (setDlog, 16, r, 17, @colorinc, 255, 0, nil);
- SetRect (r, 145, 95, 195, 109);
- NewDItem (setDlog, 17, r, 17, @dwell, 4, 0, nil);
- SetRect (r, 20, 109, 140, 124);
- NewDItem (setDlog, 18, r, 15, @'Level', 0, 0, nil);
- SetRect (r, 145, 109, 175, 124);
- NewDItem (setDlog, 19, r, 17, @level, 1, 0, nil);
- repeat
- itemHit := ModalDialog (nil);
- if itemHit = 13 then SetDItemValue (abs(1-GetDItemValue (setDlog, 13)), setDlog, 13)
- until itemHit < 3;
- gUseLevels := (GetDItemValue (setDlog, 13)=1);
- if itemHit = 1 then
- begin
- WaitCursor;
- GetIText (setDlog, 9, minx);
- GetIText (setDlog, 10, miny);
- GetIText (setDlog, 11, maxx);
- GetIText (setDlog, 12, maxy);
- GetIText (setDlog, 8, iterations);
- GetIText (setDlog, 16, colorinc);
- GetIText (setDlog, 17, dwell);
- GetIText (setDlog, 19, level);
- if maxxo <> maxx then begin gPlane.maxx := S2R(maxx); redraw := true end;
- if minxo <> minx then begin gPlane.minx := S2R(minx); redraw := true end;
- if maxyo <> maxy then begin gPlane.maxy := S2R(maxy); redraw := true end;
- if minyo <> miny then begin gPlane.miny := S2R(miny); redraw := true end;
- gMaxIter := String2Int (iterations);
- gDwell := String2Int (dwell);
- gColorInc := String2Int (colorinc) + B2I (gColorInc = 0);
- end;
- gMirror := (gPlane.miny=-gPlane.maxy);
- CloseDialog (setDlog);
- SetPort (gMainWindow);
- RestoreScreen (TmpSaveHndl);
- if redraw then
- begin
- DoErase;
- gPlane.level := 0;
- IncLev;
- end;
- if level <> levelo then
- begin
- gPlane.level := (String2Int (level)) - 1;
- IncLev
- end;
- if ((not gUseLevels) and (gPlane.level <> 8)) then IncLev;
- InitCursor;
-end;
-
-procedure DoCont;
-begin
- gPlotting := true;
- if gZoomed then FrameRect (gPlane.ZoomRect);
- gZoomed := false;
- DisableMItem (kZoomItem);
- DisableMItem (kContItem);
- EnableMItem (kStopItem);
-end;
-
-Procedure DoStop;
-begin
- if gZoomed then
- begin
- gZoomed := false;
- FrameRect (gPlane.ZoomRect);
- DisableMItem (kZoomItem)
- end;
- gPlotting := false;
- DisableMItem (kStopItem);
- EnableMItem (kContItem);
-end;
-
-
-Procedure IncLev;
-var r : rect;
- info, info2 : locInfo;
-begin
- if not gUseLevels then gPlane.level := 8;
- if gZoomed then
- begin
- FrameRect (gPlane.ZoomRect);
- DisableMItem (kZoomItem);
- gZoomed := false;
- end;
- gPlane.level := gPlane.level + 1;
- if gPlane.level > 8 then
- begin
- DisableMItem (kIncLevItem);
- gPlane.level := 8;
- end;
- gPlotting := true;
- with gPlane do
- begin
- pprx := round (exp (((level-1)/2)*kLN4))*2;
- ppry := round (exp (((level-1)/2)*kLN4));
- incx := (maxx-minx)/pprx;
- incy := (maxy-miny)/ppry;
- sizex := round ((kSWidth/exp((level-1)*kLN2)));
- sizey := round ((kSHeight/exp((level-1)*kLN2)));
- countx := 0;
- county := 0;
- x := minx;
- y := miny;
- end;
- MoveTo (0, 155); write (gPlane.minx:4:4);
- MoveTo (140, 9); write (gPlane.miny:4:4);
- MoveTo (250, 155); write (gPlane.maxx:4:4);
- MoveTo (140, 160); write (gPlane.maxy:4:4);
- MoveTo (0, 171); write ('Level: ',gPlane.level);
- MoveTo (kSLeft, kSTop);
- gLastCount := DoCalc (gPlane.minx, gPlane.miny);
-end;
-
-Procedure DoStart; {restarts new plot}
-var level, i : integer;
- r : rect;
-begin
- InitializeGlobals; {sets level to 1};
- gPlotting := true;
- EnableMItem (kStopItem);
- DisableMItem (kContItem);
- EraseRect (gMainRect);
- SetPenMode (modeCOPY);
- SetPenSize (1, 1);
- SetSolidPenPat ($0);
- SetRect (r, kSLeft-1, kSTop-1, kSRight+2, kSBot+1);
- FrameRect (r);
- for i := 0 to 15 do
- begin
- SetSolidPenPat (i);
- SetRect (r, 3, i*8+17, 20, i*8+25);
- PaintRect (r)
- end;
-end;
-
-procedure PlotLine;
-var x, y : real;
- cycles, i : integer;
- datai : array [1..256] of string [15];
- data : array [1..256] of integer;
- lx, ly : integer;
-begin
- i := 1;
- for i := 0 to 5 do
- readln (modem, datai[i]);
- i := 1;
- repeat
- readln (modem, datai [i]);
- i := i + 1;
- until i > gPlane.pprx;
- {GrafOff; for i := 1 to gPlane.pprx do writeln (i, datai[i]); readln; GrafOn;}
- {for i := 1 to gPlane.pprx do writeln ('datai [',i, '] ',datai [i]);
- }for i := 1 to gPlane.pprx do data [i] := String2Int (datai[i]);
- {GrafOff;
- writeln ('i ', i);
- writeln ('y, minx, maxx, pprx, maxiter ', gPlane.y, gPlane.minx, gPlane.maxx,
- gPlane.pprx, gMaxIter);
- readln; GrafOn;
- }SetPenSize (1, gPlane.sizey);
- SetPenMode (modeCOPY);
- i := 2;
- ly := kSTop+round ((((gPlane.y-gPlane.incy)-gPlane.miny)/(gPlane.maxy-gPlane.miny))*kSHeight);
- MoveTo (kSLeft, ly);
- repeat
- if ((data [i] <> data [i-1]) or (i>=gPlane.pprx-2))then
- begin
- SetSolidPenPat ((data [i-1] div gColorInc) mod 14 + 1);
- if data [i-1] >= gMaxIter-1 then SetSolidPenPat (0);
- x := gPlane.minx+i*gPlane.incx;
- lx := kSLeft+round(((x-gPlane.minx)/(gPlane.maxx-gPlane.minx))*kSWidth);
- LineTo (lx, ly)
- end;
- {GrafOff; writeln ('lx, ly, color ', lx, ' ', ly, ' ', data [i]); GrafOn;
- }i := i + 1
- until i > gPlane.pprx + 1;
-end;
-
-procedure DoNextLine;
-var count : integer;
-begin
-with gPlane do
- if (county < ppry div (1+(B2I(gMirror)))) then
- begin
- y := y + incy;
- county := county + 1;
- writeln (modem, y);
- writeln (modem, minx);
- writeln (modem, maxx);
- writeln (modem, pprx);
- writeln (modem, gMaxIter);
- writeln (modem, gDwell);
- PlotLine;
- end
- else
- begin
- if gPlane.level = 8 then gPlotting := false
- else
- begin
- IncLev;
- IncLev
- end;
- end;
-end;
-
-
-procedure DoNextPoint;
-var count : integer;
-begin
-with gPlane do
- if (county < ppry div (1+(B2I(gMirror)))) then
- begin
- if (countx <= pprx) then
- begin
- count := DoCalc (x+incx/2,y+incy/2);
- if count <> gLastCount then
- PlotPoint (gLastCount, x, y)
- else if ((countx = pprx) or (countx = 0)) then
- PlotPoint (count, x, y);
- gLastCount := count;
- x := x + incx;
- countx := countx + 1;
- end
- else
- begin
- x := minx;
- y := y + incy;
- county := county + 1;
- countx := 0;
- end;
- end
- else
- begin
- if gPlane.level = 8 then gPlotting := false
- else
- begin
- IncLev;
- IncLev
- end;
- end;
-end;
-
-
-procedure HandleMenu;
-var theMenu: Integer;
- theItem: Integer;
-begin
- theMenu := HiWrd(gMainEvent.wmTaskData);
- theItem := LoWrd(gMainEvent.wmTaskData);
-
- case theItem of
- kAboutItem: DoAbout;
- kOpenItem: DoOpen;
- kCloseItem: DoClose;
- kQuitItem: DoQuit;
- kStartItem: DoStart;
- kStopItem: DoStop;
- kContItem: DoCont;
- kZoomItem: DoZoom;
- kUnzoomItem: DoUnzoom;
- kIncLevItem: IncLev;
- kSetItem: DoSettings;
- kLev8Item: DoLev8;
- kEraseItem: DoErase;
- kCycleInItem: DoCycleIn;
- kCycleOutItem: DoCycleOut;
- kServerItem: SetNetwork;
- end;
- if ((theMenu = kPaletteMenuID) and (theItem < kCycleInItem)) then
- SetPalette (theItem);
- HiliteMenu (false,theMenu);
-end;
-
-begin
- gMyMemoryID := MMStartUp;
-
- gStartStopRef := StartupTools(gMyMemoryId,RefIsResource,
- Ref(kStartStopResID));
-
- if _ToolErr = noError then begin
- SetUpMenus;
- SetUpWindows;
- SetUpCursor;
- InitializeGlobals;
- InitPalettes;
- InitCursor;
- DoStart;
- MainEventLoop;
- DisposeHandle (TmpSaveHndl);
- end;
-
- ShutDownTools (refIsHandle, gStartStopRef);
-end.
-
-
+ END OF ARCHIVE