(* =======================================================================

                                  M2Sprint

                               Demo Disk V1.10

   =======================================================================

   Welcome to the M2Sprint demo disk!

   Through this disk we will show you an exciting new product for your
   Amiga 500, 1000, 2000 or 2500.

   M2Sprint is a totally new Modula-2 development environment for the
   Amiga. It couples speed with ease of use and provides the most
   sophisticated and productive programming environment for your Amiga.
   Please take the time to examine the software and documentation on this
   disk.

   To view the rest of this file, simply point the mouse at the text, hold
   down the left mouse button, and move the mouse pointer off the bottom of 
   the window.

   =======================================================================

   How to use this demo disk
   -------------------------

   On this disk you will find the major parts of the M2Sprint system together
   with several files describing the features of the system. This is a demo
   disk so the compiler and linker have been restricted from producing full
   sized programs, and the editor will not save any files, but they will
   enable you to investigate the workings of the M2Sprint system.
   
   These are the main components of the M2Sprint system;

     · Very fast single-pass Modula-2 compiler

     · Very fast single-pass program linker

     · Sophisticated Modula-2 text editor

     · Post-mortem symbolic debugger

     · Flexible environmnet. Run components from the editor, ARexx, CLI
       or Workbench

     · Standard Modula-2 library modules

     · 'Easy' Amiga interface modules

     · Support modules to interface to ARP, ARexx and IFF.

     · Advanced in-line Amiga system interface modules


   Please follow the notes in each file and you will be given
   a guided tour of M2Sprint's features.

   =======================================================================

   First, let's show the speed of the M2Sprint environment.

   The source contained in this file is a sample game demo from
   M2Sprint. NOTE: this is a full program, not just a 'hello world'
   program. 

   To compile the program: press the F1 key. The editor will load the
   compiler and then compile the source direct from the editor. The
   bar graph at the top of the window shows the compiler's progress 
   through the source file. Now, type F1 again. Notice how the
   compiler has remained loaded and can be called without loading it
   from the disk. Both the compiler and linker, once loaded, are 
   instantly available from the editor.

   Ok, having compiled the program (twice!) we now need to link it.
   Press the F2 key. The linker will load and proceed to gather the
   library modules. Notice how the linker did not need to fetch files
   for most of the Amiga's interface libraries! The advanced library
   in-line code feature means that the program calls the Amiga routines
   directly, without need of 'binding' routines. This has both the
   advantage of a fast link speed and small resultant programs as you don't
   have to load 'bindings' you don't need.

   Now for the big moment: press the F3 key to run the program.....

   See how simple it all was? M2Sprint offers the features that
   enable you to produce working programs, fast.

   =======================================================================

             Now please click the close gadget of this window.

   ======================================================================= *)


MODULE Tiles;

(*======================================================================*)
(*      Version: 3.00           Author : Martin Taillefer               *)
(*      Date   : 16-Nov-88      Changes: Update for new compiler.       *)
(*======================================================================*)

FROM SYSTEM     IMPORT ADR, ADDRESS, BYTE, TSIZE, CODE, LONG, SHORT;
FROM Intuition  IMPORT Gadget, GadgetFlags, GadgetFlagSet, WindowFlags,
                       WindowFlagSet, IDCMPFlags, IDCMPFlagSet, GadgHNone,
                       ActivationFlags, ActivationFlagSet, WBenchScreen,
                       BoolGadget, WindowPtr, NewWindow, SmartRefresh,
                       IntuiMessagePtr, GadgetPtr, CurrentTime, DisplayBeep,
                       OpenWindow, CloseWindow, SetWindowTitles,
                       IntuiText, AutoRequest;
FROM Rasters    IMPORT RastPortPtr, Jam1;
FROM Pens       IMPORT SetAPen, SetDrMd, RectFill, Move;
FROM Ports      IMPORT GetMsg, ReplyMsg, WaitPort, MessagePtr;
FROM Text       IMPORT Text, TextAttr, FontStyles, FontStyleSet, FontFlags,
                       FontFlagSet, TextFontPtr, OpenFont, CloseFont, SetFont;
FROM RandomNumbers IMPORT Random, seed;


CONST
  BlankTile = 15;


VAR
  font       : TextFontPtr;
  wp         : WindowPtr;
  rp         : RastPortPtr;
  gadgets    : ARRAY [0..1] OF Gadget;
  textattr   : TextAttr;
  i          : CARDINAL;
  neighbors  : ARRAY [0..15] OF BITSET;
  tileonspot,goalspot : ARRAY [0..15] OF CARDINAL;


PROCEDURE InitWindow():WindowPtr;
(* open a window and return a pointer to it *)
VAR
  nw : NewWindow;
BEGIN
  WITH nw DO
    LeftEdge   := 149;
    TopEdge    := 39;
    Width      := 341;
    Height     := 121;
    DetailPen  := BYTE(0);
    BlockPen   := BYTE(1);
    IDCMPFlags := IDCMPFlagSet{GadgetUp,GadgetDown,CloseWindowFlag};
    Flags      := WindowFlagSet{WindowDepth,WindowClose,WindowDrag,Activate,
			        RMBTrap}+SmartRefresh;
    FirstGadget:= ADR(gadgets);
    CheckMark  := NIL;
    Title      := ADR("Tiles 3.00");
    Screen     := NIL;
    BitMap     := NIL;
    Type       := WBenchScreen;
  END;

  RETURN OpenWindow(ADR(nw));
END InitWindow;


PROCEDURE InitGadgets;
(* guess what this does *)
BEGIN
  WITH gadgets[0] DO
    NextGadget := ADR(gadgets[1]);
    LeftEdge   := 97;
    TopEdge    := 96;
    Width      := 148;
    Height     := 15;
    Flags      := GadgetFlagSet{};
    Activation := ActivationFlagSet{RelVerify};
    GadgetType := BoolGadget;
    GadgetText    := NIL;
    MutualExclude := LONGBITSET{};
    GadgetID      := 0;
  END;

  WITH gadgets[1] DO
    NextGadget := NIL;
    LeftEdge   := 184;
    TopEdge    := 30;
    Width      := 125;
    Height     := 57;
    Flags      := GadgHNone;
    Activation := ActivationFlagSet{GadgImmediate};
    GadgetType := BoolGadget;
    GadgetText    := NIL;
    MutualExclude := LONGBITSET{};
    GadgetID      := 2;
  END;
END InitGadgets;


PROCEDURE Box(x0,y0,x1,y1:CARDINAL);
(* obviously, draws a box... *)
BEGIN
  RectFill(rp,x0,y0,x0+1,y1);
  RectFill(rp,x1-1,y0,x1,y1);
  RectFill(rp,x0,y0,x1,y0);
  RectFill(rp,x0,y1,x1,y1);
END Box;


PROCEDURE CreateDisplay;
BEGIN
  WITH textattr DO
    taName  := ADR("topaz.font");
    taYSize := 9;
    taStyle := FontStyleSet{};
    taFlags := FontFlagSet{ROMFont};
  END;

  font:=OpenFont(ADR(textattr));
  SetFont(rp,font);

  SetAPen(rp,1);
  RectFill(rp,5,11,335,118);
  SetAPen(rp,2);
  RectFill(rp,23,27,161,89);
  RectFill(rp,177,27,315,89);
  SetAPen(rp,1);
  Box(27,29,157,87);
  Box(181,29,311,87);

  SetAPen(rp,2);
  SetDrMd(rp,Jam1);
  Move(rp,120,105);
  Text(rp,ADR("Mix 'em up!"),11);

  Move(rp,50,23);
  Text(rp,ADR("Your GOAL"),9);
  Move(rp,234,23);
  Text(rp,ADR("YOU"),3);
  RectFill(rp,246,98,247,113);
  RectFill(rp,248,99,248,113);
  RectFill(rp,249,100,249,113);
  RectFill(rp,98,112,249,112);
  RectFill(rp,101,113,249,113);

  SetAPen(rp,3);
  Box(95,95,246,111);
  Move(rp,49,22);
  Text(rp,ADR("Your GOAL"),9);
  Move(rp,233,22);
  Text(rp,ADR("YOU"),3);
END CreateDisplay;


(*$X- Kill entry/exit code for this procedure *)
PROCEDURE GoalData;
(* Various layouts for the goal tiles *)
BEGIN
  CODE(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15);
  CODE(0,4,8,12,1,5,9,13,2,6,10,14,3,7,11,15);
  CODE(0,1,2,3,11,12,13,4,10,15,14,5,9,8,7,6);
  CODE(1,3,5,7,9,11,13,15,0,2,4,6,8,10,12,14);
  CODE(6,7,8,9,5,14,15,10,4,13,12,11,3,2,1,0);
  CODE(0,1,2,3,7,6,5,4,8,9,10,11,15,14,13,12);
  CODE(0,7,8,15,1,6,9,14,2,5,10,13,3,4,11,12)
END GoalData;


PROCEDURE InitData;
VAR
  i   : CARDINAL;
  ptr : POINTER TO CARDINAL;
BEGIN
  neighbors[0] :={1,4};
  neighbors[1] :={0,2,5};
  neighbors[2] :={1,3,6};
  neighbors[3] :={2,7};
  neighbors[4] :={0,5,8};
  neighbors[5] :={1,4,6,9};
  neighbors[6] :={2,5,7,10};
  neighbors[7] :={3,6,11};
  neighbors[8] :={4,9,12};
  neighbors[9] :={5,8,10,13};
  neighbors[10]:={6,9,11,14};
  neighbors[11]:={7,10,15};
  neighbors[12]:={8,13};
  neighbors[13]:={9,12,14};
  neighbors[14]:={10,13,15};
  neighbors[15]:={11,14};

  ptr:=ADDRESS(Random(7)*32)+ADR(GoalData); (* Choose a goal *)
  FOR i:=0 TO 15 DO
    goalspot[i]:=ptr^;
    tileonspot[i]:=i;
    ptr:=ADDRESS(ptr)+ADDRESS(2);
  END;
END InitData;


PROCEDURE CardToStr(card:CARDINAL;VAR str:ARRAY OF CHAR);
BEGIN
  IF card>9 THEN
    str[0]:=CHR((card DIV 10)+CARDINAL("0"));
    str[1]:=CHR((card MOD 10)+CARDINAL("0"));
  ELSE
    str[0]:=CHR((card MOD 10)+CARDINAL("0"));
  END;
END CardToStr;


PROCEDURE PutTile(spot,tilenum,surface:CARDINAL);
(* Given the parameters, draws a tile *)
VAR
  x1,y1 : CARDINAL;
  str   : ARRAY [0..2] OF CHAR;
BEGIN
  x1:=(spot MOD 4)*31+30+154*surface;
  y1:=(spot DIV 4)*14+30;
  IF tilenum=BlankTile THEN
    SetAPen(rp,2);
    RectFill(rp,x1,y1,x1+30,y1+14);
  ELSE
    INC(tilenum);
    SetAPen(rp,1);
    IF ODD(tilenum) THEN
      SetAPen(rp,3);
    END;
    RectFill(rp,x1+1,y1+1,x1+29,y1+13);
    SetAPen(rp,2);
    Move(rp,x1+11-5*(tilenum DIV 10),y1+10);
    CardToStr(tilenum,str);
    Text(rp,ADR(str),1+(tilenum DIV 10));
  END;
END PutTile;


PROCEDURE WhichSpot(x,y:CARDINAL):CARDINAL;
(* Given a coordinate return a tile position # *)
BEGIN
  DEC(x,184);
  DEC(y,30);
  RETURN (x DIV 31)+(y DIV 14)*4;
END WhichSpot;


PROCEDURE Switch(first,second,surface:CARDINAL);
(* Exchange two tiles *)
VAR
  temp : CARDINAL;
BEGIN
  temp:=tileonspot[first];
  tileonspot[first]:=tileonspot[second];
  tileonspot[second]:=temp;
  PutTile(first,tileonspot[first],surface);
  PutTile(second,tileonspot[second],surface);
END Switch;


PROCEDURE MixEmUp;
(* Get everybody all confused! *)
VAR
  sec   : LONGCARD;
  i,j   : CARDINAL;
  start : CARDINAL;
BEGIN
  CurrentTime(sec,seed); (* get a really random value for the seed *)
  InitData;
  FOR i:=0 TO 15 DO
    PutTile(i,goalspot[i],0);
    PutTile(i,tileonspot[i],1);
  END;

  FOR i:=0 TO 200 DO
    j:=0;
    LOOP
      IF tileonspot[j]=BlankTile THEN
        start:=Random(16);
        WHILE NOT (start IN neighbors[j]) DO
          INC(start);
          IF start>15 THEN
            start:=0;
          END;
        END;
        Switch(j,start,1);
        EXIT;
      END;
      INC(j);
      IF j=16 THEN
        EXIT;
      END;
    END;
  END;
END MixEmUp;


PROCEDURE SimpleReq();
VAR
  intui : ARRAY [0..1] OF IntuiText;
  bool  : BOOLEAN;
BEGIN
  WITH intui[0] DO
    FrontPen  := BYTE(0);
    DrawMode  := Jam1;
    LeftEdge  := 16;
    TopEdge   := 15;
    IText     := ADR("You got it! (finally)");
    ITextFont := ADR(textattr);
    NextText  := NIL;
  END;
  WITH intui[1] DO
    FrontPen  := BYTE(0);
    DrawMode  := Jam1;
    LeftEdge  := 6;
    TopEdge   := 3;
    IText     := ADR("I knew it!");
    ITextFont := ADR(textattr);
    NextText  := NIL;
  END;
  bool:=AutoRequest(NIL,ADR(intui[0]),NIL,
	            ADR(intui[1]),IDCMPFlagSet{},IDCMPFlagSet{},320,72);
END SimpleReq;


PROCEDURE Main;
(* Process all events, actually let the user play the stupid game... *)
VAR
  intuimsg : IntuiMessagePtr;
  class    : IDCMPFlagSet;
  x,y,spot : CARDINAL;
  check    : BOOLEAN;
  i        : CARDINAL;
BEGIN
  LOOP
    intuimsg:=WaitPort(wp^.UserPort);
    intuimsg:=GetMsg(wp^.UserPort);
    class:=intuimsg^.Class;
    x:=CARDINAL(intuimsg^.MouseX);
    y:=CARDINAL(intuimsg^.MouseY);
    ReplyMsg(intuimsg);

    IF class=IDCMPFlagSet{CloseWindowFlag} THEN
      EXIT;
    ELSIF class=IDCMPFlagSet{GadgetDown} THEN
      check:=FALSE;
      spot:=WhichSpot(x,y);
      IF tileonspot[spot] # BlankTile THEN
        FOR i:=0 TO 15 DO
          IF i IN neighbors[spot] THEN
            IF tileonspot[i]=BlankTile THEN
              check:=TRUE;
              Switch(spot,i,1);
            END;
          END;
        END;
      END;

      IF NOT check THEN
        DisplayBeep(NIL);
      END;
    ELSIF class=IDCMPFlagSet{GadgetUp} THEN
      MixEmUp;
    END;
  END;
END Main;


BEGIN
(* Set up for game and jump to main event handler procedure *)
  InitGadgets;
  wp:=InitWindow();
  IF wp # NIL THEN
    rp:=wp^.RPort;
    CreateDisplay;
    MixEmUp;
    Main;
    CloseFont(font);
    CloseWindow(wp);
  END;
END Tiles.