gcc/testsuite/gm2/examples/map/pass/AdvMap.mod

   1 (* Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
   2                  Free Software Foundation, Inc. *)
   3 (* This file is part of GNU Modula-2.
   4
   5 GNU Modula-2 is free software; you can redistribute it and/or modify it under
   6 the terms of the GNU General Public License as published by the Free
   7 Software Foundation; either version 3, or (at your option) any later
   8 version.
   9
  10 GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
  11 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  12 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  13 for more details.
  14
  15 You should have received a copy of the GNU General Public License along
  16 with gm2; see the file COPYING.  If not, write to the Free Software
  17 Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *)
  18
  19 IMPLEMENTATION MODULE AdvMap ;
  20
  21 IMPORT StdIO ;
  22
  23 FROM Scan IMPORT WriteError, GetNextSymbol, OpenSource, CloseSource ;
  24 FROM StrIO IMPORT ReadString, WriteString, WriteLn ;
  25 FROM NumberIO IMPORT WriteCard ;
  26 FROM StrLib IMPORT StrEqual, StrLen, StrCopy ;
  27 FROM ASCII IMPORT cr, lf, nul, EOL ;
  28
  29
  30 VAR
  31    CurrentRoom          : CARDINAL ;
  32    CurrentSymbol        : ARRAY [0..20] OF CHAR ;
  33    FatelError           : BOOLEAN ;
  34
  35
  36 (* IncPosition increments the x,y coordinates according  *)
  37 (* the Direction sent.                                   *)
  38
  39 PROCEDURE IncPosition (VAR x, y: CARDINAL ; Dir: CARDINAL) ;
  40 BEGIN
  41    IF (Dir=0) AND (y>0)
  42    THEN
  43       DEC(y)
  44    ELSIF Dir=3
  45    THEN
  46       INC(x)
  47    ELSIF Dir=2
  48    THEN
  49       INC(y)
  50    ELSIF x>0
  51    THEN
  52       DEC(x)
  53    END
  54 END IncPosition ;
  55
  56
  57
  58 (* Adjacent tests whether two rooms R1 & R2 are adjacent *)
  59 (* Assume that access to map has been granted.           *)
  60
  61 PROCEDURE Adjacent (R1, R2: CARDINAL) : BOOLEAN ;
  62 VAR
  63    i, r1, r2 : CARDINAL ;
  64    ok: BOOLEAN ;
  65 BEGIN
  66    WITH Rooms[R1] DO
  67       i := NoOfDoors ;
  68       ok := FALSE ;
  69       WHILE (i>0) AND (NOT ok) DO
  70          IF Doors[i].LeadsTo=R2
  71          THEN
  72             ok := TRUE
  73          ELSE
  74             DEC(i)
  75          END
  76       END
  77    END ;
  78    RETURN( ok )
  79 END Adjacent ;
  80
  81
  82 (* The following procedures test and read the syntax marking out the  *)
  83 (* map of the adventure game. Displaying syntactic errors if occurred *)
  84
  85 (*
  86    ReadAdvMap - read map, Name, into memory.
  87                 TRUE is returned if the operation was successful.
  88 *)
  89
  90 PROCEDURE ReadAdvMap (Name: ARRAY OF CHAR) : BOOLEAN ;
  91 VAR
  92    Success: BOOLEAN ;
  93 BEGIN
  94    Success := OpenSource(Name) ;
  95    IF Success
  96    THEN
  97       GetNextSymbol(CurrentSymbol) ;
  98       WHILE (NOT StrEqual( CurrentSymbol, 'END.' )) AND (NOT FatelError) DO
  99          ReadRoom ;
 100          GetNextSymbol(CurrentSymbol)
 101       END ;
 102       CloseSource ;
 103       Success := NOT FatelError
 104    ELSE
 105       WriteString('cannot open: ') ; WriteString(Name) ; WriteLn
 106    END ;
 107    RETURN( Success )
 108 END ReadAdvMap ;
 109
 110
 111 PROCEDURE ReadRoom ;
 112 BEGIN
 113    IF NOT FatelError
 114    THEN
 115       IF NOT StrEqual( CurrentSymbol, 'ROOM' )
 116       THEN
 117          WriteError('ROOM --- Expected') ;
 118          FatelError := TRUE
 119       ELSE
 120          GetNextSymbol(CurrentSymbol) ;
 121          ReadRoomNo ;
 122          IF (CurrentRoom<1) OR (CurrentRoom>MaxNoOfRooms)
 123          THEN
 124             WriteError('Out Of Range Error - Room No.') ;
 125             FatelError := TRUE ;
 126             WriteString('Non Recoverable Error') ;
 127             WriteLn
 128          ELSE
 129             WITH Rooms[CurrentRoom] DO
 130                Treasures := {} ;
 131                NoOfWalls := 0 ;
 132                NoOfDoors := 0 ;
 133             END ;
 134             GetNextSymbol(CurrentSymbol) ;
 135
 136             WHILE (NOT StrEqual( CurrentSymbol, 'END' )) AND
 137                   (NOT FatelError) DO
 138                IF StrEqual( CurrentSymbol, 'WALL' )
 139                THEN
 140                   ReadWall
 141                ELSIF StrEqual( CurrentSymbol, 'DOOR' )
 142                THEN
 143                   ReadDoor
 144                ELSIF StrEqual( CurrentSymbol, 'TREASURE' )
 145                THEN
 146                   ReadTreasure
 147                ELSE
 148                   WriteError('WALL, DOOR, TREASURE, END --- Expected') ;
 149                   FatelError := TRUE ;
 150                   GetNextSymbol(CurrentSymbol)
 151                END
 152             END
 153          END
 154       END
 155    END
 156 END ReadRoom ;
 157
 158
 159 PROCEDURE ReadWall ;
 160 VAR
 161    x1, y1,
 162    x2, y2: CARDINAL ;
 163 BEGIN
 164    IF NOT FatelError
 165    THEN
 166       GetNextSymbol(CurrentSymbol) ;
 167       WITH Rooms[CurrentRoom] DO
 168          REPEAT
 169             INC( NoOfWalls ) ;
 170             IF NoOfWalls>WallsPerRoom
 171             THEN
 172                WriteError('Out Of Range Error - Too Many Walls') ;
 173                FatelError := TRUE ;
 174                WriteString('Non Recoverable Error') ;
 175                WriteLn
 176             ELSE
 177                ReadCard( x1 ) ;
 178                GetNextSymbol(CurrentSymbol) ;
 179                ReadCard( y1 ) ;
 180                GetNextSymbol(CurrentSymbol) ;
 181                ReadCard( x2 ) ;
 182                GetNextSymbol(CurrentSymbol) ;
 183                ReadCard( y2 ) ;
 184
 185                IF (x1#x2) AND (y1#y2)
 186                THEN
 187                   WriteError('Diagonal Wall --- Not Allowed') ;
 188                   FatelError := TRUE
 189                END ;
 190
 191                (* Always have the lowest value of x in x1 OR y in y1 *)
 192
 193                IF (x1<x2) OR (y1<y2)
 194                THEN
 195                   Walls[NoOfWalls].X1 := x1 ;
 196                   Walls[NoOfWalls].Y1 := y1 ;
 197                   Walls[NoOfWalls].X2 := x2 ;
 198                   Walls[NoOfWalls].Y2 := y2
 199                ELSE
 200                   Walls[NoOfWalls].X1 := x2 ;
 201                   Walls[NoOfWalls].Y1 := y2 ;
 202                   Walls[NoOfWalls].X2 := x1 ;
 203                   Walls[NoOfWalls].Y2 := y1
 204                END
 205             END ;
 206             GetNextSymbol(CurrentSymbol) ;
 207          UNTIL StrEqual( CurrentSymbol, 'WALL' ) OR
 208                StrEqual( CurrentSymbol, 'DOOR' ) OR
 209                StrEqual( CurrentSymbol, 'TREASURE' ) OR
 210                StrEqual( CurrentSymbol, 'END' ) OR
 211                FatelError ;
 212       END ;
 213    END
 214 END ReadWall ;
 215
 216
 217 PROCEDURE ReadDoor ;
 218 VAR
 219    x1, y1,
 220    x2, y2: CARDINAL ;
 221 BEGIN
 222    IF NOT FatelError
 223    THEN
 224       GetNextSymbol(CurrentSymbol) ;
 225       WITH Rooms[CurrentRoom] DO
 226          REPEAT
 227             INC( NoOfDoors ) ;
 228             IF NoOfDoors>DoorsPerRoom
 229             THEN
 230                WriteError('Out Of Range Error - Too Many Doors') ;
 231                FatelError := TRUE ;
 232                WriteString('Non Recoverable Error') ;
 233                WriteLn
 234             ELSE
 235                ReadCard( x1 ) ;
 236                GetNextSymbol(CurrentSymbol) ;
 237                ReadCard( y1 ) ;
 238                GetNextSymbol(CurrentSymbol) ;
 239                ReadCard( x2 ) ;
 240                GetNextSymbol(CurrentSymbol) ;
 241                ReadCard( y2 ) ;
 242
 243                IF (x1#x2) AND (y1#y2)
 244                THEN
 245                   WriteError('Diagonal Door --- Not Allowed') ;
 246                   FatelError := TRUE
 247                END ;
 248
 249                (* Always have the lowest value of x in x1 OR y in y1 *)
 250
 251                IF (x1<x2) OR (y1<y2)
 252                THEN
 253                   Doors[NoOfDoors].Position.X1 := x1 ;
 254                   Doors[NoOfDoors].Position.Y1 := y1 ;
 255                   Doors[NoOfDoors].Position.X2 := x2 ;
 256                   Doors[NoOfDoors].Position.Y2 := y2
 257                ELSE
 258                   Doors[NoOfDoors].Position.X1 := x2 ;
 259                   Doors[NoOfDoors].Position.Y1 := y2 ;
 260                   Doors[NoOfDoors].Position.X2 := x1 ;
 261                   Doors[NoOfDoors].Position.Y2 := y1
 262                END ;
 263                GetNextSymbol(CurrentSymbol) ;
 264                IF NOT StrEqual( CurrentSymbol, 'STATUS' )
 265                THEN
 266                   WriteError('STATUS --- Expected') ;
 267                   FatelError := TRUE
 268                END ;
 269                GetNextSymbol(CurrentSymbol) ;
 270                IF StrEqual( CurrentSymbol, 'CLOSED' )
 271                THEN
 272                   Doors[NoOfDoors].StateOfDoor := Closed
 273                ELSIF StrEqual( CurrentSymbol, 'SECRET' )
 274                THEN
 275                   Doors[NoOfDoors].StateOfDoor := Secret
 276                ELSIF StrEqual( CurrentSymbol, 'OPEN' )
 277                THEN
 278                   Doors[NoOfDoors].StateOfDoor := Open
 279                ELSE
 280                   WriteError('Illegal Door Status')
 281                END ;
 282                GetNextSymbol(CurrentSymbol) ;
 283                IF NOT StrEqual( CurrentSymbol, 'LEADS' )
 284                THEN
 285                   WriteError('LEADS --- Expected') ;
 286                   FatelError := TRUE
 287                END ;
 288                GetNextSymbol(CurrentSymbol) ;
 289                IF NOT StrEqual( CurrentSymbol, 'TO' )
 290                THEN
 291                   WriteError('TO --- Expected') ;
 292                   FatelError := TRUE
 293                END ;
 294                GetNextSymbol(CurrentSymbol) ;
 295                ReadCard( x1 ) ;
 296                IF x1>MaxNoOfRooms
 297                THEN
 298                   WriteError('Out Of Range Error - Room No.') ;
 299                   FatelError := TRUE
 300                ELSE
 301                   Doors[NoOfDoors].LeadsTo := x1
 302                END
 303             END ;
 304             GetNextSymbol(CurrentSymbol) ;
 305          UNTIL StrEqual( CurrentSymbol, 'DOOR' ) OR
 306                StrEqual( CurrentSymbol, 'WALL' ) OR
 307                StrEqual( CurrentSymbol, 'TREASURE' ) OR
 308                StrEqual( CurrentSymbol, 'END' ) OR
 309                FatelError ;
 310       END
 311    END
 312 END ReadDoor ;
 313
 314
 315 PROCEDURE ReadTreasure ;
 316 VAR
 317    x, y, TreasureNo: CARDINAL ;
 318 BEGIN
 319    IF NOT FatelError
 320    THEN
 321       GetNextSymbol(CurrentSymbol) ;
 322       REPEAT
 323          WITH Rooms[CurrentRoom] DO
 324             IF NOT StrEqual( CurrentSymbol, 'AT' )
 325             THEN
 326                WriteError('AT --- Expected') ;
 327                FatelError := TRUE
 328             END ;
 329             GetNextSymbol(CurrentSymbol) ;
 330             ReadCard( x ) ;
 331             GetNextSymbol(CurrentSymbol) ;
 332             ReadCard( y ) ;
 333             GetNextSymbol(CurrentSymbol) ;
 334             IF NOT StrEqual( CurrentSymbol, 'IS' )
 335             THEN
 336                WriteError('IS --- Expected') ;
 337                FatelError := TRUE
 338             END ;
 339             GetNextSymbol(CurrentSymbol) ;
 340             ReadCard( TreasureNo ) ;
 341
 342             IF (TreasureNo<=MaxNoOfTreasures) AND (TreasureNo>0)
 343             THEN
 344                (* Tell Room about treasures *)
 345
 346                INCL( Treasures, TreasureNo ) ;
 347
 348                (* Tell Treasures about Treasures! and Room *)
 349
 350                Treasure[TreasureNo].Xpos := x ;
 351                Treasure[TreasureNo].Ypos := y ;
 352                Treasure[TreasureNo].Rm := CurrentRoom ;
 353             ELSE
 354                WriteError('Out Of Range Error - Treasure No.') ;
 355                FatelError := TRUE
 356             END
 357          END ;
 358          GetNextSymbol(CurrentSymbol) ;
 359       UNTIL StrEqual( CurrentSymbol, 'WALL' ) OR
 360             StrEqual( CurrentSymbol, 'DOOR' ) OR
 361             StrEqual( CurrentSymbol, 'TREASURE' ) OR
 362             StrEqual( CurrentSymbol, 'END' ) OR
 363             FatelError ;
 364    END
 365 END ReadTreasure ;
 366
 367
 368 PROCEDURE ReadRoomNo ;
 369 BEGIN
 370    IF NOT FatelError
 371    THEN
 372       ReadCard( CurrentRoom ) ;
 373       IF (CurrentRoom>0) AND (CurrentRoom<=MaxNoOfRooms)
 374       THEN
 375          IF CurrentRoom>ActualNoOfRooms
 376          THEN
 377             ActualNoOfRooms := CurrentRoom
 378          END
 379       END
 380    END
 381 END ReadRoomNo ;
 382
 383
 384 PROCEDURE ReadCard (VAR c: CARDINAL) ;
 385 VAR
 386    i    : CARDINAL ;
 387    High : CARDINAL ;
 388    ch   : CHAR ;
 389 BEGIN
 390    IF NOT FatelError
 391    THEN
 392       i := 0 ;
 393       c := 0 ;
 394       High := HIGH(CurrentSymbol) ;
 395       REPEAT
 396          ch := CurrentSymbol[i] ;
 397          IF (ch>='0') AND (ch<='9')
 398          THEN
 399             c := c*10+ORD(ch)-ORD('0')
 400          ELSIF ch#nul
 401          THEN
 402             WriteError('Cardinal Number Expected') ;
 403             FatelError := TRUE
 404          END ;
 405          INC( i ) ;
 406       UNTIL (i>High) OR (ch=nul) ;
 407    END
 408 END ReadCard ;
 409
 410
 411 PROCEDURE Init ;
 412 BEGIN
 413    ActualNoOfRooms := 0 ;
 414    FatelError := FALSE
 415 END Init ;
 416
 417
 418 BEGIN
 419    Init
 420 END AdvMap.