home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 038.lha / Puzzle / behrens.mod < prev    next >
Encoding:
Text File  |  1987-05-17  |  4.9 KB  |  171 lines
  1. (*A$+*)
  2. MODULE Behrens;
  3. (* Behrens' Puzzle Written by Jeremmy Thorne, David Siebert, and Tim Smith
  4.  April 22 1987 for the Amiga in TDI Modula II V 3.0.
  5.  Thanks to Richie Bielak for his Mondrian and WBStart programs. With out those
  6.  Examples this program would have taken much longer.
  7.    Please use this game any way you see fit to help you write your own 
  8.  Modula progams on the Amiga . You may freely copy and distribute this progam
  9.  but please distribute all of and you don't sell it. ! This Game was written
  10.  to give us something to do while linking long progams Hope you enjoy it.
  11.  IF you do please send $5.00 or what ever you like to
  12.  
  13.                   CENTUARI SYSTEMS DEVELOPMENT
  14.                          P.O. Box 2016
  15.                     Sebastian,FL 32958-2016 
  16.  
  17. This is our first Sharware product if we get a good response we have 
  18. many other games and utilities planned for ShareWare.*)
  19.  
  20.  
  21. FROM SYSTEM IMPORT NULL,ADDRESS,ADR;
  22. FROM Intuition IMPORT Window,WindowPtr,Gadget,GadgetPtr,GadgetFlags,
  23.   GadgetFlagSet,IntuitionName,IntuitionBase,IntuiMessagePtr,
  24.   IDCMPFlagSet,IDCMPFlags,IntuiMessage,Image,ImagePtr,FreeRemember;
  25. FROM Ports IMPORT WaitPort,GetMsg,ReplyMsg,MessagePtr;
  26. FROM SetBoard IMPORT PlaceBoard,PlaceType;
  27. FROM Windows IMPORT CloseWindow;
  28. FROM GraphicsLibrary IMPORT GraphicsName,GraphicsBase;
  29. FROM Libraries IMPORT OpenLibrary,CloseLibrary;
  30. FROM Gadgets IMPORT RefreshGadgets,RemoveGadget;
  31. FROM WBStart IMPORT GetWBStartUpMsg,ReturnWBStartUpMsg;
  32.  
  33. VAR
  34.   Reverse:ARRAY [1..9],[1..4] OF INTEGER;
  35.   GameWindow:WindowPtr;
  36.   Places:PlaceType;
  37.   Playing:BOOLEAN;
  38.   PosGad,
  39.   PieceID:INTEGER;
  40.   MsgPtr:IntuiMessagePtr;
  41.   GadList,
  42.   NextGad,
  43.   PieceGadget:GadgetPtr;
  44.   ImageList:ImagePtr;
  45.   Width,
  46.   Height:CARDINAL;
  47.   WBMsg:ADDRESS;
  48.  
  49. PROCEDURE FlipPieces(); (*This Procedure does the playing of the game*)
  50.  
  51.   VAR
  52.    T:INTEGER;
  53.    CurrentID:INTEGER;
  54.    CurrentGadget:GadgetPtr;
  55.  
  56.   BEGIN
  57.     IF Playing = TRUE THEN
  58.       INCL(Places[PieceID]^.Flags,Disabled);
  59.       FOR T:=1 TO 4 DO
  60.         CurrentID:=Reverse[PieceID,T];
  61.         IF CurrentID<>0 THEN
  62.           CurrentGadget:=Places[CurrentID];
  63.           IF Selected IN CurrentGadget^.Flags THEN
  64.             EXCL(CurrentGadget^.Flags,Selected);
  65.             INCL(CurrentGadget^.Flags,Disabled);
  66.           ELSE
  67.             EXCL(CurrentGadget^.Flags,Disabled);
  68.             INCL(CurrentGadget^.Flags,Selected);
  69.           END;
  70.         END;
  71.       END;
  72.     END;
  73.   END FlipPieces;
  74.  
  75. PROCEDURE SetUp():BOOLEAN;
  76.  
  77. VAR
  78.   T:INTEGER;
  79.  
  80.   BEGIN
  81.     FOR T:=1 TO 9 DO
  82.       EXCL(Places[T]^.Flags,Disabled);
  83.     END;
  84.     RETURN FALSE
  85.   END SetUp;
  86.  
  87. PROCEDURE PlayTheGame():BOOLEAN;
  88.  
  89. VAR
  90.   T:INTEGER;
  91.  
  92. BEGIN
  93.   FOR T:=1 TO 9 DO
  94.     IF NOT(Selected IN Places[T]^.Flags) THEN
  95.       INCL(Places[T]^.Flags,Disabled);
  96.     END;
  97.   END;
  98.   RETURN TRUE
  99. END PlayTheGame;
  100.  
  101. BEGIN
  102.   WBMsg:=GetWBStartUpMsg();
  103.   IntuitionBase:=OpenLibrary(IntuitionName,0);
  104.   GraphicsBase:=OpenLibrary(GraphicsName,0);
  105.   PlaceBoard(GameWindow,Places); (*Set up playing board*)
  106.   Playing:=FALSE;
  107.   Reverse[1,1]:=2;
  108.   Reverse[1,2]:=4;
  109.   Reverse[1,3]:=5;
  110.   Reverse[1,4]:=0;
  111.   Reverse[2,1]:=1;
  112.   Reverse[2,2]:=3;
  113.   Reverse[2,3]:=0;
  114.   Reverse[2,4]:=0;
  115.   Reverse[3,1]:=2;
  116.   Reverse[3,2]:=5;
  117.   Reverse[3,3]:=6;
  118.   Reverse[3,4]:=0;
  119.   Reverse[4,1]:=1;
  120.   Reverse[4,2]:=7;
  121.   Reverse[4,3]:=0;
  122.   Reverse[4,4]:=0;
  123.   Reverse[5,1]:=1;
  124.   Reverse[5,2]:=3;
  125.   Reverse[5,3]:=7;
  126.   Reverse[5,4]:=9;
  127.   Reverse[6,1]:=3;
  128.   Reverse[6,2]:=9;
  129.   Reverse[6,3]:=0;
  130.   Reverse[6,4]:=0;
  131.   Reverse[7,1]:=4;
  132.   Reverse[7,2]:=5;
  133.   Reverse[7,3]:=8;
  134.   Reverse[7,4]:=0;
  135.   Reverse[8,1]:=7;
  136.   Reverse[8,2]:=9;
  137.   Reverse[8,3]:=0;
  138.   Reverse[8,4]:=0;
  139.   Reverse[9,1]:=5;
  140.   Reverse[9,2]:=6;
  141.   Reverse[9,3]:=8;
  142.   Reverse[9,4]:=0;
  143.   REPEAT
  144.     MsgPtr:=WaitPort(GameWindow^.UserPort);(*Wait for a message from Intuition*)
  145.     MsgPtr:=GetMsg(GameWindow^.UserPort); (* Get the message *)
  146.     IF GadgetUp IN MsgPtr^.Class THEN  (* if the message is that you clicked *)
  147.       PieceGadget:=MsgPtr^.IAddress; (* on a gadget the call the flip procdure*)
  148.       PieceID:=PieceGadget^.GadgetID;(* if in playing mode *)
  149.       CASE PieceID OF                (* or if the message is from the startup*)
  150.         10 : Playing:=SetUp();       | (* or play gadget set the game to that*)
  151.         11 : Playing:=PlayTheGame(); | (* mode *)
  152.        1..9: FlipPieces();
  153.       END;
  154.       RefreshGadgets(GameWindow^.FirstGadget,GameWindow,NULL);(* refresh *)
  155.     ReplyMsg(MessagePtr(MsgPtr)); (* reply to intuiton so it will send the *)
  156.     END;                           (* next message *)
  157.   UNTIL CloseWindowFlag IN MsgPtr^.Class; (* Until you close the window *)
  158.   ReplyMsg(MessagePtr(MsgPtr));(* clean up and end the program *)
  159.   GadList:=GameWindow^.FirstGadget;
  160. (*  REPEAT
  161.     NextGad := GadList^.NextGadget; 
  162.     PosGad:= RemoveGadget(GameWindow,GadList);
  163.     GadList:=NextGad;
  164.   UNTIL GadList = NULL;*)
  165.   FreeRemember(GadList,TRUE);
  166.   CloseWindow(GameWindow);
  167.   CloseLibrary(IntuitionBase);
  168.   CloseLibrary(GraphicsBase);  
  169.   ReturnWBStartUpMsg();
  170. END Behrens.
  171.