(* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
                 Free Software Foundation, Inc. *)
(* This file is part of GNU Modula-2.

GNU Modula-2 is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.

GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License along
with gm2; see the file COPYING.  If not, write to the Free Software
Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
IMPLEMENTATION MODULE BoxMap ;

(*
   Title      : MakeMap
   Author     : Gaius Mulley
   Date       : 18/7/88
   LastEdit   : 18/7/88
   System     : LOGITECH MODULA-2/86
   Description: Generates a simple random box map for Dungeon
*)

IMPORT Break ;
FROM StdIO IMPORT Write, Read ;
FROM StrIO IMPORT WriteString, WriteLn ;
FROM NumberIO IMPORT WriteCard, ReadCard ;
FROM Assertion IMPORT Assert ;
FROM Geometry IMPORT IsSubLine, IsSubRange, IsIntersectingRange,
                     IntersectionLength, IsPointOnLine, Abs, Min, Max ;
FROM MakeBoxes IMPORT InitBoxes, KillBoxes,
                      AddBoxes, GetAndDeleteRandomBox ;
FROM StoreCoords IMPORT InitCoords, KillCoords,
                        GetAndDeleteRandomCoord, AddCoord, CoordsExist ;
FROM Chance IMPORT InitRandom, KillRandom,
                   GetAndDeleteRandom, AddRandom,
                   GetRand ;

CONST
   MaxCard  = 65535 ;

   MaxStack =   500 ;

TYPE
   Square = RECORD
               Contents    : (Empty, Secret, Door, Wall, Treasure) ;
               RoomOfSquare: CARDINAL ;
            END ;

   Map      = ARRAY [1..MaxX], [1..MaxY] OF Square ;

   StackEntity = RECORD
                    PerimeterIndex  : CARDINAL ;  (* Untried Coords   *)
                    BoxIndex        : CARDINAL ;  (* Untried boxes    *)
                    OrientationIndex: CARDINAL ;  (* Untried orient's *)
                 END ;

VAR
   CurrentMap       : Map ;
   Stack            : ARRAY [1..MaxStack] OF StackEntity ;
   StackPtr         : CARDINAL ;


(*
   InitializeMap - Initializes CurrentMap.
                   CurrentMap has its boarder set to a Wall and middle
                   is set to Empty.
*)

PROCEDURE InitializeMap ;
VAR
   i, j: CARDINAL ;
BEGIN
   FOR i := 1 TO MaxX DO
      FOR j := 1 TO MaxY DO
         WITH CurrentMap[i, j] DO
            Contents := Empty ;
            RoomOfSquare := 0
         END
      END
   END
END InitializeMap ;


(*
   Init - Initialize the module and start the generation of a map.
*)

PROCEDURE Init ;
BEGIN
   NoOfBoxes := 0 ;
   (* Initialize box 0 the edge of the map *)
   WITH Boxes[0] DO
      x1 := 1 ;
      x2 := MaxX ;
      y1 := 1 ;
      y2 := MaxY
   END ;
   StackPtr := 0
END Init ;


(*
   CreateBoxMap - builds a map with central corridors and ajoining rooms.
*)

PROCEDURE CreateBoxMap ;
BEGIN
   Init ;
   CorridorMap ;
   RoomMap
END CreateBoxMap ;


(*
   CorridorMap - makes a map based arround central corridors.
*)

PROCEDURE CorridorMap ;
BEGIN
   CreateCorridors ;
   NoOfCorridorBoxes := NoOfBoxes
END CorridorMap ;


(*
   CleanUpStack - cleans up the temporary stack where alternative rooms were
                  stored but are no longer needed.
*)

PROCEDURE CleanUpStack ;
BEGIN
   WHILE StackPtr>0 DO
      WITH Stack[StackPtr] DO
         KillBoxes(BoxIndex) ;
         KillCoords(PerimeterIndex) ;
         KillRandom(OrientationIndex)
      END ;
      DEC(StackPtr)
   END
END CleanUpStack ;


(*
   RoomMap - creates the rooms on the map which fill in space left by the
             corridors.
*)

PROCEDURE RoomMap ;
BEGIN
   WriteString('Starting Room building') ; WriteLn ;
   CreateRooms
END RoomMap ;


(*
   CreateCorridors - creates a length of corridor on the map.
*)

PROCEDURE CreateCorridors ;
VAR
   Length,
   LengthLeft: CARDINAL ;
BEGIN
   LengthLeft := TotalCorridorLength ;
   InitBoxCorridor ;  (* Place new Box on the stack *)
   REPEAT
      IF MakeCorridor()
      THEN
         WITH Boxes[NoOfBoxes] DO
            Length := Max(Abs(x1, x2), Abs(y1, y2))
         END ;
         IF LengthLeft>Length
         THEN
            DEC(LengthLeft, Length) ;
            InitBoxCorridor   (* Place new corridors on the stack *)
         ELSE
            LengthLeft := 0   (* All done *)
         END
      ELSE
         IF StackPtr>0
         THEN
            (* Retract last corridor and try another *)
            WriteString('Backtracking') ; WriteLn ;
            WriteString('HALTing - quicker than backtracking') ; WriteLn ;
            HALT ;
            WITH Boxes[NoOfBoxes] DO
               INC(LengthLeft, Max(Abs(x1, x2), Abs(y1, y2)))
            END ;
            KillBox ;
            UnMakeBox
         ELSE
            WriteString('Run out of ideas! MaxCorridorLength too large!') ;
            WriteLn ;
            LengthLeft := 0    (* Fail safe exit *)
         END
      END
   UNTIL LengthLeft=0
END CreateCorridors ;


(*
   CreateRooms - places rooms inbetween the corridors on the map.
*)

PROCEDURE CreateRooms ;
VAR
   Finished: BOOLEAN ;
BEGIN
   InitBoxRoom ;
   Finished := FALSE ;
   REPEAT
      IF MakeRoom()
      THEN
         InitBoxRoom ;
         Finished := NOT CoordsExist(Stack[StackPtr].PerimeterIndex)
      ELSE
         Finished := TRUE ;
(*
         IF StackPtr>0
         THEN
            (* Retract last room and try another *)
            WriteString('Backtracking room') ; WriteLn ;
            KillBox ;
            UnMakeBox
         ELSE
            WriteString('Run out of ideas! Trying to create rooms!') ;
            WriteLn ;
         END
*)
      END
   UNTIL Finished ;
END CreateRooms ;


(*
   MakeCorridor - returns true if a corridor was legally placed
                  onto the map.
*)

PROCEDURE MakeCorridor () : BOOLEAN ;
VAR
   Success   : BOOLEAN ;
   x, y      : CARDINAL ;
BEGIN
   WITH Stack[StackPtr] DO
      (*
         Perimeter has been previously pushed.
         We now try to place a piece of corridor
         on a selected perimeter coordinate.
      *)
      Success := FALSE ;
      REPEAT
         GetAndDeleteRandomCoord(PerimeterIndex, x, y) ;
         x := Min(x, MaxX) ;
         y := Min(y, MaxY) ;
         IF x#0  (* x=0 means no more coordinates to fetch *)
         THEN
            Success := PutCorridorOntoMap(x, y)
         END
      UNTIL Success OR (x=0)    (* x=0 and y=0 means no coordinates left *)
                                (* when x=0  y is also 0.                *)
   END ;
   RETURN( Success )
END MakeCorridor ;


(*
   MakeRoom - returns true if a room was legally placed
              onto the map.
*)

PROCEDURE MakeRoom () : BOOLEAN ;
VAR
   Success   : BOOLEAN ;
   x, y      : CARDINAL ;
BEGIN
   WITH Stack[StackPtr] DO
      (*
         Perimeter has been previously pushed.
         We now try to place a piece of corridor
         on a selected perimeter coordinate.
      *)
      Success := FALSE ;
      REPEAT
         GetAndDeleteRandomCoord(PerimeterIndex, x, y) ;
         IF x#0  (* x=0 means no more coordinates to fetch *)
         THEN
            Success := PutRoomOntoMap(x, y)
         END
      UNTIL Success OR (x=0)    (* x=0 and y=0 means no coordinates left *)
                                (* when x=0  y is also 0.                *)
   END ;
   RETURN( Success )
END MakeRoom ;


(*
   UnMakeBox - deletes the last box placed in the Box list.
*)

PROCEDURE UnMakeBox ;
BEGIN
(*
   IF NoOfCorridorBoxes>0
   THEN
      FindSpaceNextToRoom
   END ;
*)
   DEC(NoOfBoxes)
END UnMakeBox ;


(*
   KillSurroundingBoxes - finds a pocket of space on the map and deletes
                          all neighbouring boxes.
*)

(*
PROCEDURE KillSurroundingBoxes ;
VAR
   x, y,
   i, j,
   Swap, b: CARDINAL ;
BEGIN
   GetFreeSpace(x, y) ;
   i := x ;
   j := y ;
   Swap := NoOfBoxes ;
   REPEAT
      b := 1 ;
      WHILE b<=Swap DO
         IF IsPointOnBox(b, i, j)
         THEN
            SwapBox(b, Swap) ;
            DEC(Swap)
         END ;
         INC(b)
      END ;
      WalkClockWise(i, j)
   UNTIL (x=i) AND (y=j) ;
   RenewBoxes(Swap, Swap)
END KillSurroundingBoxes ;
*)


(*
   SwapBox - swaps two boxes, i and j, arround on the stack.
*)

PROCEDURE SwapBox (i, j: CARDINAL) ;
VAR
   s: StackEntity ;
   b: Box ;
BEGIN
   b := Boxes[i] ;
   Boxes[i] := Boxes[j] ;
   Boxes[j] := b ;
   s := Stack[i] ;
   Stack[i] := Stack[j] ;
   Stack[j] := s
END SwapBox ;


(*
   FindSpaceNextToRoom - finds a pocket of space on the map and places
                         a room near this onto the top of the box stack.
*)

PROCEDURE FindSpaceNextToRoom ;
VAR
   t: Box ;
   x, y, b, d,
   Nearest,
   Distance  : CARDINAL ;
BEGIN
   GetSpaceCoord(x, y) ;
   Nearest := 1 ;
   Distance := DistanceAppartPoint(1, x, y) ;
   b := NoOfBoxes-1 ;
   WHILE b>1 DO
      d := DistanceAppartPoint(b, x, y) ;
      IF d<Distance
      THEN
         Distance := d ;
         Nearest := b
      END ;
      DEC(b)
   END ;
   SwapBox(Nearest, NoOfBoxes)
END FindSpaceNextToRoom ;


(*
   GetSpaceCoord - Sets x and y to a coordinate which has no room on it.
*)

PROCEDURE GetSpaceCoord (VAR x, y: CARDINAL) ;
VAR
   Space: BOOLEAN ;
BEGIN
   Space := FALSE ;
   x := 1 ;
   WHILE (NOT Space) AND (x<=MaxX) DO
      y := 1 ;
      WHILE (NOT Space) AND (y<=MaxY) DO
         IF NOT IsSpace(x, y)
         THEN
            INC(y)
         ELSE
            Space := TRUE
         END
      END ;
      IF NOT Space
      THEN
         INC(x)
      END
   END
END GetSpaceCoord ;


(*
   Reschedule - reorders boxes on the stack, all boxes that touch the
                top box are placed n-1 n-2 etc on the stack,
                efficient recursive backtracking!
*)

PROCEDURE Reschedule (Lowest: CARDINAL) ;
VAR
   b,
   Swap: CARDINAL ;
   t   : Box ;
BEGIN
   Swap := NoOfBoxes-1 ;
   b := Lowest+1 ;
   WITH Boxes[NoOfBoxes] DO
      WHILE Swap>b DO
         IF IsTouchingBox(b, x1, y1, x2, y2)
         THEN
            SwapBox(b, Swap) ;
            INC(b)
         END ;
         DEC(Swap)
      END
   END
END Reschedule ;


(*
   InitBoxCorridor - initializes a new corridor on the Stack,
                     the perimeter of the map is also pushed.
*)

PROCEDURE InitBoxCorridor ;
BEGIN
   INC(StackPtr) ;
   WITH Stack[StackPtr] DO
      PerimeterIndex := InitCoords() ;
      PushPerimeterOfBoxes(PerimeterIndex, FALSE) ;
      OrientationIndex := 0 ;
      BoxIndex := 0
   END
END InitBoxCorridor ;


(*
   InitBoxRoom - initializes a new corridor on the Stack,
                 the perimeter of the map is also pushed.
*)

PROCEDURE InitBoxRoom ;
BEGIN
   (*
      This is a really nasty kludge - because of memory space limitations
      the StoreCoords module is pushed for space when creating large size
      maps.
      The kludge to get arround this is to kill all perimeter coordinates of the
      previous box. This can be done since we never invoke backtracking
      when creating boxrooms - but we may when we come up with a suitable
      reliable algorithm, however, until then we can take advantage of
      no backtracking and delete all perimeter coords of the last box.
   *)
   IF StackPtr>1
   THEN
      (* Ok delete perimeter coord *)
      KillCoords(Stack[StackPtr].PerimeterIndex) ;
      KillBoxes(Stack[StackPtr].BoxIndex)
   END ;
   (* All done - kludge over *)
   INC(StackPtr) ;
   WITH Stack[StackPtr] DO
      PerimeterIndex := InitCoords() ;
      PushPerimeterOfBoxes(PerimeterIndex, TRUE) ;
      OrientationIndex := 0 ;
      BoxIndex := 0
   END
END InitBoxRoom ;


(*
   KillBox - pops the last Box from the stack.
*)

PROCEDURE KillBox ;
BEGIN
   WITH Stack[StackPtr] DO
      KillCoords(PerimeterIndex)
   END ;
   DEC(StackPtr)
END KillBox ;


(*
   PutCorridorOntoMap - returns true if it has placed a corridor
                        onto a map.
                        Otherwise no corridor has been placed onto
                        this map.
*)

PROCEDURE PutCorridorOntoMap (x, y: CARDINAL) : BOOLEAN ;
VAR
   LenX,
   LenY    : CARDINAL ;
   Success : BOOLEAN ;
BEGIN
   CheckInitBoxCorridorIndex ;
   WITH Stack[StackPtr] DO
      Success := FALSE ;
      REPEAT
         IF GetBox(LenX, LenY)
         THEN
            Success := PlaceCorridorBox(x, y, LenX-1, LenY-1)
         END
      UNTIL Success OR (LenX=0) ;
   END ;
   CheckKillBoxIndex(LenX=0) ;
   RETURN( Success )
END PutCorridorOntoMap ;


(*
   PutRoomOntoMap - returns true if it has placed a room
                    onto a map.
                    Otherwise no room has been placed onto
                    this map.
*)

PROCEDURE PutRoomOntoMap (x, y: CARDINAL) : BOOLEAN ;
VAR
   LenX,
   LenY    : CARDINAL ;
   Success : BOOLEAN ;
BEGIN
   CheckInitBoxRoomIndex ;
   WITH Stack[StackPtr] DO
      Success := FALSE ;
      REPEAT
         IF GetBox(LenX, LenY)
         THEN
            Success := PlaceRoomBox(x, y, LenX-1, LenY-1)
         END
      UNTIL Success OR (LenX=0) ;
   END ;
   CheckKillBoxIndex(LenX=0) ;
   RETURN( Success )
END PutRoomOntoMap ;


(*
   GetBox - returns true if a box can be returned.
            It chooses one box from the box index,
            from the stack.
            The lengths of the Box are returned
            in LengthX and LengthY.
*)

PROCEDURE GetBox (VAR LengthX, LengthY: CARDINAL) : BOOLEAN ;
BEGIN
   WITH Stack[StackPtr] DO
      GetAndDeleteRandomBox(BoxIndex, LengthX, LengthY)
   END ;
   RETURN(LengthX#0)        (* LengthX#0 means found legal size box *)
END GetBox ;


(*
   CheckInitBoxCorridorIndex - checks to see whether the current
                               stacked box needs
                               a list of legal corridor sizes stacked.
*)

PROCEDURE CheckInitBoxCorridorIndex ;
BEGIN
   WITH Stack[StackPtr] DO
      IF BoxIndex=0
      THEN
         (* Without stacked box list of legal sized corridors *)
         BoxIndex := InitBoxes() ;
         AddBoxes(BoxIndex, MinCorridorLength, CorridorWidth,
                            MaxCorridorLength, CorridorWidth) ;
         AddBoxes(BoxIndex, CorridorWidth, MinCorridorLength,
                            CorridorWidth, MaxCorridorLength)
      END
   END
END CheckInitBoxCorridorIndex ;


(*
   CheckInitBoxRoomIndex - checks to see whether the current stack box
                           needs a list of legal corridor sizes stacked.
*)

PROCEDURE CheckInitBoxRoomIndex ;
BEGIN
   WITH Stack[StackPtr] DO
      IF BoxIndex=0
      THEN
         (* Without stacked box list of legal sized rooms *)
         BoxIndex := InitBoxes() ;
         AddBoxes(BoxIndex, MinRoomLength, MinRoomLength,
                            MaxRoomLength, MaxRoomLength)
      END
   END
END CheckInitBoxRoomIndex ;


(*
   CheckKillBoxIndex - if NeedToKill is set then the list of boxes
                       on the stack is killed.
                       Ideally this procedure should be a macro.
*)

PROCEDURE CheckKillBoxIndex (NeedToKill: BOOLEAN) ;
BEGIN
   IF NeedToKill
   THEN
      WITH Stack[StackPtr] DO
         KillBoxes(BoxIndex) ;
         BoxIndex := 0
      END
   END
END CheckKillBoxIndex ;


(*
   PlaceCorridorBox - returns true if a box can make a corridor at
                      position x, y.
                      All 4 orientations are tried.


                              2  1
                              4  3

                      Ie  1:  (x, y) (x+LenX, y+LenY)
                          2:  (x, y) (x-LenX, y+LenY)
                          3:  (x, y) (x+LenX, y-LenY)
                          4:  (x, y) (x-LenX, y-LenY)
*)

PROCEDURE PlaceCorridorBox (x, y: CARDINAL; LenX, LenY: CARDINAL) : BOOLEAN ;
VAR
   Success: BOOLEAN ;
   i      : CARDINAL ;
BEGIN
   CheckInitOrientationIndex ;
   WITH Stack[StackPtr] DO
      Success := FALSE ;
      REPEAT
         i := GetAndDeleteRandom(OrientationIndex) ;
         CASE i OF

         1:  Success := AttemptToPlaceCorridor(x, y, x+LenX, y+LenY) |

         2:  IF x>LenX
             THEN
                Success := AttemptToPlaceCorridor(x-LenX, y, x, y+LenY)
             END |

         3:  IF y>LenY
             THEN
                Success := AttemptToPlaceCorridor(x, y-LenY, x+LenX, y)
             END |

         4:  IF (x>LenX) AND (y>LenY)
             THEN
                Success := AttemptToPlaceCorridor(x-LenX, y-LenY, x, y)
             END

         ELSE
         END
      UNTIL Success OR (i=0) ;
   END ;
   CheckKillOrientationIndex(i=0) ;
   RETURN( Success )
END PlaceCorridorBox ;


(*
   PlaceRoomBox - returns true if a box can make a corridor at
                  position x, y.
                  All 4 orientations are tried.


                          2  1
                          4  3

                  Ie  1:  (x, y) (x+LenX, y+LenY)
                      2:  (x, y) (x-LenX, y+LenY)
                      3:  (x, y) (x+LenX, y-LenY)
                      4:  (x, y) (x-LenX, y-LenY)
*)

PROCEDURE PlaceRoomBox (x, y: CARDINAL; LenX, LenY: CARDINAL) : BOOLEAN ;
VAR
   Success: BOOLEAN ;
   i      : CARDINAL ;
BEGIN
   CheckInitOrientationIndex ;
   WITH Stack[StackPtr] DO
      Success := FALSE ;
      REPEAT
         i := GetAndDeleteRandom(OrientationIndex) ;
         CASE i OF

         1:  Success := AttemptToPlaceRoom(x, y, x+LenX, y+LenY) |

         2:  IF x>LenX
             THEN
                Success := AttemptToPlaceRoom(x-LenX, y, x, y+LenY)
             END |

         3:  IF y>LenY
             THEN
                Success := AttemptToPlaceRoom(x, y-LenY, x+LenX, y)
             END |

         4:  IF (x>LenX) AND (y>LenY)
             THEN
                Success := AttemptToPlaceRoom(x-LenX, y-LenY, x, y)
             END

         ELSE
         END
      UNTIL Success OR (i=0) ;
   END ;
   CheckKillOrientationIndex(i=0) ;
   RETURN( Success )
END PlaceRoomBox ;


(*
   CheckInitOrientationIndex - checks to see whether the current stacked
                               entity needs a new orientation index to also
                               be stacked.
*)

PROCEDURE CheckInitOrientationIndex ;
BEGIN
   WITH Stack[StackPtr] DO
      IF OrientationIndex=0
      THEN
         OrientationIndex := InitRandom() ;
         AddRandom(OrientationIndex, 4)
      END
   END
END CheckInitOrientationIndex ;


(*
   CheckKillOrientationIndex - checks to see whether the current stacked
                               entities orientation index needs to be
                               deleted.
                               This procedure ideally should be a macro..
*)

PROCEDURE CheckKillOrientationIndex (NeedToKill: BOOLEAN) ;
BEGIN
   IF NeedToKill
   THEN
      WITH Stack[StackPtr] DO
         KillRandom(OrientationIndex) ;
         OrientationIndex := 0
      END
   END
END CheckKillOrientationIndex ;


(*
   PushPerimeterOfBoxes - pushes all the current perimeter of the box map onto
                          the perimeter stack.
*)

PROCEDURE PushPerimeterOfBoxes (CoordIndex: CARDINAL; NoOpt: BOOLEAN) ;
VAR
   i: CARDINAL ;
BEGIN
   IF NoOfBoxes=0
   THEN
      (* Perimeter is center square in map *)
      AddCoord(CoordIndex, MaxX DIV 2, MaxY DIV 2)
   ELSE
      i := 1 ;
      WHILE i<=NoOfBoxes DO
         PushPerimeterOfWalls(CoordIndex, i, NoOpt) ;
         INC(i)
      END
   END
END PushPerimeterOfBoxes ;


(*
   PushPerimeterOfWalls - pushes all coordinates of a box wall which are
                          external to the group of boxes.
                          Ie any wall which does is not shared by an
                          adjacent box MUST be external.
                          NoOpt determines whether optimization should be
                          applied to the restricting of perimeter coords.
                          Optimiztion tests for the minimum size of a room
                          to any wall, if this fails the coord is not added
                          to the perimeter list.
                          However this should not be used when pushing the
                          room perimeter since optimization is too restrictive.
                          (Corridor restrictions etc).
*)

PROCEDURE PushPerimeterOfWalls (CoordIndex: CARDINAL; b: CARDINAL;
                                NoOpt: BOOLEAN) ;
VAR
   i, j: CARDINAL ;
BEGIN
   WITH Boxes[b] DO
      FOR i := x1 TO x2 DO
         IF IsExternalHorizWallPerimeter(b, i, y1) AND
            (NoOpt OR IsEnoughSpacePointToBox(i, y1))
         THEN
            AddCoord(CoordIndex, i, y1)
         END ;
         IF IsExternalHorizWallPerimeter(b, i, y2) AND
            (NoOpt OR IsEnoughSpacePointToBox(i, y2))
         THEN
            AddCoord(CoordIndex, i, y2)
         END
      END ;
      FOR j := y1 TO y2 DO
         IF IsExternalVertWallPerimeter(b, x1, j) AND
            (NoOpt OR IsEnoughSpacePointToBox(x1, j))
         THEN
            AddCoord(CoordIndex, x1, j)
         END ;
         IF IsExternalVertWallPerimeter(b, x2, j) AND
            (NoOpt OR IsEnoughSpacePointToBox(x2, j))
         THEN
            AddCoord(CoordIndex, x2, j)
         END
      END
   END
END PushPerimeterOfWalls ;


(*
   IsExternalHorizWallPerimeter - returns true if coordinates,
                                  x and y are not on any Horiz
                                  wall of any box except b.
                                  This routine allows point z, y to be
                                  on a Vertical wall, but NOT on another
                                  Horizontal wall.
*)

PROCEDURE IsExternalHorizWallPerimeter (b: CARDINAL;
                                        x, y: CARDINAL) : BOOLEAN ;
VAR
   i    : CARDINAL ;
   Found: BOOLEAN ;
BEGIN
   Found := FALSE ;
   IF NOT IsCornerPerimeter(b, x, y)
   THEN
      i := 0 ;
      WHILE (i<=NoOfBoxes) AND (NOT Found) DO
         IF i#b
         THEN
            WITH Boxes[i] DO
               IF IsPointOnLine(x, y, x1, y1, x2, y1)
               THEN
                  Found := TRUE
               ELSIF IsPointOnLine(x, y, x1, y2, x2, y2)
               THEN
                  Found := TRUE
               END
            END
         END ;
         INC(i)
      END
   END ;
   RETURN( NOT Found )
END IsExternalHorizWallPerimeter ;


(*
   IsExternalVertWallPerimeter - returns true if coordinates,
                                 x and y are not on any Vertical
                                 wall of any box except b.
                                 This routine allows point z, y to be
                                 on a Horizontal wall, but NOT on another
                                 Vertical wall.
*)

PROCEDURE IsExternalVertWallPerimeter (b: CARDINAL;
                                       x, y: CARDINAL) : BOOLEAN ;
VAR
   i    : CARDINAL ;
   Found: BOOLEAN ;
BEGIN
   Found := FALSE ;
   IF NOT IsCornerPerimeter(b, x, y)
   THEN
      i := 0 ;
      WHILE (i<=NoOfBoxes) AND (NOT Found) DO
         IF i#b
         THEN
            WITH Boxes[i] DO
               IF IsPointOnLine(x, y, x1, y1, x1, y2)
               THEN
                  Found := TRUE
               ELSIF IsPointOnLine(x, y, x2, y1, x2, y2)
               THEN
                  Found := TRUE
               END
            END
         END ;
         INC(i)
      END
   END ;
   RETURN( NOT Found )
END IsExternalVertWallPerimeter ;


(*
   AttemptToPlaceCorridor - attempts to place a corridor x1, y1  x2, y2
                            onto the map.
                            If it succeeds it returns true
                            otherwise false
*)

PROCEDURE AttemptToPlaceCorridor (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
VAR
   Success: BOOLEAN ;
BEGIN
   IF IsCorridorSatisfied(x1, y1, x2, y2)
   THEN
      AddBox(x1, y1, x2, y2) ;
      Success := TRUE
   ELSE
      Success := FALSE
   END ;
   RETURN( Success )
END AttemptToPlaceCorridor ;


(*
   AttemptToPlaceRoom - attempts to place a room x1, y1  x2, y2
                        onto the map.
                        If it succeeds it returns true
                        otherwise false
*)

PROCEDURE AttemptToPlaceRoom (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
VAR
   Success: BOOLEAN ;
BEGIN
   IF IsRoomSatisfied(x1, y1, x2, y2)
   THEN
      AddBox(x1, y1, x2, y2) ;
      Success := TRUE
   ELSE
      Success := FALSE
   END ;
   RETURN( Success )
END AttemptToPlaceRoom ;


(*
   IsCorridorSatisfied - returns true if a Corridor x1, y1  x2, y2
                         may be placed onto the map without
                         contraveining the various rules.
*)

PROCEDURE IsCorridorSatisfied (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
VAR
   Success: BOOLEAN ;
BEGIN
   (* Put(x1, y1, x2, y2) ; *)
   IF (x2>MaxX) OR (y2>MaxY)
   THEN
      (* WriteString('Failed SIZE') ; WriteLn *)
      Success := FALSE
   ELSIF NOT DistanceAppartEdge(x1, y1, x2, y2)
   THEN
      Success := FALSE
   ELSIF IsOverLappingBox(x1, y1, x2, y2)
   THEN
      (* WriteString('Failed OVERLAP') ; *)
      Success := FALSE
   ELSIF NOT IsCorridorJoin(x1, y1, x2, y2)
   THEN
      (* WriteString('Failed CORRIDOR JOIN') ; *)
      Success := FALSE
   ELSIF NOT IsEnoughSpaceBetweenCorridors(x1, y1, x2, y2)
   THEN
      (* WriteString('Failed SPACE') ; *)
      Success := FALSE
   ELSE
      Success := TRUE
   END ;
   RETURN( Success )
END IsCorridorSatisfied ;


(*
   IsRoomSatisfied - returns true if a box x1, y1  x2, y2
                     may be placed onto the map without
                     contraveining the various rules.
*)

PROCEDURE IsRoomSatisfied (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
VAR
   Success: BOOLEAN ;
BEGIN
   (* Put(x1, y1, x2, y2) ; *)
   IF (x2>MaxX) OR (y2>MaxY)
   THEN
      (* WriteString('Failed SIZE') ; WriteLn ; *)
      Success := FALSE
   ELSIF IsOverLappingBox(x1, y1, x2, y2)
   THEN
      (* WriteString('Failed OVERLAP') ; *)
      Success := FALSE
   ELSIF NOT DistanceAppartEdge(x1, y1, x2, y2)
   THEN
      Success := FALSE
   ELSIF NOT IsBoxRoomLegal(x1, y1, x2, y2)
   THEN
      (* WriteString('Failed Legal') ; *)
      Success := FALSE
   ELSIF NOT IsRoomJoin(x1, y1, x2, y2)
   THEN
      (* WriteString('Failed ROOM JOIN') ; *)
      Success := FALSE
   ELSIF NOT IsEnoughSpaceBetweenRooms(x1, y1, x2, y2)
   THEN
      (* WriteString('Failed SPACE') ; *)
      Success := FALSE
   ELSE
      Success := TRUE
      (* ; WriteString('SUCCESS') ; *)
   END ;
   RETURN( Success )
END IsRoomSatisfied ;


(*
   IsEnoughSpacePointToBox - returns true if there is enough space
                             between a point, x, y and all the boxes.
                             This routine is called before perimeter
                             coordinates are pushed, therefore coordinates
                             pushed are not doomed to failure due to lack
                             of space.
                             This routine consists of a reduced
                             IsEnoughSpaceBetweenBoxes procedure.
*)

PROCEDURE IsEnoughSpacePointToBox (x, y: CARDINAL) : BOOLEAN ;
VAR
   ok      : BOOLEAN ;
   i       : CARDINAL ;
   Distance: CARDINAL ;
BEGIN
   ok := TRUE ;
   i := 0 ;  (* 0 = Perimeter of map *)
   WHILE ok AND (i<=NoOfBoxes) DO
      Distance := DistanceAppartPoint(i, x, y) ;
      IF Distance#0
      THEN
         ok := (Distance>=MinDistanceBetweenRooms)
      END ;
      INC(i)
   END ;
   RETURN( ok )
END IsEnoughSpacePointToBox ;


(*
   IsEnoughSpaceBetweenCorridors - returns true if there is enough
                                   space between box x1, y1  x2, y2
                                   and the other boxes.
                                   Also tests for right angle connection.
*)

PROCEDURE IsEnoughSpaceBetweenCorridors (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
VAR
   ok      : BOOLEAN ;
   i       : CARDINAL ;
   Distance: CARDINAL ;
BEGIN
   ok := TRUE ;
   i := 1 ;
   WHILE ok AND (i<=NoOfBoxes) DO
      IF IsTouchingBox(i, x1, y1, x2, y2)
      THEN
         (* Check for a box that is not at right angles to new box. *)
         (* We are only allowed to touch a box at right angles.     *)
         IF NOT IsDifferentOrientationBox(i, x1, y1, x2, y2)
         THEN
            (* touching a box which is not at right angles *)
            ok := FALSE
         END
      ELSIF FreeSpace(i, x1, y1, x2, y2)
      THEN
         Distance := DistanceAppartBox(i, x1, y1, x2, y2) ;
(*
      Distance := Min(
                       DistanceAppartBox(i, x1, y1, x2, y2),
                       DistanceAppartDiagonal(i, x1, y1, x2, y2)
                     ) ;
*)
         IF Distance=0
         THEN
         ELSE
            ok := (Distance>=MinDistanceBetweenCorridors)
         END
      END ;
      INC(i)
   END ;
   RETURN( ok )
END IsEnoughSpaceBetweenCorridors ;


(*
   IsBoxRoomLegal - returns true if a box x1, y1, x2, y2 does not
                    have a wall which is next to but not sharing
                    another wall.
*)

PROCEDURE IsBoxRoomLegal (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
VAR
   ok      : BOOLEAN ;
   i       : CARDINAL ;
   Distance: CARDINAL ;
   CoveredN,
   CoveredS,
   CoveredE,
   CoveredW: BOOLEAN ;
BEGIN
   CoveredN := IsFullyCovered(x1, y2, x2, y2) ;
   CoveredS := IsFullyCovered(x1, y1, x2, y1) ;
   CoveredE := IsFullyCovered(x2, y1, x2, y2) ;
   CoveredW := IsFullyCovered(x1, y1, x1, y2) ;
   ok := TRUE ;
   i := 1 ;
   WHILE ok AND (i<=NoOfBoxes) DO
      IF NOT IsTouchingBox(i, x1, y1, x2, y2)
      THEN
         IF (x1>1) AND (NOT CoveredW)
         THEN
            ok := NOT IsTouchingBox(i, x1-1, y1, x2, y2)
         END ;
         IF ok AND (y1>1) AND (NOT CoveredS)
         THEN
            ok := NOT IsTouchingBox(i, x1, y1-1, x2, y2)
         END ;
         IF ok AND (x2<MaxX) AND (NOT CoveredE)
         THEN
            ok := NOT IsTouchingBox(i, x1, y1, x2+1, y2)
         END ;
         IF ok AND (y2<MaxY) AND (NOT CoveredN)
         THEN
            ok := NOT IsTouchingBox(i, x1, y1, x2, y2+1)
         END
      END ;
      INC(i)
   END ;
   RETURN( ok )
END IsBoxRoomLegal ;


(*
   IsFullyCovered - returns true if every point on the line
                    x1, y1, x2, y2 is covered. The line must
                    either be horizontal or vertical.
*)

PROCEDURE IsFullyCovered (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
VAR
   i      : CARDINAL ;
   Covered: BOOLEAN ;
BEGIN
   Covered := TRUE ;
   IF x1=x2
   THEN
      (* Vertical *)
      i := y1 ;
      WHILE Covered AND (i<=y2) DO
         Covered := IsSpace(x1, i) ;
         INC(i)
      END
   ELSIF y1=y2
   THEN
      (* Horizontal *)
      i := x1 ;
      WHILE Covered AND (i<=x2) DO
         Covered := IsSpace(i, y1) ;
         INC(i)
      END
   END ;
   RETURN( Covered )
END IsFullyCovered ;


(*
   IsEnoughSpaceBetweenRooms - returns true if there is enough
                               space between box x1, y1  x2, y2
                               and the other boxes.
*)

PROCEDURE IsEnoughSpaceBetweenRooms (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
VAR
   ok      : BOOLEAN ;
   i       : CARDINAL ;
   Distance: CARDINAL ;
BEGIN
   ok := TRUE ;
   i := 1 ;
   WHILE ok AND (i<=NoOfBoxes) DO
      IF NOT IsTouchingBox(i, x1, y1, x2, y2)
      THEN
         (* Dont test the walls of the box for contraveining the space rule *)
(*
         IF (x1+1<x2-1) AND (y1+1<y2-1) AND FreeSpace(i, x1+1, y1+1, x2-1, y2-1)
         THEN
            Distance := DistanceAppartDiagonal(i, x1+1, y1+1, x2-1, y2-1) ;
*)
         IF FreeSpace(i, x1, y1, x2, y2)
         THEN
(*
            Distance := DistanceAppartDiagonal(i, x1, y1, x2, y2) ;
*)
            Distance := Max( DistanceAppartDiagonal(i, x1, y1, x2, y2),
                             DistanceAppartBox(i, x1, y1, x2, y2) ) ;
            (* WriteString('Dist') ; WriteCard(Distance, 6) ; WriteLn ; *)
            IF Distance=0
            THEN
               (* touching a box *)
            ELSE
               Assert(NOT IsTouchingBox(i, x1, y1, x2, y2)) ;
               ok := (Distance>=MinDistanceBetweenRooms)
            END
         END
      END ;
      INC(i)
   END ;
   RETURN( ok )
END IsEnoughSpaceBetweenRooms ;


(*
   FreeSpace - returns true if there exists free space between box
               X1, Y1, X2, Y2 and box b.
               Should not be called if box b touches X1, Y1, X2, Y2.
*)

PROCEDURE FreeSpace (b: CARDINAL; X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
VAR
   Free  : BOOLEAN ;
   xs, xe,
   ys, ye,
   i, j  : CARDINAL ;
BEGIN
   WITH Boxes[b] DO
      IF Abs(X1, x2)<Abs(X2, x1)
      THEN
         xs := Min(X1, x2) ;
         xe := Max(X1, x2)
      ELSE
         xs := Min(X2, x1) ;
         xe := Max(X2, x1)
      END ;
      IF Abs(Y1, y2)<Abs(Y2, y1)
      THEN
         ys := Min(Y1, y2) ;
         ye := Max(Y1, y2)
      ELSE
         ys := Min(Y2, y1) ;
         ye := Max(Y2, y1)
      END ;
      Free := FALSE ;
      i := xs ;
      WHILE (NOT Free) AND (i<=xe) DO
         j := ys ;
         WHILE (NOT Free) AND (j<=ye) DO
            Free := IsSpace(i, j) ;
            INC(j)
         END ;
         INC(i)
      END
   END ;
   (* IF Free THEN WriteString('FREE') END ; *)
   RETURN( Free )
END FreeSpace ;


(*
   IsSpace - returns true if point x, y is not in any box.
             A wall is counted as in the box.
*)

PROCEDURE IsSpace (x, y: CARDINAL) : BOOLEAN ;
VAR
   b    : CARDINAL ;
   InBox: BOOLEAN ;
BEGIN
   InBox := FALSE ;
   b := 1 ;   (* Not zero of course !! *)
   WHILE (NOT InBox) AND (b<=NoOfBoxes) DO
      WITH Boxes[b] DO
         InBox := IsSubRange(x1, x2, x) AND IsSubRange(y1, y2, y)
      END ;
      INC(b)
   END ;
   RETURN( NOT InBox )
END IsSpace ;


(*
   DistanceAppartEdge - returns true if the box, x1, y1, x2, y2, is a
                        required distance away from the edge of the
                        map.
                        Cannot use room zero for this test as we are inside
                        it and may touch one wall but be too near another!
*)

PROCEDURE DistanceAppartEdge (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
VAR
   ok      : BOOLEAN ;
   Distance: CARDINAL ;
BEGIN
    ok := TRUE ;
    Distance := Abs(x1, 1) ;
    IF (Distance>0) AND ok
    THEN
       ok := (Distance>=MinDistanceBetweenRooms)
    END ;
    Distance := Abs(x2, MaxX) ;
    IF (Distance>0) AND ok
    THEN
       ok := (Distance>=MinDistanceBetweenRooms)
    END ;
    Distance := Abs(y1, 1) ;
    IF (Distance>0) AND ok
    THEN
       ok := (Distance>=MinDistanceBetweenRooms)
    END ;
    Distance := Abs(y2, MaxY) ;
    IF (Distance>0) AND ok
    THEN
       ok := (Distance>=MinDistanceBetweenRooms)
    END ;
    RETURN( ok )
END DistanceAppartEdge ;


(*
   DistanceAppartPoint - returns the distance appart between box, b,
                         and point X, Y.
*)

PROCEDURE DistanceAppartPoint (b: CARDINAL; X, Y: CARDINAL) : CARDINAL ;
VAR
   Xmin,
   Ymin: CARDINAL ;
BEGIN
   WITH Boxes[b] DO
      IF IsSubRange(x1, x2, X)
      THEN
         Ymin := Min( Abs(y1, Y), Abs(y2, Y) )
      ELSE
         Ymin := MaxCard
      END ;
      IF IsSubRange(y1, y2, Y)
      THEN
         Xmin := Min( Abs(x1, X), Abs(x2, X) )
      ELSE
         Xmin := MaxCard
      END
   END ;
   RETURN( Min(Xmin, Ymin) )
END DistanceAppartPoint ;


(*
   DistanceAppartBox - returns the distance appart between box, b,
                       and box X1, Y1, X2, Y2
*)

PROCEDURE DistanceAppartBox (b: CARDINAL; X1, Y1, X2, Y2: CARDINAL) : CARDINAL ;
VAR
   Xmin,
   Ymin: CARDINAL ;
BEGIN
   WITH Boxes[b] DO
      IF IsIntersectingRange(x1, x2, X1, X2)
      THEN
         Ymin := Min(
                      Min( Abs(y1, Y1), Abs(y2, Y2) ),
                      Min( Abs(y1, Y2), Abs(Y1, y2) )
                    )
      ELSE
         Ymin := MaxCard
      END ;
      IF IsIntersectingRange(y1, y2, Y1, Y2)
      THEN
         Xmin := Min(
                      Min( Abs(x1, X1), Abs(x2, X2) ),
                      Min( Abs(x1, X2), Abs(X1, x2) )
                    )
      ELSE
         Xmin := MaxCard
      END
   END ;
   RETURN( Min(Xmin, Ymin) )
END DistanceAppartBox ;


(*
   DistanceAppartDiagonal - returns the diagonal
                            distance appart between X1, Y1, X2, Y2
                            and box b.
*)

PROCEDURE DistanceAppartDiagonal (b: CARDINAL;
                                  X1, Y1, X2, Y2: CARDINAL) : CARDINAL ;
BEGIN
   WITH Boxes[b] DO
      RETURN(
              Min(
                   Min( Abs(x1, X2), Abs(x2, X1) ),
                   Min( Abs(y1, Y2), Abs(y2, Y1) )
                 )
            )
   END
END DistanceAppartDiagonal ;


(*
   IsCorridorJoin - returns true if a box corridor x1, y1  x2, y2
                    joins another corridor at right angles without
                    cutting off the potential corridor door.

                    A corridor is thought of as

                    ##########################
                    |                        |
                    |                        |
                    ##########################

                    and may only be placed together in a way such that
                    they meet  -|  or  -  etc
                                       |

                    False is returned if this box corridor does not
                    correctly form a T junction with another.
*)

PROCEDURE IsCorridorJoin (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
VAR
   ok,
   DoorFound: BOOLEAN ;
   b        : CARDINAL ;
BEGIN
   ok := TRUE ;
   IF NoOfBoxes=0
   THEN
      DoorFound := TRUE
   ELSE
      DoorFound := FALSE ;
      b := 1 ;
      WHILE ok AND (b<=NoOfBoxes) DO
         (* WriteString('Box') ; WriteCard(b, 2) ; *)
         IF IsTouchingBox(b, x1, y1, x2, y2)
         THEN
            (* WriteString('TouchingBox') ; *)
            IF IsDifferentOrientationBox(b, x1, y1, x2, y2)
            THEN
               (* WriteString('Different Orientation') ; *)
               IF NOT DoorFound
               THEN
                  DoorFound := IsCorridorWallJoinBox(b, x1, y1, x2, y2)
               END
               (* ; IF ok THEN WriteString('WallJoin') END ; *)
            ELSE
               ok := FALSE  (* Dont allow parallel corridors to touch *)
            END
         END ;
         INC(b)
      END
   END ;
   RETURN( ok AND DoorFound )
END IsCorridorJoin ;


(*
   IsRoomJoin - returns true if a box room x1, y1  x2, y2
                joins another room with enough space for a door.
*)

PROCEDURE IsRoomJoin (x1, y1, x2, y2: CARDINAL) : BOOLEAN ;
VAR
   DoorFound: BOOLEAN ;
   b        : CARDINAL ;
BEGIN
   IF NoOfBoxes=0
   THEN
      DoorFound := TRUE
   ELSE
      DoorFound := FALSE ;
      b := 1 ;
      WHILE (NOT DoorFound) AND (b<=NoOfBoxes) DO
         (* WriteString('Box') ; WriteCard(b, 2) ; *)
         IF IsTouchingBox(b, x1, y1, x2, y2)
         THEN
            IF NOT DoorFound
            THEN
               DoorFound := IsRoomWallJoinBox(b, x1, y1, x2, y2)
            END
         END ;
         INC(b)
      END
   END ;
   RETURN( DoorFound )
END IsRoomJoin ;


(*
   IsCorridorWallJoinBox - returns true if box, b, and box X1, Y1  X2, Y2
                           form a correct join ie covering the potential
                           door.
*)

PROCEDURE IsCorridorWallJoinBox (b: CARDINAL;
                                 X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
VAR
   Success: BOOLEAN ;
BEGIN
   WITH Boxes[b] DO
      Success := (((X1=x1) OR (X1=x2) OR (X2=x1) OR (X2=x2))
                              AND IsSubLine(Y1, Y2, y1, y2)) OR
                 (((Y1=y1) OR (Y1=y2) OR (Y2=y1) OR (Y2=y2))
                              AND IsSubLine(X1, X2, x1, x2)) ;
      RETURN( Success )
   END
END IsCorridorWallJoinBox ;


(*
   IsRoomWallJoinBox - returns true if box, b, and box X1, Y1  X2, Y2
                       form a correct join ie covering the potential
                       door.
*)

PROCEDURE IsRoomWallJoinBox (b: CARDINAL;
                             X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
VAR
   DoorWidth: CARDINAL ;
BEGIN
   DoorWidth := 0 ;
   WITH Boxes[b] DO
      IF (X1=x2) OR (x1=X2)
      THEN
         DoorWidth := IntersectionLength(Y1, Y2, y1, y2) ;
         IF (IsSubRange(Y1, Y2, y1) OR IsSubRange(y1, y2, Y1)) AND (DoorWidth>1)
         THEN
            DEC(DoorWidth)
         END ;
         IF (IsSubRange(Y1, Y2, y2) OR IsSubRange(y1, y2, Y2)) AND (DoorWidth>1)
         THEN
            DEC(DoorWidth)
         END
      ELSIF (Y1=y2) OR (y1=Y2)
      THEN
         DoorWidth := IntersectionLength(X1, X2, x1, x2) ;
         IF (IsSubRange(X1, X2, x1) OR IsSubRange(x1, x2, X1)) AND (DoorWidth>1)
         THEN
            DEC(DoorWidth)
         END ;
         IF (IsSubRange(X1, X2, x2) OR IsSubRange(x1, x2, X2)) AND (DoorWidth>1)
         THEN
            DEC(DoorWidth)
         END
      END ;
      RETURN( DoorWidth>=MinDoorLength )
   END
END IsRoomWallJoinBox ;


(*
   IsDifferentOrientationBox - returns true if box b has a different
                               orientation to box X1, Y1  X2, Y2.
*)

PROCEDURE IsDifferentOrientationBox (b: CARDINAL;
                                     X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
BEGIN
   WITH Boxes[b] DO
      IF Abs(X1, X2) = Abs(Y1, Y2)
      THEN
         RETURN( TRUE )                        (* Square X1, Y1, X2, Y2 *)
      ELSIF Abs(X1, X2) > Abs(Y1, Y2)
      THEN
         RETURN( Abs(x1, x2) <= Abs(y1, y2) )
      ELSE
         RETURN( Abs(x1, x2) >= Abs(y1, y2) )
      END
   END
END IsDifferentOrientationBox ;


(*
   IsTouchingBox - returns true if a box X1, Y1  X2, Y2 touches box b
                   or if it intersects with this box.
*)

PROCEDURE IsTouchingBox (b: CARDINAL; X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
BEGIN
   WITH Boxes[b] DO
      RETURN( NOT ((X2<x1) OR (X1>x2) OR (Y2<y1) OR (Y1>y2)) )
   END
END IsTouchingBox ;


(*
   IsCornerPerimeter - returns true if box, b, has a corner x, y which
                       is a perimeter.
*)

PROCEDURE IsCornerPerimeter (b: CARDINAL; x, y: CARDINAL) : BOOLEAN ;
VAR
   Perimeter: BOOLEAN ;
   i, j     : CARDINAL ;
BEGIN
   IF IsCorner(b, x, y)
   THEN
      Perimeter := FALSE ;
      i := x-1 ;
      j := y-1 ;
      WHILE (NOT Perimeter) AND (i<=x+1) DO
         j := y-1 ;
         WHILE (NOT Perimeter) AND (j<=y+1) DO
            IF IsSubRange(1, MaxX, i) AND IsSubRange(1, MaxY, j)
            THEN
               Perimeter := IsSpace(i, j)
            END ;
            INC(j, 2)
         END ;
         INC(i, 2)
      END ;
      RETURN( Perimeter )
   ELSE
      RETURN( FALSE )
   END
END IsCornerPerimeter ;


(*
   IsCorner - returns true if box, b, has a corner x, y.
*)

PROCEDURE IsCorner (b: CARDINAL; x, y: CARDINAL) : BOOLEAN ;
BEGIN
   WITH Boxes[b] DO
      RETURN( ((x1=x) OR (x2=x)) AND ((y1=y) OR (y2=y)) )
   END
END IsCorner ;


(*
   IsOverLappingBox - returns true if box X1, Y1  X2, Y2 overlaps
                      with another box NOT including edges touching.
*)

PROCEDURE IsOverLappingBox (X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
VAR
   b    : CARDINAL ;
   Found: BOOLEAN ;
BEGIN
   Found := FALSE ;
   b := 1 ;
   WHILE (NOT Found) AND (b<=NoOfBoxes) DO
      WITH Boxes[b] DO
         Found := IsIntersection(x1, y1, x2, y2, X1, Y1, X2, Y2)
      END ;
      INC(b)
   END ;
   RETURN( Found )
END IsOverLappingBox ;


(*
   IsIntersection - returns true if two boxes x1, y1  x2, y2 intersects
                    with X1, Y1  X2, Y2. Wall touching is allowed.
*)

PROCEDURE IsIntersection (x1, y1, x2, y2,
                          X1, Y1, X2, Y2: CARDINAL) : BOOLEAN ;
BEGIN
   RETURN( NOT ( (x2<=X1) OR (x1>=X2) OR (y2<=Y1) OR (y1>=Y2) ) )
END IsIntersection ;


(*
   AddBox - adds a box to the list of boxes and
            adds a box to the Map.
*)

PROCEDURE AddBox (X1, Y1, X2, Y2: CARDINAL) ;
BEGIN
   IF NoOfBoxes=MaxBoxes
   THEN
      WriteString('Too many boxes in Module MakeMap') ; WriteLn ;
      HALT
   ELSE
      INC(NoOfBoxes) ;
      WITH Boxes[NoOfBoxes] DO
         x1 := X1 ;
         y1 := Y1 ;
         x2 := X2 ;
         y2 := Y2
      END
   END
END AddBox ;


(*
   GetCh - waits for a character to be pressed.
*)

PROCEDURE GetCh ;
VAR
   ch: CHAR ;
BEGIN
   Read(ch)
END GetCh ;


BEGIN
   Init
END BoxMap.