1C SAVE- SAVE GAME STATE 2C 3C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 4C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED 5C WRITTEN BY R. M. SUPNIK 6C 7C DECLARATIONS 8C 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" 23C 24C MISCELLANEOUS VARIABLES 25C 26 COMMON /VERS/ VMAJ,VMIN,VEDIT 27 COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC 28C 29 PRSWON=.FALSE. 30C !DISABLE GAME. 31C Note: save file format is different for PDP vs. non-PDP versions 32C 33#ifdef PDP 34C 35C send restore data flag down pipe 36C 37 call outstr(stchr,1) 38 39C write out necessary common blocks 40C 41C /play/ 42 call arywt(4,winner) 43C 44C /state/ 45 call arywt(11,moves) 46C 47C /screen/ 48 call arywt(3,formdr) 49C 50C /puzzle/ 51 call arywt(64,cpvec) 52C 53C /vers/ 54 call arywt(3,vmaj) 55C 56C /rooms/ 57 call arywt(400,rval) 58C 59C /objects/ 60 call arywt(2860,odesc1) 61C 62C /cevent/ 63 call arywt(100,ctick) 64C 65C /hack/ 66 call arywt(8,thfpos) 67C 68C /vill/ 69 call arywt(4,vprob) 70C 71C /advs/ 72 call arywt(28,aroom) 73C 74C /findex/ 75 call arywt(114,flags) 76C 77C send end of data flag down pipe 78C 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) 86C 87 CALL GTTIME(I) 88C !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 99C 100 CLOSE(UNIT=1) 101 CALL RSPEAK(597) 102 RETURN 103C 104100 CALL RSPEAK(598) 105C !CANT DO IT. 106 RETURN 107#endif PDP 108 END 109C RESTORE- RESTORE GAME STATE 110C 111C DECLARATIONS 112C 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" 127C 128C MISCELLANEOUS VARIABLES 129C 130 COMMON /VERS/ VMAJ,VMIN,VEDIT 131 COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC 132C 133 PRSWON=.FALSE. 134C !DISABLE GAME. 135C Note: save file format is different for PDP vs. non-PDP versions 136C 137#ifdef PDP 138C 139C read in necessary common blocks 140C 141C /play/ 142 call aryrd(4,winner) 143C 144C /state/ 145 call aryrd(11,moves) 146C 147C /screen/ 148 call aryrd(3,formdr) 149C 150C /puzzle/ 151 call aryrd(64,cpvec) 152C 153C /vers/ 154 call intrd(i) 155 call intrd(j) 156 call intrd(k) 157C 158C /rooms/ 159 call aryrd(400,rval) 160C 161C /objects/ 162 call aryrd(2860,odesc1) 163C 164C /cevent/ 165 call aryrd(100,ctick) 166C 167C /hack/ 168 call aryrd(8,thfpos) 169C 170C /vill/ 171 call aryrd(4,vprob) 172C 173C /advs/ 174 call aryrd(28,aroom) 175C 176C /findex/ 177 call aryrd(114,flags) 178C 179 180C 181 IF(or((I.NE.VMAJ),(J.NE.VMIN))) GO TO 200 182 CALL RSPEAK(599) 183 RETURN 184C 185200 CALL RSPEAK(600) 186C !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) 196C 197 READ(1) I,J,K 198 IF(or((I.NE.VMAJ),(J.NE.VMIN))) GO TO 200 199C 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 209C 210 CLOSE(UNIT=1) 211 CALL RSPEAK(599) 212 RETURN 213C 214100 CALL RSPEAK(598) 215C !CANT DO IT. 216 RETURN 217C 218200 CALL RSPEAK(600) 219C !OBSOLETE VERSION 220 CLOSE (UNIT=1) 221 RETURN 222#endif PDP 223 END 224C WALK- MOVE IN SPECIFIED DIRECTION 225C 226C DECLARATIONS 227C 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" 244C 245C FUNCTIONS AND DATA 246C 247 QOPEN(O)=and(OFLAG2(O),OPENBT).NE.0 248C WALK, PAGE 2 249C 250 WALK=.TRUE. 251C !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 255C !INVALID EXIT? GRUE 256C ! 257 GO TO (400,200,100,300),XTYPE 258C !DECODE EXIT TYPE. 259 CALL BUG(9,XTYPE) 260C 261100 IF(CXAPPL(XACTIO).NE.0) GO TO 400 262C !CEXIT... RETURNED ROOM? 263 IF(FLAGS(XFLAG)) GO TO 400 264C !NO, FLAG ON? 265200 CALL JIGSUP(523) 266C !BAD EXIT, GRUE 267C ! 268 RETURN 269C 270300 IF(CXAPPL(XACTIO).NE.0) GO TO 400 271C !DOOR... RETURNED ROOM? 272 IF(QOPEN(XOBJ)) GO TO 400 273C !NO, DOOR OPEN? 274 CALL JIGSUP(523) 275C !BAD EXIT, GRUE 276C ! 277 RETURN 278C 279400 IF(LIT(XROOM1)) GO TO 900 280C !VALID ROOM, IS IT LIT? 281450 CALL JIGSUP(522) 282C !NO, GRUE 283C ! 284 RETURN 285C 286C ROOM IS LIT, OR WINNER IS NOT PLAYER (NO GRUE). 287C 288500 IF(FINDXT(PRSO,HERE)) GO TO 550 289C !EXIT EXIST? 290525 XSTRNG=678 291C !ASSUME WALL. 292 IF(PRSO.EQ.XUP) XSTRNG=679 293C !IF UP, CANT. 294 IF(PRSO.EQ.XDOWN) XSTRNG=680 295C !IF DOWN, CANT. 296 IF(and(RFLAG(HERE),RNWALL).NE.0) XSTRNG=524 297 CALL RSPEAK(XSTRNG) 298 PRSCON=1 299C !STOP CMD STREAM. 300 RETURN 301C 302550 GO TO (900,600,700,800),XTYPE 303C !BRANCH ON EXIT TYPE. 304 CALL BUG(9,XTYPE) 305C 306700 IF(CXAPPL(XACTIO).NE.0) GO TO 900 307C !CEXIT... RETURNED ROOM? 308 IF(FLAGS(XFLAG)) GO TO 900 309C !NO, FLAG ON? 310600 IF(XSTRNG.EQ.0) GO TO 525 311C !IF NO REASON, USE STD. 312 CALL RSPEAK(XSTRNG) 313C !DENY EXIT. 314 PRSCON=1 315C !STOP CMD STREAM. 316 RETURN 317C 318800 IF(CXAPPL(XACTIO).NE.0) GO TO 900 319C !DOOR... RETURNED ROOM? 320 IF(QOPEN(XOBJ)) GO TO 900 321C !NO, DOOR OPEN? 322 IF(XSTRNG.EQ.0) XSTRNG=525 323C !IF NO REASON, USE STD. 324 CALL RSPSUB(XSTRNG,ODESC2(XOBJ)) 325 PRSCON=1 326C !STOP CMD STREAM. 327 RETURN 328C 329900 WALK=MOVETO(XROOM1,WINNER) 330C !MOVE TO ROOM. 331 IF(WALK) WALK=RMDESC(0) 332C !DESCRIBE ROOM. 333 RETURN 334 END 335C CXAPPL- CONDITIONAL EXIT PROCESSORS 336C 337C DECLARATIONS 338C 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" 355C CXAPPL, PAGE 2 356C 357 CXAPPL=0 358C !NO RETURN. 359 IF(RI.EQ.0) RETURN 360C !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) 364C 365C C1- COFFIN-CURE 366C 3671000 EGYPTF=OADV(COFFI).NE.WINNER 368C !T IF NO COFFIN. 369 RETURN 370C 371C C2- CAROUSEL EXIT 372C C5- CAROUSEL OUT 373C 3742000 IF(CAROFF) RETURN 375C !IF FLIPPED, NOTHING. 3762500 CALL RSPEAK(121) 377C !SPIN THE COMPASS. 3785000 I=XELNT(XCOND)*RND(8) 379C !CHOOSE RANDOM EXIT. 380 XROOM1=and(TRAVEL(REXIT(HERE)+I),XRMASK) 381 CXAPPL=XROOM1 382C !RETURN EXIT. 383 RETURN 384C 385C C3- CHIMNEY FUNCTION 386C 3873000 LITLDF=.FALSE. 388C !ASSUME HEAVY LOAD. 389 J=0 390 DO 3100 I=1,OLNT 391C !COUNT OBJECTS. 392 IF(OADV(I).EQ.WINNER) J=J+1 3933100 CONTINUE 394C 395 IF(J.GT.2) RETURN 396C !CARRYING TOO MUCH? 397 XSTRNG=446 398C !ASSUME NO LAMP. 399 IF(OADV(LAMP).NE.WINNER) RETURN 400C !NO LAMP? 401 LITLDF=.TRUE. 402C !HE CAN DO IT. 403 IF(and(OFLAG2(DOOR),OPENBT).EQ.0) 404& OFLAG2(DOOR)=and(OFLAG2(DOOR), not(TCHBT)) 405 RETURN 406C 407C C4- FROBOZZ FLAG (MAGNET ROOM, FAKE EXIT) 408C C6- FROBOZZ FLAG (MAGNET ROOM, REAL EXIT) 409C 4104000 IF(CAROFF) GO TO 2500 411C !IF FLIPPED, GO SPIN. 412 FROBZF=.FALSE. 413C !OTHERWISE, NOT AN EXIT. 414 RETURN 415C 4166000 IF(CAROFF) GO TO 2500 417C !IF FLIPPED, GO SPIN. 418 FROBZF=.TRUE. 419C !OTHERWISE, AN EXIT. 420 RETURN 421C 422C C7- FROBOZZ FLAG (BANK ALARM) 423C 4247000 FROBZF=and((OROOM(BILLS).NE.0),(OROOM(PORTR).NE.0)) 425 RETURN 426C CXAPPL, PAGE 3 427C 428C C8- FROBOZZ FLAG (MRGO) 429C 4308000 FROBZF=.FALSE. 431C !ASSUME CANT MOVE. 432 IF(MLOC.NE.XROOM1) GO TO 8100 433C !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 436C !MIRROR MUST BE N-S. 437 XROOM1=((XROOM1-MRA)*2)+MRAE 438C !CALC EAST ROOM. 439 IF(PRSO.GT.XSOUTH) XROOM1=XROOM1+1 440C !IF SW/NW, CALC WEST. 4418100 CXAPPL=XROOM1 442 RETURN 443C 4448200 XSTRNG=814 445C !ASSUME STRUC BLOCKS. 446 IF(MOD(MDIR,180).EQ.0) RETURN 447C !IF MIRROR N-S, DONE. 4488300 LDIR=MDIR 449C !SEE WHICH MIRROR. 450 IF(PRSO.EQ.XSOUTH) LDIR=180 451 XSTRNG=815 452C !MIRROR BLOCKS. 453 IF(((LDIR.GT.180).AND..NOT.MR1F).OR. 454& ((LDIR.LT.180).AND..NOT.MR2F)) XSTRNG=816 455 RETURN 456C 457C C9- FROBOZZ FLAG (MIRIN) 458C 4599000 IF(MRHERE(HERE).NE.1) GO TO 9100 460C !MIRROR 1 HERE? 461 IF(MR1F) XSTRNG=805 462C !SEE IF BROKEN. 463 FROBZF=MROPNF 464C !ENTER IF OPEN. 465 RETURN 466C 4679100 FROBZF=.FALSE. 468C !NOT HERE, 469 XSTRNG=817 470C !LOSE. 471 RETURN 472C CXAPPL, PAGE 4 473C 474C C10- FROBOZZ FLAG (MIRROR EXIT) 475C 47610000 FROBZF=.FALSE. 477C !ASSUME CANT. 478 LDIR=((PRSO-XNORTH)/XNORTH)*45 479C !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) 484C !ASSUME E-W EXIT. 485 IF(MOD(MDIR,180).EQ.0) GO TO 10100 486C !IF N-S, OK. 487 XROOM1=MLOC+1 488C !ASSUME N EXIT. 489 IF(MDIR.GT.180) XROOM1=MLOC-1 490C !IF SOUTH. 49110100 CXAPPL=XROOM1 492 RETURN 493C 49410200 IF(.NOT.WDOPNF .OR. 495& ((MOD(MDIR+180,360).NE.LDIR).AND.(PRSO.NE.XEXIT))) 496& RETURN 497 XROOM1=MLOC+1 498C !ASSUME N. 499 IF(MDIR.EQ.0) XROOM1=MLOC-1 500C !IF S. 501 CALL RSPEAK(818) 502C !CLOSE DOOR. 503 WDOPNF=.FALSE. 504 CXAPPL=XROOM1 505 RETURN 506C 507C C11- MAYBE DOOR. NORMAL MESSAGE IS THAT DOOR IS CLOSED. 508C BUT IF LCELL.NE.4, DOOR ISNT THERE. 509C 51011000 IF(LCELL.NE.4) XSTRNG=678 511C !SET UP MSG. 512 RETURN 513C 514C C12- FROBZF (PUZZLE ROOM MAIN ENTRANCE) 515C 51612000 FROBZF=.TRUE. 517C !ALWAYS ENTER. 518 CPHERE=10 519C !SET SUBSTATE. 520 RETURN 521C 522C C13- CPOUTF (PUZZLE ROOM SIZE ENTRANCE) 523C 52413000 CPHERE=52 525C !SET SUBSTATE. 526 RETURN 527C CXAPPL, PAGE 5 528C 529C C14- FROBZF (PUZZLE ROOM TRANSITIONS) 530C 53114000 FROBZF=.FALSE. 532C !ASSSUME LOSE. 533 IF(PRSO.NE.XUP) GO TO 14100 534C !UP? 535 IF(CPHERE.NE.10) RETURN 536C !AT EXIT? 537 XSTRNG=881 538C !ASSUME NO LADDER. 539 IF(CPVEC(CPHERE+1).NE.-2) RETURN 540C !LADDER HERE? 541 CALL RSPEAK(882) 542C !YOU WIN. 543 FROBZF=.TRUE. 544C !LET HIM OUT. 545 RETURN 546C 54714100 IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST).OR..NOT.CPOUTF) 548& GO TO 14200 549 FROBZF=.TRUE. 550C !YES, LET HIM OUT. 551 RETURN 552C 55314200 DO 14300 I=1,16,2 554C !LOCATE EXIT. 555 IF(PRSO.EQ.CPDR(I)) GO TO 14400 55614300 CONTINUE 557 RETURN 558C !NO SUCH EXIT. 559C 56014400 J=CPDR(I+1) 561C !GET DIRECTIONAL OFFSET. 562 NXT=CPHERE+J 563C !GET NEXT STATE. 564 K=8 565C !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 571C 57214500 CALL CPGOTO(NXT) 573C !MOVE TO STATE. 574 XROOM1=CPUZZ 575C !STAY IN ROOM. 576 CXAPPL=XROOM1 577 RETURN 578C 579 END 580