home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 200-299 / ff241.lzh / Tiles / Tiles.mod < prev    next >
Text File  |  1989-08-27  |  5KB  |  185 lines
  1. (*$T- Range Checking Off (bombs if we turn it on!) *)
  2. (* $ S - Stack Checking Off *)
  3. MODULE Tiles;
  4.  
  5. (* Game stolen from the Mac by Todd Lewis.
  6.    Lots of code ideas from Trails, by Richard Bielak.
  7.    Created: 3/15/88 by Todd Lewis
  8.    Modified:
  9. Copyright (c) 1988 by Todd Lewis
  10. This program can be freely copied, but please
  11. leave Richie's name in. Thanks, Todd.
  12. *)
  13.  
  14. FROM SYSTEM    IMPORT ADR, BYTE, WORD, ADDRESS, SETREG, NULL;
  15. FROM Intuition IMPORT IntuitionName, IntuitionBase,
  16.  
  17.                       IntuiMessagePtr, IDCMPFlags, IDCMPFlagSet;
  18. FROM GraphicsLibrary IMPORT GraphicsName, GraphicsBase;
  19. FROM Libraries  IMPORT OpenLibrary,CloseLibrary;
  20. FROM Windows IMPORT ReportMouse, CloseWindow, ViewPortAddress;
  21. FROM Ports      IMPORT WaitPort, ReplyMsg, MessagePtr, GetMsg;
  22. FROM InputEvents IMPORT LButton, UpPrefix;
  23. FROM Screens    IMPORT CloseScreen;
  24. FROM Colors IMPORT SetRGB4;
  25. (* FROM DOSProcessHandler IMPORT Exit; Nope! Doesn't do process right *)
  26. IMPORT AMIGAX;
  27. FROM DOSExtensions IMPORT ProcessPtr, Process;
  28. FROM Interrupts IMPORT Forbid;
  29. (* The modules below are home grown *)
  30. FROM TilesMenu IMPORT ConnectMenu, DisconnectMenu, TilesMenuType,
  31.                        ActionItemType, SymetryItemType, SizeItemType,
  32.        SquareSizeItemType;
  33. FROM TilesPlay   IMPORT InitTiles,FreeBitMap,UserInput;
  34. FROM TilesScreen IMPORT SetUpScreen,wp,sp;
  35. FROM TilesInfo IMPORT ShowTilesInfo, InitTilesInfo;
  36. FROM DecodeMenu IMPORT MenuNull, MenuNumber, ItemNumber;
  37.  
  38. CONST
  39.   IntuitionRev = 29;
  40.  
  41. PROCEDURE OpenLibraries () : BOOLEAN;
  42.   BEGIN
  43.     (* Open intuition library *)
  44.     IntuitionBase := OpenLibrary (IntuitionName,IntuitionRev);
  45.     IF IntuitionBase = 0 THEN
  46.       RETURN FALSE
  47.     END;
  48.  
  49.     (* Now open the graphics library *)
  50.     GraphicsBase := OpenLibrary (GraphicsName, 0);
  51.     IF GraphicsBase = 0 THEN
  52.       CloseLibrary(IntuitionBase);
  53.       RETURN FALSE
  54.     END;
  55.     RETURN TRUE
  56.   END OpenLibraries;
  57.  
  58. PROCEDURE CloseLibraries();
  59.   BEGIN
  60.     IF (GraphicsBase # 0)
  61.        THEN CloseLibrary(GraphicsBase); END;
  62.     IF (IntuitionBase # 0)
  63.        THEN CloseLibrary(IntuitionBase); END;
  64.     END CloseLibraries;
  65.  
  66. (* ++++++++++++++++++++++++++++++++++++ *)
  67. PROCEDURE ProcessMenuRequest (code : CARDINAL; VAR quit : BOOLEAN);
  68.   VAR
  69.     menu, item : CARDINAL;
  70.  
  71.   BEGIN
  72.     menu := MenuNumber (code); item := ItemNumber (code);
  73.     CASE TilesMenuType (menu) OF
  74.       Actions:
  75.         CASE ActionItemType (item) OF
  76.           NewBoard : InitTiles;     |
  77.           AboutTiles: ShowTilesInfo( wp ); |
  78.           QuitTiles:  quit := TRUE; |
  79.          END;
  80.       END;
  81.   END ProcessMenuRequest;
  82.  
  83.  
  84. PROCEDURE ProcessButton (code, x, y : CARDINAL);
  85.   VAR ButtonDown : BOOLEAN;
  86.   BEGIN
  87.     (* If the button was just pressed,     *)
  88.     (* Play the piece through UserInput.   *)
  89.     ButtonDown := code = LButton;
  90.     IF ButtonDown THEN UserInput(x,y); END;
  91.   END ProcessButton;
  92.  
  93. PROCEDURE ProcessMessages;
  94.   VAR
  95.     MsgPtr : IntuiMessagePtr;
  96.     Quit   : BOOLEAN;
  97.     code   : CARDINAL;
  98.     class  : IDCMPFlagSet;
  99.     x, y   : CARDINAL;
  100.   BEGIN
  101.     Quit := FALSE;
  102.  
  103.     (* Get messages from intuition, and process them *)
  104.     REPEAT
  105.       (* Wait for a message *)
  106.       MsgPtr := IntuiMessagePtr(WaitPort (wp^.UserPort));
  107.       (* Got something, process it *)
  108.       REPEAT
  109.         MsgPtr := IntuiMessagePtr(GetMsg(wp^.UserPort));
  110.         IF MsgPtr <> NULL THEN
  111.           class := MsgPtr^.Class;
  112.           code  := MsgPtr^.Code;
  113.           x     := MsgPtr^.MouseX;
  114.           y     := MsgPtr^.MouseY;
  115.           ReplyMsg (MessagePtr(MsgPtr));
  116.           IF   (class = IDCMPFlagSet {MouseButtons})
  117.               THEN  ProcessButton (code, x, y)
  118.             ELSIF (class = IDCMPFlagSet {MenuPick}) AND (code <> MenuNull)
  119.               THEN ProcessMenuRequest (code, Quit);
  120.             END;
  121.           END; (* IF *)
  122.         UNTIL MsgPtr = NULL
  123.       UNTIL Quit
  124.   END ProcessMessages;
  125.  
  126. PROCEDURE SetColors;
  127.   VAR vpa : ADDRESS;
  128.   BEGIN
  129.     vpa := ViewPortAddress(wp);
  130.     SetRGB4(vpa, 0, 0, 5,13);
  131.     SetRGB4(vpa, 1,12,13,14);
  132.     SetRGB4(vpa, 2, 3, 4, 8);
  133.     SetRGB4(vpa, 3, 4,11,15);
  134.  
  135.     SetRGB4(vpa, 4,12, 4, 0);
  136.     SetRGB4(vpa, 5,15,13,12);
  137.     SetRGB4(vpa, 6, 8, 4, 3);
  138.     SetRGB4(vpa, 7,15,11, 5);
  139.  
  140.     SetRGB4(vpa, 8, 0, 3, 9);
  141.     SetRGB4(vpa, 9, 6, 7, 8);
  142.     SetRGB4(vpa,10, 1, 1, 3);
  143.     SetRGB4(vpa,11, 2, 5, 7);
  144.  
  145.     SetRGB4(vpa,12,15, 0, 2);
  146.     SetRGB4(vpa,13,11,11, 0);
  147.     SetRGB4(vpa,14, 4, 8, 2);
  148.     SetRGB4(vpa,15, 2, 5, 1);
  149.     END SetColors;
  150.  
  151. VAR
  152.   i : CARDINAL;
  153.   processptr : ProcessPtr;
  154.   startupmsg : ADDRESS;
  155. BEGIN
  156.   IF OpenLibraries() THEN
  157.     InitTilesInfo;
  158.     SetUpScreen;
  159.     (* Attach menu to the window *)
  160.     ConnectMenu(wp);
  161.     (* Don't report mouse until Button is clicked *)
  162.     ReportMouse(wp,FALSE);
  163.     SetColors;
  164.     InitTiles;
  165.     ProcessMessages;
  166.     FreeBitMap;
  167.     DisconnectMenu(wp);
  168.     (* Close the window and screen  *)
  169.     CloseWindow(wp);
  170.     CloseScreen(sp);
  171.     CloseLibraries;
  172.     END; (* IF *)
  173.   (*  Exit(0);  Nope!  Doesn't close a process right! *)
  174.   processptr := AMIGAX.ProcessPtr;
  175.   IF (processptr^.prTaskNum = 0)   (* 0 = not cli, !0 = cli *)
  176.         THEN startupmsg := GetMsg(ADR(processptr^.prMsgPort));
  177.              IF (startupmsg # ADDRESS(0))
  178.                 THEN Forbid;
  179.                      ReplyMsg(startupmsg);
  180.                 END;
  181.         END;
  182. END Tiles.
  183.  
  184.  
  185.