# 2.11BSD#431 - /usr/src/new/PORT/dungeon/dverb2.F

       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: 652 |