home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Snippets / SplatMaster / BalloonMain.p < prev    next >
Encoding:
Text File  |  1992-03-10  |  17.2 KB  |  537 lines  |  [TEXT/PJMM]
  1. ======================================================================================    }
  2.     function SysCheck: boolean;
  3.         label
  4.             99;
  5.         const
  6.             versRequested = 1;
  7.             envBadVers = -5501;
  8.             envVersTooBig = -5502;
  9.             WNE_TRAP_NUM = $60;
  10.             UNIMPL_TRAP_NUM = $9F;
  11.         var
  12.             str1, str2: str255;
  13.             freeSpace: size;
  14.             myHeapSpace: longint;
  15.             err: OSErr;
  16.             theWorld: sysEnvRec;
  17.             GotColorQD, GotCoProcessor, runability: boolean;
  18.     begin
  19.         SysCheck := FALSE;
  20.         HasColorQD := FALSE;
  21.         HasCoProcessor := FALSE;
  22.         runability := FALSE;
  23.  
  24.         err := SysEnvirons(versRequested, theWorld);
  25.  
  26.         if err <> noErr then        {error on SysEnvirons call? If so,    }
  27.             goto 99;
  28.  
  29. {-1 = Macintosh with 64K Rom, -2 = Macintosh XL. We can't run on those.}
  30.         if (theWorld.machineType = -1) or (theWorld.machineType = -2) then
  31.             goto 99;
  32.  
  33.         if theWorld.hasFPU then
  34.             HasCoProcessor := TRUE;
  35.  
  36.         if theWorld.HasColorQD then
  37.             HasColorQD := TRUE;
  38.  
  39.         runability := TRUE;
  40.         gWNEImplemented := (NGetTrapAddress(WNE_TRAP_NUM, ToolTrap) <> NGetTrapAddress(UNIMPL_TRAP_NUM, ToolTrap));
  41.  
  42. 99:
  43.         if not runability then
  44.             DoMessage('**Sorry, this program', 'is unable to run', 'on this machine.', '')
  45.         else
  46.             SysCheck := TRUE;
  47.  
  48.     end;{SysCheck}
  49.  
  50.  
  51. {=======================================================================================    }
  52.     function GetMBarHeight: INTEGER;
  53.     inline
  54.         $3EB8, $0BAA; {smMoveWord2Stack, smMBarHeight; (from ScriptManager.p interface}
  55.  
  56. {=======================================================================================    }
  57.     procedure InitGlobs;
  58.         var
  59.             aLong: longint;
  60.             anInt: integer;
  61.     begin
  62.  
  63.         GetDateTime(aLong);                {make sure the numbers are randomized}
  64.         randSeed := aLong;                {seed the system's random generator}
  65.  
  66.         appResFileRef := CurResFile;
  67.  
  68.         savedMenuHeight := GetMBarHeight;
  69.         currMenuHeight := savedMenuHeight;
  70.  
  71.         gIBeam := GetCursor(iBeamCursor);
  72.         gWatch := GetCursor(watchCursor);
  73.         gCrossHairs := GetCursor(crossCursor);
  74.  
  75.         refreshMenus := TRUE;
  76.         errorFlag := FALSE;
  77.         quitting := FALSE;
  78.         finished := FALSE;
  79.  
  80.         graphPICHdl := nil;
  81.  
  82.         cursorIs := k_arrowCurs;
  83.  
  84.     end;{InitGlobs}
  85.  
  86. {=======================================================================================    }
  87.     procedure MakeMenus;
  88.         var
  89.             index: Integer;
  90.     begin
  91.  
  92.         for index := AppleMenuID to GoodiesMenuID do
  93.             begin
  94.                 myMenus[index] := GetMenu(index);
  95.                 InsertMenu(myMenus[index], 0);
  96.             end;
  97.         AddResMenu(myMenus[AppleMenuID], 'DRVR');
  98.  
  99.  
  100.         DisableItem(myMenus[EditMenuID], MenuUndo);
  101.         EnableItem(myMenus[EditMenuID], MenuCut);
  102.         EnableItem(myMenus[EditMenuID], MenuCopy);
  103.         DisableItem(myMenus[EditMenuID], MenuPaste);
  104.         DisableItem(myMenus[EditMenuID], MenuClear);
  105.  
  106.         refreshMenus := TRUE;
  107.     end;{MakeMenus}
  108.  
  109. {=======================================================================================    }
  110.     function IsOptionKeyDown: boolean;
  111.         var
  112.             keys: keyMap;
  113.     begin
  114.         GetKeys(keys);
  115.         if BitTst(@keys, 61) then
  116.             IsOptionKeyDown := TRUE
  117.         else
  118.             IsOptionKeyDown := FALSE;
  119.     end;{IsOptionKeyDown}
  120.  
  121.  
  122. {=======================================================================================    }
  123.     function IsCommandKeyDown: boolean;
  124.         var
  125.             keys: keyMap;
  126.     begin
  127.         GetKeys(keys);
  128.         if BitTst(@keys, 48) then
  129.             IsCommandKeyDown := TRUE
  130.         else
  131.             IsCommandKeyDown := FALSE;
  132.     end;{IsCommandKeyDown}
  133.  
  134.  
  135. {=======================================================================================    }
  136.     procedure HandleDiskEvt;
  137.         const
  138.             top = 80;
  139.             left = 120;
  140.         var
  141.             highWord: integer;
  142.             aPt: point;
  143.             result: integer;
  144.     begin
  145.         highWord := HiWord(MainEvent.message);
  146.         if highWord <> 0 then    {the disk did not mount successfully}
  147.             begin
  148.                 SetPt(aPt, top, left);
  149.                 DILoad;    {load the disk-initialization package}
  150.                 result := DIBadMount(aPt, MainEvent.message);
  151.                 DIUnLoad;    {Unload the disk-initialization package}
  152.             end;
  153.     end;{HandleDiskEvt}
  154.  
  155. {===========================================================================}
  156.     procedure AnUpDate;
  157.         var
  158.             ActivePort, whichWindow: WindowPtr;
  159.             x, width: integer;
  160.     begin
  161. {    save the current port in 'activeport', set the port to the}
  162. {    window needing updating, redraw the contents of the window,}
  163. {    restore the port to the original 'activeport'}
  164.         GetPort(ActivePort);
  165.         whichWindow := WindowPtr(MainEvent.message);
  166.  
  167.         SetCursor(gWatch^^);
  168.  
  169.         if whichWindow = toolWindPtr then        {drawing window}
  170.             begin
  171.                 BeginUpdate(toolWindPtr);
  172.                 SelectWindow(toolWindPtr);
  173.                 SetPort(toolWindPtr);
  174.                 RefreshToolWind;
  175.                 ENDUpdate(toolWindPtr);
  176.             end;
  177.         if whichWindow = DrawWindPtr then        {drawing window}
  178.             begin
  179.                 SetPort(DrawWindPtr);
  180.                 InvalRect(thePort^.portRect);
  181.                 BeginUpdate(DrawWindPtr);
  182.                 if (curBalloon.myBigArray = nil) or (curBalloon.numPtsSoFar = 0) then
  183.                     begin
  184.                         if curBalloon.autoRedraw then
  185.                             begin
  186.                                 DrawBalloon(curBalloon);
  187.                                 BalloonStats(curBalloon);
  188.                             end
  189.                     end
  190.                 else
  191.                     RefreshBalloons(curBalloon);
  192.                 FakeGrowIcon(DrawWindPtr, prefs.def_alwaysGrowBox);
  193.                 ENDUpdate(DrawWindPtr);
  194.                 if showToolWind then
  195.                     begin
  196.                         SelectWindow(toolWindPtr);
  197.                         SetPort(toolWindPtr);
  198.                     end;
  199.             end;
  200.  
  201.         cursorIs := 0;
  202.  
  203.         SetPort(ActivePort);
  204.     end;{}
  205.  
  206.  
  207.  
  208. {=======================================================================================    }
  209.     procedure ClickInZoom (TheZoom: integer);
  210.  
  211.         var
  212.             TheWindow: WindowPtr;
  213.     begin
  214.         TheWindow := FrontWindow;
  215.         with TheWindow^ do
  216.             if TrackBox(TheWindow, MainEvent.where, TheZoom) then
  217.                 begin
  218.                     EraseRect(TheWindow^.portRect);
  219.                     ZoomWindow(TheWindow, TheZoom, true);
  220. {•     WSize(gWindow);•}
  221.                 end;{with…if}
  222.     end;
  223.  
  224.  
  225. {=======================================================================================    }
  226.     procedure HandleContent (theWindow: WindowPtr; where: Point);
  227.         var
  228.             oldPort: GrafPtr;
  229.             aBool: boolean;
  230.             tempRect: rect;
  231.     begin
  232.         if thewindow = DrawWindPtr then
  233.             begin
  234.                 GetPort(oldPort);
  235.                 SetPort(DrawWindPtr);
  236.                 GlobalToLocal(where);
  237.                 if (PtInRect(where, curBalloon.statsBox)) then
  238.                     DragStatsRect(curBalloon)
  239.                 else if (PtInRect(where, GrowIconRect)) then
  240.                     begin
  241.                         DoGrow(DrawWindPtr);
  242.                         EraseRect(thePort^.portRect);
  243.                         InvalRect(thePort^.portRect);
  244.                         with thePort^.portRect do
  245.                             begin
  246.                                 curBalloon.blnMiddle.h := (right - left) div 2;
  247.                                 curBalloon.blnMiddle.v := (bottom - top) div 2;
  248.                             end;
  249.                         tempRect := curBalloon.statsBox;        {is it still visible?}
  250.                         InsetRect(tempRect, 4, 4);
  251.                         if not SectRect(tempRect, thePort^.portRect, tempRect) then    {well, it's not visible *enough*, so:}
  252.                             OffSetRect(curBalloon.statsBox, -curBalloon.statsBox.left + 2, -curBalloon.statsBox.top + 2);
  253.                     end;
  254.                 SetPort(oldPort);
  255.             end    { if DrawWindPtr }
  256.         else if thewindow = toolWindPtr then
  257.             begin
  258.                 HandleToolContent(where);
  259.  
  260.             end;{ if toolWindPtr}
  261.     end;
  262.  
  263.  
  264. {=======================================================================================    }
  265.     procedure HandleGoAway (theWindow: WindowPtr; where: Point);
  266.     begin
  267.         if TrackGoAway(theWindow, where) then
  268.             begin
  269.                 if WindowPeek(theWindow)^.WindowKind = userKind then
  270.                     if theWindow = toolWindPtr then
  271.                         begin
  272.                             showToolWind := False;
  273.                             ShowHideTools;
  274.                         end
  275.                     else
  276.                         CloseDeskAcc(WindowPeek(theWindow)^.WindowKind)
  277.             end;
  278.     end;
  279.  
  280.  
  281. {=======================================================================================    }
  282.     procedure ClickInDA (theWindow: WindowPtr);
  283.     begin
  284.         SystemClick(MainEvent, theWindow);
  285. {•  CheckMenus;•}
  286.     end;{ClickInDA}
  287.  
  288. {=======================================================================================    }
  289.     procedure ClickAppleMenu (TheItem: integer);
  290.         var
  291.             SavedPort: GrafPtr;
  292.             TheName: Str255;
  293.             aDLOGPtr: dialogPtr;
  294.             OldPort: GrafPtr;
  295.             itemHit: integer;
  296.     begin
  297.         case theItem of
  298.             MenuAbout: 
  299.                 begin
  300.                     InitCursor;
  301.                     cursorIs := k_arrowCurs;
  302.                     GetPort(OldPort);
  303.                     aDLOGPtr := GetNewDialog(1000, nil, Pointer(-1));
  304.                     CenterWindow(WindowPtr(aDLOGPtr));
  305.                     SetPort(aDLOGPtr);
  306.                     ShowWindow(aDLOGPtr);
  307.                     repeat
  308.                         ModalDialog(nil, itemHit);    {Wait until an item is hit}
  309.                     until itemhit <> 0;
  310.                     DisposDialog(aDLOGPtr);{Flush the dialog out of memory}
  311.                     SetPort(oldPort);
  312.                 end;
  313.             otherwise
  314.                 begin
  315.                     GetPort(SavedPort);
  316.                     GetItem(myMenus[AppleMenuID], TheItem, TheName);
  317.                     itemHit := OpenDeskAcc(TheName);
  318.                     SetPort(SavedPort);
  319.                 end;    {otherwise}
  320.         end;{case}
  321.     end;{ClickAppleMenu}
  322.  
  323. {=======================================================================================    }
  324.     procedure ClickFileMenu (TheItem: integer);
  325.         var
  326.             Dummy: boolean;
  327.     begin
  328.         case TheItem of
  329.             MenuNew: 
  330.                 NewBalloon(curBalloon);
  331.             MenuQuit: 
  332.                 begin
  333.                     quitting := TRUE;
  334.                 end;
  335.             otherwise
  336.                 ;
  337.         end;    {case}
  338.         if quitting = TRUE then
  339.             finished := TRUE;
  340.     end;{ClickFileMenu}
  341.  
  342. {=======================================================================================    }
  343.     procedure DoCutCopy;
  344.         var
  345.             aLong, longSize: longint;
  346.             resultStr: Str255;
  347.     begin
  348.         BalloonPICT(curBalloon, graphPICHdl);
  349.         MoveHHi(Handle(graphPICHdl));    {get the PICT on the clipboard}
  350.         HLock(Handle(graphPICHdl));
  351.         aLong := ZeroScrap;
  352.         if aLong = noErr then
  353.             begin
  354.                 longSize := GetHandlesize(Handle(graphPICHdl));
  355.                 aLong := PutScrap(longSize, 'PICT', Ptr(graphPICHdl^));
  356.                 if aLong = noErr then
  357.                     aLong := UnloadScrap;
  358.             end;
  359.         if aLong <> noErr then
  360.             SysBeep(1);
  361.         HUnlock(Handle(graphPICHdl));
  362.         KillPicture(graphPICHdl);
  363.         graphPICHdl := nil;
  364.     end;    {DoCutCopy}
  365.  
  366.  
  367. {=======================================================================================    }
  368.     procedure ClickEditMenu (TheItem: integer);
  369.         var
  370.             aLong: longint;
  371.     begin
  372.         if not SystemEdit(TheItem - 1) then    {okay, it's us, not a DA}
  373.             case theItem of
  374.                 MenuUndo: 
  375.                     ;
  376.                 MenuCopy, MenuCut: 
  377.                     begin
  378.                         if ZeroScrap = noerr then
  379.                             begin
  380.                                 aLong := ZeroScrap;
  381.                                 if aLong = noErr then
  382.                                     DoCutCopy
  383.                                 else
  384.                                     SysBeep(1);
  385. {    MoveHHi(Handle(ourPictureHdl));}
  386. {    HLock(Handle(ourPictureHdl));}
  387. {    longSize := GetHandlesize(Handle(ourPictureHdl));}
  388. {    aLong := PutScrap(longSize, 'PICT', Ptr(ourPictureHdl^));}
  389. {    if aLong = noErr then}
  390. {    aLong := UnloadScrap;}
  391. {    HUnlock(Handle(ourPictureHdl));}
  392.                             end
  393.                         else
  394.                             SysBeep(1);
  395.                     end;
  396.                 MenuPaste: 
  397.                     ;
  398.                 MenuClear: 
  399.                     ;
  400.                 MenuPrefs: 
  401.                     PrefsDLOG;
  402.                 otherwise
  403.                     ;
  404.             end;{case}
  405. {•   if (TheItem = MenuCut) or (TheItem = MenuCopy) then•}
  406. {•     ClipChanged := true;•}
  407.     end;{ClickEditMenu}
  408.  
  409.  
  410. {=======================================================================================    }
  411.     procedure ClickGoodiesMenu (TheItem: integer);
  412.         var
  413.             oldPort: GrafPtr;
  414.     begin
  415.         case theItem of
  416.             MenuMultiSplat: 
  417.                 if MakeMacro(curBalloon) then
  418.                     begin
  419.                         DoMultiSplat(curBalloon);
  420.                         BalloonStats(curBalloon);
  421.                     end;
  422.             MenuClearSplats: 
  423.                 ClearAllSplats(curBalloon);
  424.             MenuHidePalette: 
  425.                 begin
  426.                     showToolWind := not showToolWind;
  427.                     ShowHideTools;
  428.                 end;
  429.             otherwise
  430.                 ;
  431.         end;{case}
  432.     end;{ClickGoodiesMenu}
  433.  
  434.  
  435. {=======================================================================================    }
  436.     procedure ClickInMenu;
  437.         var
  438.             Selection: longint;
  439.     begin
  440.         Selection := MenuSelect(MainEvent.where);
  441.         case HiWord(Selection) of
  442.             AppleMenuID: 
  443.                 ClickAppleMenu(LoWord(Selection));
  444.             FileMenuID: 
  445.                 ClickFileMenu(LoWord(Selection));
  446.             EditMenuID: 
  447.                 ClickEditMenu(LoWord(Selection));
  448.             GoodiesMenuID: 
  449.                 ClickGoodiesMenu(LoWord(Selection));
  450.             otherwise
  451.                 ;
  452.         end;
  453.         HiliteMenu(0);        {turns off menu after action has taken place}
  454.     end;{ClickInMenu}
  455.  
  456. {=======================================================================================    }
  457.     procedure AClick;
  458.  
  459.         var
  460.             theWindow: WindowPtr;
  461.             where: Point;
  462.             windowLoc: INTEGER;
  463.  
  464.     begin
  465.  
  466.         where := MainEvent.where;
  467.         theWindow := WindowPtr(MainEvent.message);
  468.         windowLoc := FindWindow(where, theWindow);
  469.  
  470.         case windowLoc of
  471.             inDesk: 
  472.                 ;
  473.             InMenuBar: 
  474.                 ClickInMenu;
  475.             inSysWindow: 
  476.                 ClickInDA(theWindow);
  477.             InGrow: 
  478.                 DoGrow(theWindow);
  479.             InContent: 
  480.                 HandleContent(theWindow, where);
  481.             InGoAway: 
  482.                 HandleGoAway(theWindow, where);
  483.             InDrag: 
  484.                 DoDrag(theWindow);
  485.             inZoomIn: 
  486.                 ClickInZoom(inZoomIn);
  487.             inZoomOut: 
  488.                 ClickInZoom(inZoomOut);
  489.         end;
  490.  
  491.     end;
  492.  
  493. {•    AKey•}
  494. {•    -ouseUp: 
  495.                         ;
  496.                     keyDown: 
  497.                         AKey;
  498.                     keyUp: 
  499.                         ;
  500.                     autoKey: 
  501.                         AKey;
  502.                     updateEvt: 
  503.                         AnUpDate;
  504.                     DiskEvt: 
  505.                         HandleDiskEvt;
  506.                     activateEvt: 
  507.                         AnActivate;
  508.                     nullEvent: 
  509.                         ;
  510.                     otherwise
  511.                         ;
  512.                 end;    {case}
  513.  
  514.         until finished;
  515.  
  516.     end;
  517.  
  518. {=======================================================================================    }
  519. {MAIN}
  520.  
  521. begin
  522.     InitMac;
  523.  
  524.     InitGlobs;
  525.     SetUpPrefs(prefs);
  526.     if sysCheck then                        {find out about our environment}
  527.         begin
  528.             MakeMenus;
  529.             PutUpDrawingWIND;
  530.             InitBalloon(curBalloon);
  531.             PutUpToolWIND;
  532.             SelectWindow(toolWindPtr);
  533.             SetPort(toolWindPtr);
  534.             MainLoop;                    {let's jam}
  535.         end;
  536.     RewritePrefs(prefs);
  537. end.