home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Snippets / TruchetTiles / Truchet_Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-09  |  14.2 KB  |  265 lines  |  [TEXT/PJMM]
  1. program Truchet;
  2. {Demonstrates TRUCHET Tilings. Based on A.K. Dewdney's 7/89 Computer Recreations column in Scientific American.}
  3. {Quickly written by: Jon Benton.  Thanks to: THINK Technology, TML, and the guys in GEnie's MACPRO section.}
  4. {This is Freeware, enjoy it!}
  5.     uses
  6.         PrintTraps, Quickdraw, Picker, Palettes, Globs, DLOGStuff, WindowStuff, prefsUnit, Truchet;
  7.  
  8.  
  9. {=======================================================================================    }
  10.     procedure Panic;
  11.     begin
  12.         ExitToShell;
  13.     end;
  14.  
  15. {==================================    }
  16.     procedure ClickInGoAway;
  17.         var
  18.             topWindow: WindowPtr;
  19.     begin
  20.         topWindow := FrontWindow;
  21.  
  22.         if TrackGoAway(topWindow, MainEvent.where) then
  23.             begin
  24.                 if topWindow = MainWindPtr then
  25.                     begin
  26.                         CloseWindow(MainWindPtr);
  27.                         gdh^^.done := TRUE;
  28.                     end;
  29.             end;
  30.  
  31.     end;
  32.  
  33. {=======================================================================================    }
  34.     procedure ClickInDA (theWindow: WindowPtr);
  35.     begin
  36.         SystemClick(MainEvent, theWindow);
  37.     end;{ClickInDA}
  38.  
  39. {=======================================================================================    }
  40.     procedure ClickAppleMenu (TheItem: integer);
  41.         var
  42.             SavedPort: GrafPtr;
  43.             TheName: Str255;
  44.             Dummy: integer;
  45.     begin
  46.         case theItem of
  47.             MenuAbout: 
  48.                 begin
  49.                     ObscureCursor;
  50.                     DoAbout;
  51.                 end;
  52.             otherwise
  53.                 begin
  54.                     GetPort(SavedPort);                                            {get current port, just in case the DA is uncooperative sort…}
  55.                     GetItem(myMenus[AppleMenuID], TheItem, TheName);        {identify which DA}
  56.                     Dummy := OpenDeskAcc(TheName);                            {kick off DA}
  57.                     SetPort(SavedPort);                                            {set back to original port}
  58.                 end;    {otherwise}
  59.         end;{case}
  60.     end;{ClickAppleMenu}
  61.  
  62. {=======================================================================================    }
  63.     procedure ClickFileMenu (TheItem: integer);
  64.         var
  65.             Dummy: boolean;
  66.     begin
  67.         case TheItem of
  68.             MenuQuit: 
  69.                 gdh^^.Done := TRUE;
  70.             otherwise
  71.                 ;
  72.         end;    {case}
  73.     end;{ClickFileMenu}
  74.  
  75. {=======================================================================================    }
  76.     procedure ClickEditMenu (TheItem: integer);
  77.     begin
  78.         if not SystemEdit(TheItem - 1) then    {okay, it's us, not a DA}
  79.             case theItem of
  80.                 MenuUndo: 
  81.                     ;         {this pgm doesn't handle any of the cases}
  82.                 MenuCopy: 
  83.                     ;
  84.                 MenuCut: 
  85.                     ;
  86.                 MenuPaste: 
  87.                     ;
  88.                 MenuClear: 
  89.                     ;
  90.                 otherwise
  91.                     ;
  92.             end;{case}
  93. {•   if (TheItem = MenuCut) or (TheItem = MenuCopy) then•}
  94. {•    gdh^^.ClipChanged := true;•}
  95.     end;{ClickEditMenu}
  96.  
  97. {=======================================================================================    }
  98.     procedure ClickTileMenu (TheItem: integer);
  99.     begin
  100.         case theItem of
  101.             MenuDrawEm: 
  102.                 begin
  103.                     GetDateTime(aLong);                            {make sure the numbers are randomized}
  104.                     gdh^^.seedRand := aLong - TickCount;            {store it away…}
  105.                     DoTruchet;
  106.                     FakeGrowIcon(mainWindPtr);
  107.                 end;
  108.             MenuPrefs: 
  109.                 begin
  110.                     DoPrefs;
  111.                     DoTruchet;
  112.                     ValidRect(mainWindPtr^.portRect);
  113.                 end;
  114.             otherwise
  115.                 ;
  116.         end;{case}
  117.     end;{ClickTileMenu}
  118.  
  119. {=======================================================================================    }
  120.     procedure ClickInMenu;
  121.         var
  122.             Selection: longint;
  123.     begin
  124.         Selection := MenuSelect(MainEvent.where);
  125.         case HiWord(Selection) of
  126.             AppleMenuID: 
  127.                 ClickAppleMenu(LoWord(Selection));
  128.             FileMenuID: 
  129.                 ClickFileMenu(LoWord(Selection));
  130.             EditMenuID: 
  131.                 ClickEditMenu(LoWord(Selection));
  132.             TileMenuID: 
  133.                 ClickTileMenu(LoWord(Selection));
  134.             otherwise
  135.                 ;
  136.         end;
  137.         HiliteMenu(0);        {turns off menu after action has taken place}
  138.     end;{ClickInMenu}
  139.  
  140. {=======================================================================================    }
  141.     procedure AClick;            {someone clicked somewhere…}
  142.         var
  143.             where: integer;
  144.             theWindow: WindowPtr;
  145.     begin
  146.  
  147.         where := FindWindow(MainEvent.where, theWindow);        {where on DeskTop did they click?}
  148.  
  149.         case where of
  150.             inDesk: 
  151.                 SysBeep(1);
  152.             inMenuBar: 
  153.                 ClickInMenu;
  154.             inSysWindow: 
  155.                 ClickInDA(theWindow);
  156.             inContent: 
  157.                 begin
  158.                     if FrontWindow = MainWindPtr then
  159.                         ClickInContent;
  160.                 end;
  161.             inDrag: 
  162.                 begin
  163.                     aRect := gdh^^.DragRect;
  164.                     DragWindow(theWindow, MainEvent.where, aRect);
  165.                 end;
  166.             inGrow: 
  167.                 ClickInGrow;
  168.             inGoAway: 
  169.                 ClickInGoAway;
  170.             inZoomIn: 
  171.                 ClickInZoom(inZoomIn);
  172.             inZoomOut: 
  173.                 ClickInZoom(inZoomOut);
  174.         end;
  175.  
  176.     end;
  177.  
  178. {=======================================================================================    }
  179.     procedure CommandKey (TheKey: char);            {handle Command Keys…}
  180.         var
  181.             Selection: longint;
  182.     begin
  183.         Selection := MenuKey(TheKey);
  184.         case HiWord(Selection) of
  185.             AppleMenuID: 
  186.                 ClickAppleMenu(LoWord(Selection));
  187.             FileMenuID: 
  188.                 ClickFileMenu(LoWord(Selection));
  189.             EditMenuID: 
  190.                 ClickEditMenu(LoWord(Selection));
  191.             TileMenuID: 
  192.                 ClickTileMenu(LoWord(Selection));
  193.             otherwise
  194.                 ;
  195.         end;
  196.         HiliteMenu(0);
  197.     end;{CommandKey}
  198.  
  199. {=======================================================================================    }
  200.     procedure AKey;                {user hit key(s) on keyboard…}
  201.         var
  202.             TheCode: integer;
  203.             TheChar: char;
  204.     begin
  205.         TheCode := BitAnd(MainEvent.message, charCodeMask);
  206.         TheChar := chr(TheCode);
  207.  
  208.         if BitAnd(MainEvent.modifiers, cmdKey) <> 0 then
  209.             CommandKey(TheChar)
  210.     end;{AKey}
  211.  
  212. {=======================================================================================    }
  213.     procedure MainLoop;            {EventLoop…not MultiFinder friendly…}
  214.         var
  215.             Dummy: boolean;
  216.             whichDialog: DialogPtr;
  217.             whichItem: integer;
  218.     begin
  219.  
  220.         gdh^^.Done := FALSE;        {initialize global 'Quit-and-Get-Out' flag…}
  221.         repeat
  222.             SystemTask;
  223.             Dummy := GetNextEvent(everyEvent, MainEvent);
  224.             if Dummy then
  225.                 begin
  226.                     case MainEvent.what of
  227.                         mouseDown: 
  228.                             AClick;
  229.                         mouseUp: 
  230.                             ;
  231.                         keyDown: 
  232.                             AKey;
  233.                         keyUp: 
  234.                             ;
  235.                         autoKey: 
  236.                             AKey;
  237.                         updateEvt: 
  238.                             AnUpDate;
  239.                         DiskEvt: 
  240.                             HandleDiskEvt;
  241.                         activateEvt: 
  242.                             AnActivate;
  243.                         otherwise
  244.                             ;
  245.                     end;    {case}
  246.                 end;
  247.         until gdh^^.Done;
  248.  
  249.     end;
  250.  
  251. {=======================================================================================    }
  252. {MAIN}
  253.  
  254. begin
  255.     InitMac;
  256.     gdh := GlobalDataHDL(NewHandle(SizeOf(GlobalDataRec)));            {allocate handle for our global data}
  257.     if sysCheck then
  258.         begin
  259.             InitGlobs;
  260.             MakeMenus;
  261.             PutUpWind('Truchet Tiles');
  262.             ShowWindow(MainWindPtr);
  263.             MainLoop;
  264.         end;
  265. end.        {TRUCHET program}