gcc/testsuite/gm2/examples/map/pass/Semantic.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 MODULE Semantic ;
  19
  20
  21 FROM SYSTEM IMPORT ADR ;
  22 FROM libc IMPORT exit, system ;
  23 FROM StrLib IMPORT StrCopy, StrConCat ;
  24 FROM StrIO IMPORT WriteString, WriteLn ;
  25 FROM NumberIO IMPORT WriteCard ;
  26 FROM Args IMPORT GetArg ;
  27 FROM libc IMPORT system ;
  28 (*
  29 FROM FIO IMPORT File, OpenToWrite, Close, Exists, ReportError, WriteShort,
  30                 WriteChar, IsNoError ;
  31 *)
  32 FROM FIO IMPORT File, OpenToWrite, Close, Exists, WriteChar, IsNoError ;
  33
  34 FROM AdvMap IMPORT ReadAdvMap, Rooms, DoorStatus, ActualNoOfRooms,
  35                    MaxNoOfTreasures, Treasure ;
  36
  37 CONST
  38    MaxFileName = 4096 ;
  39
  40 VAR
  41    ErrorInRoom: BOOLEAN ;
  42
  43
  44 PROCEDURE GetOppositeDoor (r, x1, y1, x2, y2: CARDINAL ;
  45                            VAR doorno: CARDINAL ; VAR ok: BOOLEAN) ;
  46 VAR
  47    xok, yok: BOOLEAN ;
  48 BEGIN
  49    ok := FALSE ;
  50    doorno := 1 ;
  51    WITH Rooms[r] DO
  52       WHILE (NOT ok) AND (doorno<=NoOfDoors) DO
  53          xok :=  (x1=Doors[doorno].Position.X1) AND
  54                  (x2=Doors[doorno].Position.X2) ;
  55          yok :=  (y1=Doors[doorno].Position.Y1) AND
  56                  (y2=Doors[doorno].Position.Y2) ;
  57          IF xok AND yok
  58          THEN
  59             ok := TRUE
  60          ELSE
  61             INC( doorno )
  62          END
  63       END
  64    END
  65 END GetOppositeDoor ;
  66
  67
  68 PROCEDURE GetWallOnDoor (r, x1, y1, x2, y2: CARDINAL ;
  69                          VAR ok: BOOLEAN) ;
  70 VAR
  71    wallno: CARDINAL ;
  72 BEGIN
  73    ok := FALSE ;
  74    wallno := 1 ;
  75    WITH Rooms[r] DO
  76       WHILE (NOT ok) AND (wallno<=NoOfWalls) DO
  77          WITH Walls[wallno] DO
  78             IF (Walls[wallno].X1=x1) AND (Walls[wallno].X2=x2)
  79             THEN
  80                IF (Walls[wallno].Y1<=y1) AND (Walls[wallno].Y2>=y2)
  81                THEN
  82                   ok := TRUE
  83                END
  84             END ;
  85             IF (Walls[wallno].Y1=y1) AND (Walls[wallno].Y2=y2)
  86             THEN
  87                IF (Walls[wallno].X1<=x1) AND (Walls[wallno].X2>=x2)
  88                THEN
  89                   ok := TRUE
  90                END
  91             END ;
  92             INC( wallno )
  93          END
  94       END
  95    END
  96 END GetWallOnDoor ;
  97
  98
  99 PROCEDURE HorizWallOnDoor (r, x1, y1: CARDINAL ;
 100                            VAR ok: BOOLEAN) ;
 101 VAR
 102    wallno: CARDINAL ;
 103 BEGIN
 104    ok := FALSE ;
 105    wallno := 1 ;
 106    WITH Rooms[r] DO
 107       WHILE (NOT ok) AND (wallno<=NoOfWalls) DO
 108          WITH Walls[wallno] DO
 109             IF (Walls[wallno].X1=Walls[wallno].X2) AND (x1=Walls[wallno].X1)
 110             THEN
 111                IF (Walls[wallno].Y1<=y1) AND (Walls[wallno].Y2>=y1)
 112                THEN
 113                   ok := TRUE
 114                END
 115             END
 116          END ;
 117          INC( wallno )
 118       END
 119    END
 120 END HorizWallOnDoor ;
 121
 122
 123 PROCEDURE VertWallOnDoor (r, x1, y1: CARDINAL ;
 124                           VAR ok: BOOLEAN) ;
 125 VAR
 126    wallno: CARDINAL ;
 127 BEGIN
 128    ok := FALSE ;
 129    wallno := 1 ;
 130    WITH Rooms[r] DO
 131       WHILE (NOT ok) AND (wallno<=NoOfWalls) DO
 132          WITH Walls[wallno] DO
 133             IF (Walls[wallno].Y1=Walls[wallno].Y2) AND (y1=Walls[wallno].Y1)
 134             THEN
 135                IF (Walls[wallno].X1<=x1) AND (Walls[wallno].X2>=x1)
 136                THEN
 137                   ok := TRUE
 138                END
 139             END
 140          END ;
 141          INC( wallno )
 142       END
 143    END
 144 END VertWallOnDoor ;
 145
 146
 147 (*
 148    AnalyzeSemantic -
 149 *)
 150
 151 PROCEDURE AnalyzeSemantic ;
 152 VAR
 153    room: CARDINAL ;
 154 BEGIN
 155    FOR room := 1 TO ActualNoOfRooms DO
 156       AnalyzeRoom(room)
 157    END
 158 END AnalyzeSemantic ;
 159
 160
 161 (*
 162    AnalyzeRoom -
 163 *)
 164
 165 PROCEDURE AnalyzeRoom (room: CARDINAL) ;
 166 VAR
 167    door: CARDINAL ;
 168 BEGIN
 169    WITH Rooms[room] DO
 170       IF NoOfDoors#0
 171       THEN
 172          FOR door := 1 TO NoOfDoors DO
 173             AnalyzeDoor(room, door)
 174          END
 175       END
 176    END
 177 END AnalyzeRoom ;
 178
 179
 180 (*
 181    AnalyzeDoor -
 182 *)
 183
 184 PROCEDURE AnalyzeDoor (room, door: CARDINAL) ;
 185 VAR
 186    OtherDoor,
 187    i        : CARDINAL ;
 188    ok       : BOOLEAN ;
 189 BEGIN
 190    WITH Rooms[room] DO
 191       WITH Doors[door] DO
 192          IF LeadsTo#0
 193          THEN
 194             GetOppositeDoor( LeadsTo, Position.X1, Position.Y1,
 195                              Position.X2, Position.Y2 ,OtherDoor, ok ) ;
 196             IF ok
 197             THEN
 198                IF StateOfDoor#Rooms[LeadsTo].Doors[OtherDoor].StateOfDoor
 199                THEN
 200                   WriteString('Inconsistant Door STATUS in room') ;
 201                   WriteCard( room, 6 ) ; WriteString('Door NO.') ;
 202                   WriteCard( door, 6 ) ; WriteLn ;
 203                   ErrorInRoom := TRUE
 204                END
 205             ELSE
 206                WriteString('Inconsistant Door LEADSTO in room') ;
 207                WriteCard( room, 6 ) ; WriteString('  Door NO.') ;
 208                WriteCard( door, 6 ) ; WriteString('  - OR -') ;WriteLn ;
 209                WriteString('Inconsistant Door COORDS in room') ;
 210                WriteCard( room, 6 ) ; WriteString('  Door NO.') ;
 211                WriteCard( door, 6 ) ; WriteLn ;
 212                ErrorInRoom := TRUE
 213             END ;
 214             GetWallOnDoor( room, Position.X1, Position.Y1,
 215                            Position.X2, Position.Y2, ok ) ;
 216             IF NOT ok
 217             THEN
 218                WriteString('Door NOT ON WALL in room') ;
 219                WriteCard( room, 6 ) ; WriteString('  Door NO.') ;
 220                WriteCard( door, 6 ) ; WriteLn ;
 221                ErrorInRoom := TRUE
 222             END ;
 223             IF Position.X1=Position.X2
 224             THEN
 225                i := Position.Y1 ;
 226                REPEAT
 227                   VertWallOnDoor( LeadsTo, Position.X1, i, ok ) ;
 228                   INC( i ) ;
 229                UNTIL ok OR (i>Position.Y2)
 230             ELSE
 231                i := Position.X1 ;
 232                REPEAT
 233                   HorizWallOnDoor( LeadsTo, i, Position.Y1, ok ) ;
 234                   INC( i )
 235                UNTIL ok OR (i>Position.X2)
 236             END ;
 237             IF ok
 238             THEN
 239                WriteString('Adjacent Room CONFLICT with DOOR in ROOM') ;
 240                WriteCard( room, 6 ) ; WriteString('  Door NO.') ;
 241                WriteCard( door, 6 ) ; WriteLn ;
 242                WriteString('Adjacent Room is') ; WriteCard( LeadsTo, 6 ) ;
 243                WriteLn ;
 244                ErrorInRoom := TRUE
 245             END
 246          END
 247       END
 248    END
 249 END AnalyzeDoor ;
 250
 251
 252 (*
 253 (*
 254    CrunchRooms -
 255 *)
 256
 257 PROCEDURE CrunchRooms (f: File) ;
 258 VAR
 259    room: CARDINAL ;
 260 BEGIN
 261    WriteShort(f, ActualNoOfRooms) ;
 262    FOR room := 1 TO ActualNoOfRooms DO
 263       CrunchRoom(f, room)
 264    END
 265 END CrunchRooms ;
 266
 267
 268 (*
 269    CrunchRoom -
 270 *)
 271
 272 PROCEDURE CrunchRoom (f: File; room: CARDINAL) ;
 273 VAR
 274    i: CARDINAL ;
 275 BEGIN
 276    WITH Rooms[room] DO
 277       WriteShort(f, NoOfWalls) ;
 278       FOR i := 1 TO NoOfWalls DO
 279          CrunchWall(f, room, i)
 280       END ;
 281       WriteShort(f, NoOfDoors) ;
 282       FOR i := 1 TO NoOfDoors DO
 283          CrunchDoor(f, room, i)
 284       END
 285    END
 286 END CrunchRoom ;
 287
 288
 289 (*
 290    CrunchDoor -
 291 *)
 292
 293 PROCEDURE CrunchDoor (f: File; room: CARDINAL; doorno: CARDINAL) ;
 294 BEGIN
 295    WITH Rooms[room].Doors[doorno] DO
 296       WriteShort(f, Position.X1) ;
 297       WriteShort(f, Position.Y1) ;
 298       WriteShort(f, Position.X2) ;
 299       WriteShort(f, Position.Y2) ;
 300       WriteShort(f, LeadsTo) ;
 301       WriteChar(f, VAL(CHAR, StateOfDoor))
 302    END
 303 END CrunchDoor ;
 304
 305
 306 (*
 307    CrunchWall -
 308 *)
 309
 310 PROCEDURE CrunchWall (f: File; room: CARDINAL; wallno: CARDINAL) ;
 311 BEGIN
 312    WITH Rooms[room].Walls[wallno] DO
 313       WriteShort(f, X1) ;
 314       WriteShort(f, Y1) ;
 315       WriteShort(f, X2) ;
 316       WriteShort(f, Y2)
 317    END
 318 END CrunchWall ;
 319
 320
 321 (*
 322    CrunchTreasures -
 323 *)
 324
 325 PROCEDURE CrunchTreasures (f: File) ;
 326 VAR
 327    i: CARDINAL ;
 328 BEGIN
 329    FOR i := 1 TO MaxNoOfTreasures DO
 330       WITH Treasure[i] DO
 331          WriteShort(f, Xpos) ;
 332          WriteShort(f, Ypos) ;
 333          WriteShort(f, Rm)
 334       END
 335    END
 336 END CrunchTreasures ;
 337
 338
 339 (*
 340    CrunchMap -
 341 *)
 342
 343 PROCEDURE CrunchMap (a: ARRAY OF CHAR) ;
 344 VAR
 345    f: File ;
 346    c: ARRAY [0..MaxFileName] OF CHAR ;
 347 BEGIN
 348    StrConCat(a, '.bin', a) ;
 349    IF Exists(a)
 350    THEN
 351       StrCopy('/bin/rm -f ', c) ;
 352       StrConCat(c, a, c) ;
 353       IF system(ADR(c))#0
 354       THEN
 355          WriteString('failed to ') ; WriteString(c) ; WriteLn ;
 356          exit(1)
 357       END
 358    END ;
 359    f := OpenToWrite(a) ;
 360    IF IsNoError(f)
 361    THEN
 362       CrunchRooms(f) ;
 363       CrunchTreasures(f) ;
 364       Close(f)
 365    ELSE
 366       WriteString('error when opening ') ; WriteString(a) ;
 367       WriteString(' for writing: ') ; ReportError(f) ; WriteLn
 368    END
 369 END CrunchMap ;
 370 *)
 371
 372 VAR
 373    FileName: ARRAY [0..MaxFileName] OF CHAR ;
 374 BEGIN
 375    IF GetArg(FileName, 1)
 376    THEN
 377       IF ReadAdvMap(FileName)
 378       THEN
 379          ErrorInRoom := FALSE ;
 380          AnalyzeSemantic ;
 381 (*
 382          IF NOT ErrorInRoom
 383          THEN
 384             CrunchMap(FileName)
 385          END
 386 *)
 387       END
 388    END
 389 END Semantic.