(* 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 AdvMap ;
IMPORT StdIO ;
FROM Scan IMPORT WriteError, GetNextSymbol, OpenSource, CloseSource ;
FROM StrIO IMPORT ReadString, WriteString, WriteLn ;
FROM NumberIO IMPORT WriteCard ;
FROM StrLib IMPORT StrEqual, StrLen, StrCopy ;
FROM ASCII IMPORT cr, lf, nul, EOL ;
VAR
CurrentRoom : CARDINAL ;
CurrentSymbol : ARRAY [0..20] OF CHAR ;
FatelError : BOOLEAN ;
(* IncPosition increments the x,y coordinates according *)
(* the Direction sent. *)
PROCEDURE IncPosition (VAR x, y: CARDINAL ; Dir: CARDINAL) ;
BEGIN
IF (Dir=0) AND (y>0)
THEN
DEC(y)
ELSIF Dir=3
THEN
INC(x)
ELSIF Dir=2
THEN
INC(y)
ELSIF x>0
THEN
DEC(x)
END
END IncPosition ;
(* Adjacent tests whether two rooms R1 & R2 are adjacent *)
(* Assume that access to map has been granted. *)
PROCEDURE Adjacent (R1, R2: CARDINAL) : BOOLEAN ;
VAR
i, r1, r2 : CARDINAL ;
ok: BOOLEAN ;
BEGIN
WITH Rooms[R1] DO
i := NoOfDoors ;
ok := FALSE ;
WHILE (i>0) AND (NOT ok) DO
IF Doors[i].LeadsTo=R2
THEN
ok := TRUE
ELSE
DEC(i)
END
END
END ;
RETURN( ok )
END Adjacent ;
(* The following procedures test and read the syntax marking out the *)
(* map of the adventure game. Displaying syntactic errors if occurred *)
(*
ReadAdvMap - read map, Name, into memory.
TRUE is returned if the operation was successful.
*)
PROCEDURE ReadAdvMap (Name: ARRAY OF CHAR) : BOOLEAN ;
VAR
Success: BOOLEAN ;
BEGIN
Success := OpenSource(Name) ;
IF Success
THEN
GetNextSymbol(CurrentSymbol) ;
WHILE (NOT StrEqual( CurrentSymbol, 'END.' )) AND (NOT FatelError) DO
ReadRoom ;
GetNextSymbol(CurrentSymbol)
END ;
CloseSource ;
Success := NOT FatelError
ELSE
WriteString('cannot open: ') ; WriteString(Name) ; WriteLn
END ;
RETURN( Success )
END ReadAdvMap ;
PROCEDURE ReadRoom ;
BEGIN
IF NOT FatelError
THEN
IF NOT StrEqual( CurrentSymbol, 'ROOM' )
THEN
WriteError('ROOM --- Expected') ;
FatelError := TRUE
ELSE
GetNextSymbol(CurrentSymbol) ;
ReadRoomNo ;
IF (CurrentRoom<1) OR (CurrentRoom>MaxNoOfRooms)
THEN
WriteError('Out Of Range Error - Room No.') ;
FatelError := TRUE ;
WriteString('Non Recoverable Error') ;
WriteLn
ELSE
WITH Rooms[CurrentRoom] DO
Treasures := {} ;
NoOfWalls := 0 ;
NoOfDoors := 0 ;
END ;
GetNextSymbol(CurrentSymbol) ;
WHILE (NOT StrEqual( CurrentSymbol, 'END' )) AND
(NOT FatelError) DO
IF StrEqual( CurrentSymbol, 'WALL' )
THEN
ReadWall
ELSIF StrEqual( CurrentSymbol, 'DOOR' )
THEN
ReadDoor
ELSIF StrEqual( CurrentSymbol, 'TREASURE' )
THEN
ReadTreasure
ELSE
WriteError('WALL, DOOR, TREASURE, END --- Expected') ;
FatelError := TRUE ;
GetNextSymbol(CurrentSymbol)
END
END
END
END
END
END ReadRoom ;
PROCEDURE ReadWall ;
VAR
x1, y1,
x2, y2: CARDINAL ;
BEGIN
IF NOT FatelError
THEN
GetNextSymbol(CurrentSymbol) ;
WITH Rooms[CurrentRoom] DO
REPEAT
INC( NoOfWalls ) ;
IF NoOfWalls>WallsPerRoom
THEN
WriteError('Out Of Range Error - Too Many Walls') ;
FatelError := TRUE ;
WriteString('Non Recoverable Error') ;
WriteLn
ELSE
ReadCard( x1 ) ;
GetNextSymbol(CurrentSymbol) ;
ReadCard( y1 ) ;
GetNextSymbol(CurrentSymbol) ;
ReadCard( x2 ) ;
GetNextSymbol(CurrentSymbol) ;
ReadCard( y2 ) ;
IF (x1#x2) AND (y1#y2)
THEN
WriteError('Diagonal Wall --- Not Allowed') ;
FatelError := TRUE
END ;
(* Always have the lowest value of x in x1 OR y in y1 *)
IF (x1<x2) OR (y1<y2)
THEN
Walls[NoOfWalls].X1 := x1 ;
Walls[NoOfWalls].Y1 := y1 ;
Walls[NoOfWalls].X2 := x2 ;
Walls[NoOfWalls].Y2 := y2
ELSE
Walls[NoOfWalls].X1 := x2 ;
Walls[NoOfWalls].Y1 := y2 ;
Walls[NoOfWalls].X2 := x1 ;
Walls[NoOfWalls].Y2 := y1
END
END ;
GetNextSymbol(CurrentSymbol) ;
UNTIL StrEqual( CurrentSymbol, 'WALL' ) OR
StrEqual( CurrentSymbol, 'DOOR' ) OR
StrEqual( CurrentSymbol, 'TREASURE' ) OR
StrEqual( CurrentSymbol, 'END' ) OR
FatelError ;
END ;
END
END ReadWall ;
PROCEDURE ReadDoor ;
VAR
x1, y1,
x2, y2: CARDINAL ;
BEGIN
IF NOT FatelError
THEN
GetNextSymbol(CurrentSymbol) ;
WITH Rooms[CurrentRoom] DO
REPEAT
INC( NoOfDoors ) ;
IF NoOfDoors>DoorsPerRoom
THEN
WriteError('Out Of Range Error - Too Many Doors') ;
FatelError := TRUE ;
WriteString('Non Recoverable Error') ;
WriteLn
ELSE
ReadCard( x1 ) ;
GetNextSymbol(CurrentSymbol) ;
ReadCard( y1 ) ;
GetNextSymbol(CurrentSymbol) ;
ReadCard( x2 ) ;
GetNextSymbol(CurrentSymbol) ;
ReadCard( y2 ) ;
IF (x1#x2) AND (y1#y2)
THEN
WriteError('Diagonal Door --- Not Allowed') ;
FatelError := TRUE
END ;
(* Always have the lowest value of x in x1 OR y in y1 *)
IF (x1<x2) OR (y1<y2)
THEN
Doors[NoOfDoors].Position.X1 := x1 ;
Doors[NoOfDoors].Position.Y1 := y1 ;
Doors[NoOfDoors].Position.X2 := x2 ;
Doors[NoOfDoors].Position.Y2 := y2
ELSE
Doors[NoOfDoors].Position.X1 := x2 ;
Doors[NoOfDoors].Position.Y1 := y2 ;
Doors[NoOfDoors].Position.X2 := x1 ;
Doors[NoOfDoors].Position.Y2 := y1
END ;
GetNextSymbol(CurrentSymbol) ;
IF NOT StrEqual( CurrentSymbol, 'STATUS' )
THEN
WriteError('STATUS --- Expected') ;
FatelError := TRUE
END ;
GetNextSymbol(CurrentSymbol) ;
IF StrEqual( CurrentSymbol, 'CLOSED' )
THEN
Doors[NoOfDoors].StateOfDoor := Closed
ELSIF StrEqual( CurrentSymbol, 'SECRET' )
THEN
Doors[NoOfDoors].StateOfDoor := Secret
ELSIF StrEqual( CurrentSymbol, 'OPEN' )
THEN
Doors[NoOfDoors].StateOfDoor := Open
ELSE
WriteError('Illegal Door Status')
END ;
GetNextSymbol(CurrentSymbol) ;
IF NOT StrEqual( CurrentSymbol, 'LEADS' )
THEN
WriteError('LEADS --- Expected') ;
FatelError := TRUE
END ;
GetNextSymbol(CurrentSymbol) ;
IF NOT StrEqual( CurrentSymbol, 'TO' )
THEN
WriteError('TO --- Expected') ;
FatelError := TRUE
END ;
GetNextSymbol(CurrentSymbol) ;
ReadCard( x1 ) ;
IF x1>MaxNoOfRooms
THEN
WriteError('Out Of Range Error - Room No.') ;
FatelError := TRUE
ELSE
Doors[NoOfDoors].LeadsTo := x1
END
END ;
GetNextSymbol(CurrentSymbol) ;
UNTIL StrEqual( CurrentSymbol, 'DOOR' ) OR
StrEqual( CurrentSymbol, 'WALL' ) OR
StrEqual( CurrentSymbol, 'TREASURE' ) OR
StrEqual( CurrentSymbol, 'END' ) OR
FatelError ;
END
END
END ReadDoor ;
PROCEDURE ReadTreasure ;
VAR
x, y, TreasureNo: CARDINAL ;
BEGIN
IF NOT FatelError
THEN
GetNextSymbol(CurrentSymbol) ;
REPEAT
WITH Rooms[CurrentRoom] DO
IF NOT StrEqual( CurrentSymbol, 'AT' )
THEN
WriteError('AT --- Expected') ;
FatelError := TRUE
END ;
GetNextSymbol(CurrentSymbol) ;
ReadCard( x ) ;
GetNextSymbol(CurrentSymbol) ;
ReadCard( y ) ;
GetNextSymbol(CurrentSymbol) ;
IF NOT StrEqual( CurrentSymbol, 'IS' )
THEN
WriteError('IS --- Expected') ;
FatelError := TRUE
END ;
GetNextSymbol(CurrentSymbol) ;
ReadCard( TreasureNo ) ;
IF (TreasureNo<=MaxNoOfTreasures) AND (TreasureNo>0)
THEN
(* Tell Room about treasures *)
INCL( Treasures, TreasureNo ) ;
(* Tell Treasures about Treasures! and Room *)
Treasure[TreasureNo].Xpos := x ;
Treasure[TreasureNo].Ypos := y ;
Treasure[TreasureNo].Rm := CurrentRoom ;
ELSE
WriteError('Out Of Range Error - Treasure No.') ;
FatelError := TRUE
END
END ;
GetNextSymbol(CurrentSymbol) ;
UNTIL StrEqual( CurrentSymbol, 'WALL' ) OR
StrEqual( CurrentSymbol, 'DOOR' ) OR
StrEqual( CurrentSymbol, 'TREASURE' ) OR
StrEqual( CurrentSymbol, 'END' ) OR
FatelError ;
END
END ReadTreasure ;
PROCEDURE ReadRoomNo ;
BEGIN
IF NOT FatelError
THEN
ReadCard( CurrentRoom ) ;
IF (CurrentRoom>0) AND (CurrentRoom<=MaxNoOfRooms)
THEN
IF CurrentRoom>ActualNoOfRooms
THEN
ActualNoOfRooms := CurrentRoom
END
END
END
END ReadRoomNo ;
PROCEDURE ReadCard (VAR c: CARDINAL) ;
VAR
i : CARDINAL ;
High : CARDINAL ;
ch : CHAR ;
BEGIN
IF NOT FatelError
THEN
i := 0 ;
c := 0 ;
High := HIGH(CurrentSymbol) ;
REPEAT
ch := CurrentSymbol[i] ;
IF (ch>='0') AND (ch<='9')
THEN
c := c*10+ORD(ch)-ORD('0')
ELSIF ch#nul
THEN
WriteError('Cardinal Number Expected') ;
FatelError := TRUE
END ;
INC( i ) ;
UNTIL (i>High) OR (ch=nul) ;
END
END ReadCard ;
PROCEDURE Init ;
BEGIN
ActualNoOfRooms := 0 ;
FatelError := FALSE
END Init ;
BEGIN
Init
END AdvMap.