|
|
1.1 ! root 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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.