1: C SAVE- SAVE GAME STATE
   2: C
   3: C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
   4: C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
   5: C WRITTEN BY R. M. SUPNIK
   6: C
   7: C DECLARATIONS
   8: C
   9:         SUBROUTINE SAVEGM
  10:         IMPLICIT INTEGER (A-Z)
  11: #include "parser.h"
  12: #include "gamestate.h"
  13: #include "state.h"
  14: #include "screen.h"
  15: #include "puzzle.h"
  16: #include "rooms.h"
  17: #include "exits.h"
  18: #include "objects.h"
  19: #include "clock.h"
  20: #include "villians.h"
  21: #include "advers.h"
  22: #include "flags.h"
  23: C
  24: C MISCELLANEOUS VARIABLES
  25: C
  26:         COMMON /VERS/ VMAJ,VMIN,VEDIT
  27:         COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
  28: C
  29:         PRSWON=.FALSE.
  30: C						!DISABLE GAME.
  31: C Note: save file format is different for PDP vs. non-PDP versions
  32: C
  33: #ifdef PDP
  34: C
  35: C	send restore data flag down pipe
  36: C
  37:         call outstr(stchr,1)
  38: 
  39: C	write out necessary common blocks
  40: C
  41: C	/play/
  42:         call arywt(4,winner)
  43: C
  44: C	/state/
  45:         call arywt(11,moves)
  46: C
  47: C	/screen/
  48:         call arywt(3,formdr)
  49: C
  50: C	/puzzle/
  51:         call arywt(64,cpvec)
  52: C
  53: C	/vers/
  54:         call arywt(3,vmaj)
  55: C
  56: C	/rooms/
  57:         call arywt(400,rval)
  58: C
  59: C	/objects/
  60:         call arywt(2860,odesc1)
  61: C
  62: C	/cevent/
  63:         call arywt(100,ctick)
  64: C
  65: C	/hack/
  66:         call arywt(8,thfpos)
  67: C
  68: C	/vill/
  69:         call arywt(4,vprob)
  70: C
  71: C	/advs/
  72:         call arywt(28,aroom)
  73: C
  74: C	/findex/
  75:         call arywt(114,flags)
  76: C
  77: C	send end of data flag down pipe
  78: C
  79:         call outstr(endchr,1)
  80:         CALL RSPEAK(597)
  81:         RETURN
  82: #else
  83:         OPEN (UNIT=1,file='dsave.dat',ACCESS='SEQUENTIAL',
  84: &               status='UNKNOWN',FORM='UNFORMATTED',ERR=100)
  85:         rewind (unit=1, err=100)
  86: C
  87:         CALL GTTIME(I)
  88: C						!GET TIME.
  89:         WRITE(1) VMAJ,VMIN,VEDIT
  90:         WRITE(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
  91: &               SWDACT,SWDSTA,CPVEC
  92:         WRITE(1) I,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD,
  93: &               LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC
  94:         WRITE(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
  95: &               OSIZE,OCAPAC,OROOM,OADV,OCAN
  96:         WRITE(1) RVAL,RFLAG
  97:         WRITE(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
  98:         WRITE(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK
  99: C
 100:         CLOSE(UNIT=1)
 101:         CALL RSPEAK(597)
 102:         RETURN
 103: C
 104: 100     CALL RSPEAK(598)
 105: C						!CANT DO IT.
 106:         RETURN
 107: #endif PDP
 108:         END
 109: C RESTORE- RESTORE GAME STATE
 110: C
 111: C DECLARATIONS
 112: C
 113:         SUBROUTINE RSTRGM
 114:         IMPLICIT INTEGER (A-Z)
 115: #include "parser.h"
 116: #include "gamestate.h"
 117: #include "state.h"
 118: #include "screen.h"
 119: #include "puzzle.h"
 120: #include "rooms.h"
 121: #include "exits.h"
 122: #include "objects.h"
 123: #include "clock.h"
 124: #include "villians.h"
 125: #include "advers.h"
 126: #include "flags.h"
 127: C
 128: C MISCELLANEOUS VARIABLES
 129: C
 130:         COMMON /VERS/ VMAJ,VMIN,VEDIT
 131:         COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
 132: C
 133:         PRSWON=.FALSE.
 134: C						!DISABLE GAME.
 135: C Note: save file format is different for PDP vs. non-PDP versions
 136: C
 137: #ifdef PDP
 138: C
 139: C	read in necessary common blocks
 140: C
 141: C	/play/
 142:         call aryrd(4,winner)
 143: C
 144: C	/state/
 145:         call aryrd(11,moves)
 146: C
 147: C	/screen/
 148:         call aryrd(3,formdr)
 149: C
 150: C	/puzzle/
 151:         call aryrd(64,cpvec)
 152: C
 153: C	/vers/
 154:         call intrd(i)
 155:         call intrd(j)
 156:         call intrd(k)
 157: C
 158: C	/rooms/
 159:         call aryrd(400,rval)
 160: C
 161: C	/objects/
 162:         call aryrd(2860,odesc1)
 163: C
 164: C	/cevent/
 165:         call aryrd(100,ctick)
 166: C
 167: C	/hack/
 168:         call aryrd(8,thfpos)
 169: C
 170: C	/vill/
 171:         call aryrd(4,vprob)
 172: C
 173: C	/advs/
 174:         call aryrd(28,aroom)
 175: C
 176: C	/findex/
 177:         call aryrd(114,flags)
 178: C
 179: 
 180: C
 181:         IF(or((I.NE.VMAJ),(J.NE.VMIN))) GO TO 200
 182:         CALL RSPEAK(599)
 183:         RETURN
 184: C
 185: 200     CALL RSPEAK(600)
 186: C						!OBSOLETE VERSION
 187:         RETURN
 188: #else
 189:         OPEN (UNIT=1,file='dsave.dat',ACCESS='SEQUENTIAL',
 190: #ifdef XELOS
 191: &               status='OLD',FORM='UNFORMATTED',ERR=100,recl=1)
 192: #else
 193: &               status='OLD',FORM='UNFORMATTED',ERR=100)
 194: #endif
 195:         rewind (unit=1, err=100)
 196: C
 197:         READ(1) I,J,K
 198:         IF(or((I.NE.VMAJ),(J.NE.VMIN))) GO TO 200
 199: C
 200:         READ(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
 201: &               SWDACT,SWDSTA,CPVEC
 202:         READ(1) PLTIME,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD,
 203: &               LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC
 204:         READ(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
 205: &               OSIZE,OCAPAC,OROOM,OADV,OCAN
 206:         READ(1) RVAL,RFLAG
 207:         READ(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
 208:         READ(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK
 209: C
 210:         CLOSE(UNIT=1)
 211:         CALL RSPEAK(599)
 212:         RETURN
 213: C
 214: 100     CALL RSPEAK(598)
 215: C						!CANT DO IT.
 216:         RETURN
 217: C
 218: 200     CALL RSPEAK(600)
 219: C						!OBSOLETE VERSION
 220:         CLOSE (UNIT=1)
 221:         RETURN
 222: #endif PDP
 223:         END
 224: C WALK- MOVE IN SPECIFIED DIRECTION
 225: C
 226: C DECLARATIONS
 227: C
 228:         LOGICAL FUNCTION WALK(X)
 229:         IMPLICIT INTEGER(A-Z)
 230:         LOGICAL FINDXT,QOPEN,LIT,PROB,MOVETO,RMDESC
 231: #include "parser.h"
 232: #include "gamestate.h"
 233: #include "rooms.h"
 234: #include "rflag.h"
 235: #include "curxt.h"
 236: #include "xsrch.h"
 237: #include "objects.h"
 238: #include "oflags.h"
 239: #include "clock.h"
 240: 
 241: #include "villians.h"
 242: #include "advers.h"
 243: #include "flags.h"
 244: C
 245: C FUNCTIONS AND DATA
 246: C
 247:         QOPEN(O)=and(OFLAG2(O),OPENBT).NE.0
 248: C WALK, PAGE 2
 249: C
 250:         WALK=.TRUE.
 251: C						!ASSUME WINS.
 252:         IF((WINNER.NE.PLAYER).OR.LIT(HERE).OR.PROB(25,25))
 253: &               GO TO 500
 254:         IF(.NOT.FINDXT(PRSO,HERE)) GO TO 450
 255: C						!INVALID EXIT? GRUE
 256: C						!
 257:         GO TO (400,200,100,300),XTYPE
 258: C						!DECODE EXIT TYPE.
 259:         CALL BUG(9,XTYPE)
 260: C
 261: 100     IF(CXAPPL(XACTIO).NE.0) GO TO 400
 262: C						!CEXIT... RETURNED ROOM?
 263:         IF(FLAGS(XFLAG)) GO TO 400
 264: C						!NO, FLAG ON?
 265: 200     CALL JIGSUP(523)
 266: C						!BAD EXIT, GRUE
 267: C						!
 268:         RETURN
 269: C
 270: 300     IF(CXAPPL(XACTIO).NE.0) GO TO 400
 271: C						!DOOR... RETURNED ROOM?
 272:         IF(QOPEN(XOBJ)) GO TO 400
 273: C						!NO, DOOR OPEN?
 274:         CALL JIGSUP(523)
 275: C						!BAD EXIT, GRUE
 276: C						!
 277:         RETURN
 278: C
 279: 400     IF(LIT(XROOM1)) GO TO 900
 280: C						!VALID ROOM, IS IT LIT?
 281: 450     CALL JIGSUP(522)
 282: C						!NO, GRUE
 283: C						!
 284:         RETURN
 285: C
 286: C ROOM IS LIT, OR WINNER IS NOT PLAYER (NO GRUE).
 287: C
 288: 500     IF(FINDXT(PRSO,HERE)) GO TO 550
 289: C						!EXIT EXIST?
 290: 525     XSTRNG=678
 291: C						!ASSUME WALL.
 292:         IF(PRSO.EQ.XUP) XSTRNG=679
 293: C						!IF UP, CANT.
 294:         IF(PRSO.EQ.XDOWN) XSTRNG=680
 295: C						!IF DOWN, CANT.
 296:         IF(and(RFLAG(HERE),RNWALL).NE.0) XSTRNG=524
 297:         CALL RSPEAK(XSTRNG)
 298:         PRSCON=1
 299: C						!STOP CMD STREAM.
 300:         RETURN
 301: C
 302: 550     GO TO (900,600,700,800),XTYPE
 303: C						!BRANCH ON EXIT TYPE.
 304:         CALL BUG(9,XTYPE)
 305: C
 306: 700     IF(CXAPPL(XACTIO).NE.0) GO TO 900
 307: C						!CEXIT... RETURNED ROOM?
 308:         IF(FLAGS(XFLAG)) GO TO 900
 309: C						!NO, FLAG ON?
 310: 600     IF(XSTRNG.EQ.0) GO TO 525
 311: C						!IF NO REASON, USE STD.
 312:         CALL RSPEAK(XSTRNG)
 313: C						!DENY EXIT.
 314:         PRSCON=1
 315: C						!STOP CMD STREAM.
 316:         RETURN
 317: C
 318: 800     IF(CXAPPL(XACTIO).NE.0) GO TO 900
 319: C						!DOOR... RETURNED ROOM?
 320:         IF(QOPEN(XOBJ)) GO TO 900
 321: C						!NO, DOOR OPEN?
 322:         IF(XSTRNG.EQ.0) XSTRNG=525
 323: C						!IF NO REASON, USE STD.
 324:         CALL RSPSUB(XSTRNG,ODESC2(XOBJ))
 325:         PRSCON=1
 326: C						!STOP CMD STREAM.
 327:         RETURN
 328: C
 329: 900     WALK=MOVETO(XROOM1,WINNER)
 330: C						!MOVE TO ROOM.
 331:         IF(WALK) WALK=RMDESC(0)
 332: C						!DESCRIBE ROOM.
 333:         RETURN
 334:         END
 335: C CXAPPL- CONDITIONAL EXIT PROCESSORS
 336: C
 337: C DECLARATIONS
 338: C
 339:         INTEGER FUNCTION CXAPPL(RI)
 340:         IMPLICIT INTEGER (A-Z)
 341: #include "gamestate.h"
 342: #include "parser.h"
 343: #include "puzzle.h"
 344: #include "rooms.h"
 345: #include "rindex.h"
 346: #include "exits.h"
 347: #include "curxt.h"
 348: #include "xpars.h"
 349: #include "xsrch.h"
 350: #include "objects.h"
 351: #include "oflags.h"
 352: #include "oindex.h"
 353: #include "advers.h"
 354: #include "flags.h"
 355: C CXAPPL, PAGE 2
 356: C
 357:         CXAPPL=0
 358: C						!NO RETURN.
 359:         IF(RI.EQ.0) RETURN
 360: C						!IF NO ACTION, DONE.
 361:         GO TO (1000,2000,3000,4000,5000,6000,7000,
 362: &               8000,9000,10000,11000,12000,13000,14000),RI
 363:         CALL BUG(5,RI)
 364: C
 365: C C1- COFFIN-CURE
 366: C
 367: 1000    EGYPTF=OADV(COFFI).NE.WINNER
 368: C						!T IF NO COFFIN.
 369:         RETURN
 370: C
 371: C C2- CAROUSEL EXIT
 372: C C5- CAROUSEL OUT
 373: C
 374: 2000    IF(CAROFF) RETURN
 375: C						!IF FLIPPED, NOTHING.
 376: 2500    CALL RSPEAK(121)
 377: C						!SPIN THE COMPASS.
 378: 5000    I=XELNT(XCOND)*RND(8)
 379: C						!CHOOSE RANDOM EXIT.
 380:         XROOM1=and(TRAVEL(REXIT(HERE)+I),XRMASK)
 381:         CXAPPL=XROOM1
 382: C						!RETURN EXIT.
 383:         RETURN
 384: C
 385: C C3- CHIMNEY FUNCTION
 386: C
 387: 3000    LITLDF=.FALSE.
 388: C						!ASSUME HEAVY LOAD.
 389:         J=0
 390:         DO 3100 I=1,OLNT
 391: C						!COUNT OBJECTS.
 392:           IF(OADV(I).EQ.WINNER) J=J+1
 393: 3100    CONTINUE
 394: C
 395:         IF(J.GT.2) RETURN
 396: C						!CARRYING TOO MUCH?
 397:         XSTRNG=446
 398: C						!ASSUME NO LAMP.
 399:         IF(OADV(LAMP).NE.WINNER) RETURN
 400: C						!NO LAMP?
 401:         LITLDF=.TRUE.
 402: C						!HE CAN DO IT.
 403:         IF(and(OFLAG2(DOOR),OPENBT).EQ.0)
 404: &               OFLAG2(DOOR)=and(OFLAG2(DOOR), not(TCHBT))
 405:         RETURN
 406: C
 407: C C4-	FROBOZZ FLAG (MAGNET ROOM, FAKE EXIT)
 408: C C6-	FROBOZZ FLAG (MAGNET ROOM, REAL EXIT)
 409: C
 410: 4000    IF(CAROFF) GO TO 2500
 411: C						!IF FLIPPED, GO SPIN.
 412:         FROBZF=.FALSE.
 413: C						!OTHERWISE, NOT AN EXIT.
 414:         RETURN
 415: C
 416: 6000    IF(CAROFF) GO TO 2500
 417: C						!IF FLIPPED, GO SPIN.
 418:         FROBZF=.TRUE.
 419: C						!OTHERWISE, AN EXIT.
 420:         RETURN
 421: C
 422: C C7-	FROBOZZ FLAG (BANK ALARM)
 423: C
 424: 7000    FROBZF=and((OROOM(BILLS).NE.0),(OROOM(PORTR).NE.0))
 425:         RETURN
 426: C CXAPPL, PAGE 3
 427: C
 428: C C8-	FROBOZZ FLAG (MRGO)
 429: C
 430: 8000    FROBZF=.FALSE.
 431: C						!ASSUME CANT MOVE.
 432:         IF(MLOC.NE.XROOM1) GO TO 8100
 433: C						!MIRROR IN WAY?
 434:         IF((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XSOUTH)) GO TO 8200
 435:         IF(MOD(MDIR,180).NE.0) GO TO 8300
 436: C						!MIRROR MUST BE N-S.
 437:         XROOM1=((XROOM1-MRA)*2)+MRAE
 438: C						!CALC EAST ROOM.
 439:         IF(PRSO.GT.XSOUTH) XROOM1=XROOM1+1
 440: C						!IF SW/NW, CALC WEST.
 441: 8100    CXAPPL=XROOM1
 442:         RETURN
 443: C
 444: 8200    XSTRNG=814
 445: C						!ASSUME STRUC BLOCKS.
 446:         IF(MOD(MDIR,180).EQ.0) RETURN
 447: C						!IF MIRROR N-S, DONE.
 448: 8300    LDIR=MDIR
 449: C						!SEE WHICH MIRROR.
 450:         IF(PRSO.EQ.XSOUTH) LDIR=180
 451:         XSTRNG=815
 452: C						!MIRROR BLOCKS.
 453:         IF(((LDIR.GT.180).AND..NOT.MR1F).OR.
 454: &         ((LDIR.LT.180).AND..NOT.MR2F)) XSTRNG=816
 455:         RETURN
 456: C
 457: C C9-	FROBOZZ FLAG (MIRIN)
 458: C
 459: 9000    IF(MRHERE(HERE).NE.1) GO TO 9100
 460: C						!MIRROR 1 HERE?
 461:         IF(MR1F) XSTRNG=805
 462: C						!SEE IF BROKEN.
 463:         FROBZF=MROPNF
 464: C						!ENTER IF OPEN.
 465:         RETURN
 466: C
 467: 9100    FROBZF=.FALSE.
 468: C						!NOT HERE,
 469:         XSTRNG=817
 470: C						!LOSE.
 471:         RETURN
 472: C CXAPPL, PAGE 4
 473: C
 474: C C10-	FROBOZZ FLAG (MIRROR EXIT)
 475: C
 476: 10000   FROBZF=.FALSE.
 477: C						!ASSUME CANT.
 478:         LDIR=((PRSO-XNORTH)/XNORTH)*45
 479: C						!XLATE DIR TO DEGREES.
 480:         IF(.NOT.MROPNF .OR.
 481: &               ((MOD(MDIR+270,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
 482: &               GO TO 10200
 483:         XROOM1=((MLOC-MRA)*2)+MRAE+1-(MDIR/180)
 484: C						!ASSUME E-W EXIT.
 485:         IF(MOD(MDIR,180).EQ.0) GO TO 10100
 486: C						!IF N-S, OK.
 487:         XROOM1=MLOC+1
 488: C						!ASSUME N EXIT.
 489:         IF(MDIR.GT.180) XROOM1=MLOC-1
 490: C						!IF SOUTH.
 491: 10100   CXAPPL=XROOM1
 492:         RETURN
 493: C
 494: 10200   IF(.NOT.WDOPNF .OR.
 495: &               ((MOD(MDIR+180,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
 496: &               RETURN
 497:         XROOM1=MLOC+1
 498: C						!ASSUME N.
 499:         IF(MDIR.EQ.0) XROOM1=MLOC-1
 500: C						!IF S.
 501:         CALL RSPEAK(818)
 502: C						!CLOSE DOOR.
 503:         WDOPNF=.FALSE.
 504:         CXAPPL=XROOM1
 505:         RETURN
 506: C
 507: C C11-	MAYBE DOOR.  NORMAL MESSAGE IS THAT DOOR IS CLOSED.
 508: C	BUT IF LCELL.NE.4, DOOR ISNT THERE.
 509: C
 510: 11000   IF(LCELL.NE.4) XSTRNG=678
 511: C						!SET UP MSG.
 512:         RETURN
 513: C
 514: C C12-	FROBZF (PUZZLE ROOM MAIN ENTRANCE)
 515: C
 516: 12000   FROBZF=.TRUE.
 517: C						!ALWAYS ENTER.
 518:         CPHERE=10
 519: C						!SET SUBSTATE.
 520:         RETURN
 521: C
 522: C C13-	CPOUTF (PUZZLE ROOM SIZE ENTRANCE)
 523: C
 524: 13000   CPHERE=52
 525: C						!SET SUBSTATE.
 526:         RETURN
 527: C CXAPPL, PAGE 5
 528: C
 529: C C14-	FROBZF (PUZZLE ROOM TRANSITIONS)
 530: C
 531: 14000   FROBZF=.FALSE.
 532: C						!ASSSUME LOSE.
 533:         IF(PRSO.NE.XUP) GO TO 14100
 534: C						!UP?
 535:         IF(CPHERE.NE.10) RETURN
 536: C						!AT EXIT?
 537:         XSTRNG=881
 538: C						!ASSUME NO LADDER.
 539:         IF(CPVEC(CPHERE+1).NE.-2) RETURN
 540: C						!LADDER HERE?
 541:         CALL RSPEAK(882)
 542: C						!YOU WIN.
 543:         FROBZF=.TRUE.
 544: C						!LET HIM OUT.
 545:         RETURN
 546: C
 547: 14100   IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST).OR..NOT.CPOUTF)
 548: &               GO TO 14200
 549:         FROBZF=.TRUE.
 550: C						!YES, LET HIM OUT.
 551:         RETURN
 552: C
 553: 14200   DO 14300 I=1,16,2
 554: C						!LOCATE EXIT.
 555:           IF(PRSO.EQ.CPDR(I)) GO TO 14400
 556: 14300   CONTINUE
 557:         RETURN
 558: C						!NO SUCH EXIT.
 559: C
 560: 14400   J=CPDR(I+1)
 561: C						!GET DIRECTIONAL OFFSET.
 562:         NXT=CPHERE+J
 563: C						!GET NEXT STATE.
 564:         K=8
 565: C						!GET ORTHOGONAL DIR.
 566:         IF(J.LT.0) K=-8
 567:         IF((((IABS(J).EQ.1).OR.(IABS(J).EQ.8)).OR.
 568: &          ((CPVEC(CPHERE+K).EQ.0).OR.(CPVEC(NXT-K).EQ.0))).AND.
 569: &           (CPVEC(NXT).EQ.0)) GO TO 14500
 570:         RETURN
 571: C
 572: 14500   CALL CPGOTO(NXT)
 573: C						!MOVE TO STATE.
 574:         XROOM1=CPUZZ
 575: C						!STAY IN ROOM.
 576:         CXAPPL=XROOM1
 577:         RETURN
 578: C
 579:         END
Last modified: 1988-10-21
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 2167
Valid CSS Valid XHTML 1.0 Strict