C Verb processors for DUNGEON
C
C COPYRIGHT 1980, 1990, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA.
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C 1-Oct-94      RMS     Fixed bugs in ANSWER, INCANT, UNTIE FROM, FILL,
C                       GIVE, SHAKE, PLAY, POUR, POUR ON, TAKE, SPIN, BURN,
C                       ALARM, collectives, subcripting.
C                       Added COUNT, Puzzle Room entrance test.
C 11-Feb-94     RMS     Fixed bug in chimney load calculation.
C 30-Jan-94     RMS     Fixed bugs from MS DOS port.
C 27-Jan-94     RMS     Fixed portability problem in answer array.
C 25-Jan-94     RMS     Fixed bug in DIG not with shovel.
C 09-Jul-92     RMS     Fixed subscript range error.
C 01-Jul-92     RMS     Removed extraneous function from TAKE.
C 30-Jun-92     RMS     Changed file names to lower case.
C
C VAPPLI- Main verb processing routine
C
C Declarations
C
      LOGICAL FUNCTION VAPPLI(RI)
      IMPLICIT INTEGER (A-Z)
      INCLUDE 'dparam.for'
      PARAMETER (MXNOP=39,MXJOKE=64,MXSMP=99)
      PARAMETER (NUMANS=16)
      LOGICAL LIT,OBJACT,WASLIT
      LOGICAL QEMPTY,RMDESC,CLOCKD
      LOGICAL MOVETO,YESNO
      LOGICAL QOPEN,EDIBLE,DRKBLE
      LOGICAL TAKE,PUT,DROP,WALK
      LOGICAL QHERE,FINDXT,OAPPLI,F
      INTEGER JOKES(25),ANSWER(NUMANS)
      CHARACTER*12 ANSSTR(NUMANS)
      CHARACTER*(WRDLNT) PW(2),CH,CH2
C
C Functions and data
C
      QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0
      EDIBLE(R)=(OFLAG1(R).AND.FOODBT).NE.0
      DRKBLE(R)=(OFLAG1(R).AND.DRNKBT).NE.0
      DATA JOKES/4,5,3,304,305,306,307,308,309,310,311,312,
     1313,5314,5319,324,325,883,884,120,120,0,0,0,0/
      DATA ANSWER/0,1,2,2,3,4,4,4,4,4,5,5,5,6,7,7/
      DATA ANSSTR/'TEMPLE','FOREST','30003','30,003','FLASK','RUB',
     1'FONDLE','CARESS','FEEL','TOUCH','BONES','BODY',
     2'SKELETON','RUSTY KNIFE','NONE','NOWHERE'/

C VAPPLI, PAGE 2
C
      VAPPLI=.TRUE.                             ! assume wins.
      ODO2=0
      ODI2=0
      IF((PRSO.NE.0).AND.(PRSO.LE.OMAX)) ODO2=ODESC2(PRSO)
      IF(PRSI.NE.0) ODI2=ODESC2(PRSI)           ! set up descriptors.
      AV=AVEHIC(WINNER)                         ! (PRSO can be direction.)
      RMK=372+RND(6)                            ! remark for hack-hacks.
      IF(RI.EQ.0) GO TO 10                      ! zero is false.
      IF(RI.LE.MXNOP) RETURN                    ! nop?
      IF(RI.LE.MXJOKE) GO TO 20                 ! joke?
      IF(RI.LE.MXSMP) GO TO 30                  ! simple verb?
      WASLIT=LIT(HERE)
      GO TO (
     1  500, 1000, 2000, 3000, 4000, 5000, 6000, 7000, 8000, 9000,
     210000,11000,12000,13000,14000,15000,16000,17000,18000,19000,
     320000,21000,22000,23000,24000,25000,26000,27000,28000,29000,
     430000,31000,32000,33000,34000,35000,36000,37000,38000,39000,
     540000,41000,42000,43000,44000,45000,46000,47000,48000,49000,
     650000,51000,52000,53000,54000,55000,56000,57000,58000,59000,
     760000,61000,62000,63000,64000,65000,66000,67000,68000,69000),
     9(RI-MXSMP)
      CALL BUG(7,RI)
C
C All verb processors return here to declare failure.
C
10    VAPPLI=.FALSE.                            ! lose.
      RETURN
C
C Joke processor.
C Find proper entry in jokes, use it to select string to print.
C
20    I=JOKES(RI-MXNOP)                         ! get table entry.
      J=I/1000                                  ! isolate # strings.
      IF(J.NE.0) I=MOD(I,1000)+RND(J)           ! if random, choose.
      CALL RSPEAK(I)                            ! print joke.
      RETURN
C
C 'Simple' verbs.
C
30    GO TO (65001,66001,67001,68001,69001,
     170000,71000,72000,73000,74000,75000,76000,77000,78000,79000,
     280000,81000,82000,83000,84000,85000,86000,87000,88000,89000,
     390000,91000,92000,93000,94000,95000,96000,97000),
     9(RI-MXJOKE)
      CALL BUG(7,RI)
C
C Here to test for change in light.
C
50    IF(WASLIT.AND..NOT.LIT(HERE)) CALL RSPEAK(406)
      RETURN

C VAPPLI, PAGE 3
C
C V100--        Read
C
500   IF(LIT(HERE)) GO TO 600                   ! room lit?
      CALL RSPEAK(356)                          ! no, cant read.
      RETURN
C
600   IF(PRSI.EQ.0) GO TO 700                   ! read through obj?
      IF((OFLAG1(PRSI).AND.TRANBT).NE.0) GO TO 700
      CALL RSPSUB(357,ODI2)                     ! not transparent.
      RETURN
C
700   IF(OBJACT(X)) RETURN                      ! object handle?
      IF((OFLAG1(PRSO).AND.READBT).NE.0) GO TO 800
      CALL RSPSUB(358,ODO2)                     ! not readable.
      RETURN
C
800   CALL RSPEAK(OREAD(PRSO))                  ! print reading material.
      RETURN
C
C V101--        Melt
C
1000  IF(.NOT.OBJACT(X)) CALL RSPSUB(361,ODO2)
      RETURN
C
C V102--        Inflate
C
2000  IF(.NOT.OBJACT(X)) CALL RSPEAK(368)       ! obj handle?
      RETURN
C
C V103--        Deflate.
C
3000  IF(.NOT.OBJACT(X)) CALL RSPEAK(369)       ! obj handle?
      RETURN

C VAPPLI, PAGE 4
C
C V104--        Alarm
C
4000  IF((OFLAG2(PRSO).AND.VILLBT).NE.0) GO TO 4100 ! villain?
      CALL RSPEAK(552+RND(6))                   ! no, joke.
      RETURN
C
4100  IF(.NOT.OBJACT(X)) CALL RSPSUB(370,ODO2)
      RETURN
C
C V105--        Exorcise
C
5000  F=OBJACT(X)                               ! objects handle.
      RETURN
C
C V106--        Plug
C
6000  IF(.NOT.OBJACT(X)) CALL RSPEAK(371)
      RETURN
C
C V107--        Kick
C
7000  IF(.NOT.OBJACT(X)) CALL RSPSB2(378,ODO2,RMK)
      RETURN
C
C V108--        Wave
C
8000  IF(.NOT.OBJACT(X)) CALL RSPSB2(379,ODO2,RMK)
      RETURN
C
C V109,V110--   Raise, lower
C
9000  CONTINUE
10000 IF(.NOT.OBJACT(X)) CALL RSPSB2(380,ODO2,RMK)
      RETURN
C
C V111--        Rub
C
11000 IF(.NOT.OBJACT(X)) CALL RSPSB2(381,ODO2,RMK)
      RETURN
C
C V112--        Push
C
12000 IF(.NOT.OBJACT(X)) CALL RSPSB2(382,ODO2,RMK)
      RETURN

C VAPPLI, PAGE 5
C
C V113--        Untie
C
13000 IF(OBJACT(X)) RETURN                      ! object handle?
      I=383                                     ! no, not tied.
      IF((OFLAG2(PRSO).AND.TIEBT).EQ.0) I=384   ! not tieable.
      CALL RSPEAK(I)
      RETURN
C
C V114--        Tie
C
14000 IF((OFLAG2(PRSO).AND.TIEBT).NE.0) GO TO 14100
      CALL RSPEAK(385)                          ! not tieable.
      RETURN
C
14100 IF(OBJACT(X)) RETURN                      ! object handle?
      I=386                                     ! joke 1.
      IF(PRSI.EQ.OPLAY) I=919                   ! if player, joke 2.
      CALL RSPSUB(386,ODO2)                     ! print remark.
      RETURN
C
C V115--        Tie up
C
15000 IF((OFLAG2(PRSI).AND.TIEBT).NE.0) GO TO 15100
      CALL RSPSUB(387,ODO2)                     ! not tieable.
      RETURN
C
15100 I=388                                     ! assume villain.
      IF((OFLAG2(PRSO).AND.VILLBT).EQ.0) I=389
      CALL RSPSUB(I,ODO2)                       ! joke.
      RETURN
C
C V116--        Turn
C
16000 IF((OFLAG1(PRSO).AND.TURNBT).NE.0) GO TO 16100
      CALL RSPEAK(390)                          ! not turnable.
      RETURN
C
16100 IF((OFLAG1(PRSI).AND.TOOLBT).NE.0) GO TO 16200
      CALL RSPSUB(391,ODI2)                     ! not a tool.
      RETURN
C
16200 VAPPLI=OBJACT(X)                          ! let object handle.
      RETURN
C
C V117--        Breathe
C
17000 PRSA=INFLAW
      PRSI=LUNGS
      GO TO 2000                                ! handle like inflate.

C VAPPLI, PAGE 5A.
C
C V118--        Knock
C
18000 IF(OBJACT(X)) RETURN                      ! obj handle?
      I=394                                     ! joke for door.
      IF((OFLAG1(PRSO).AND.DOORBT).EQ.0) I=395
      CALL RSPSUB(I,ODO2)                       ! joke for nondoors too.
      RETURN
C
C V119--        Look
C
19000 IF(PRSO.NE.0) GO TO 20500                 ! something to look at?
      VAPPLI=RMDESC(3)                          ! handled by rmdesc.
      RETURN
C
C V120--        Examine
C
20000 IF(PRSO.NE.0) GO TO 20500                 ! something to examine?
      VAPPLI=RMDESC(0)                          ! handled by rmdesc.
      RETURN
C
20500 IF(OBJACT(X)) RETURN                      ! obj handle?
      I=OREAD(PRSO)                             ! get reading material.
      IF(I.NE.0) CALL RSPEAK(I)                 ! output if there,
      IF(I.EQ.0) CALL RSPSUB(429,ODO2)          ! otherwise default.
      PRSA=FOOW                                 ! defuse room processors.
      RETURN
C
C V121--        Shake
C
21000 IF(OBJACT(X)) RETURN                      ! object handle?
      IF(PRSO.EQ.GWATE) GO TO 10                ! global water? fails.
      IF((OFLAG2(PRSO).AND.VILLBT).EQ.0) GO TO 21100
      CALL RSPEAK(371)                          ! joke for villains.
      RETURN
C
21100 IF(PRSO.NE.AV) GO TO 21150                ! vehicle?
      CALL RSPEAK(672)                          ! yes, joke.
      RETURN
C
21150 IF((OFLAG1(PRSO).AND.TAKEBT).NE.0) GO TO 21200 ! takeable?
      CALL RSPEAK(923)                          ! no, joke.
      RETURN
C
21200 IF(OADV(PRSO).EQ.WINNER) GO TO 21250      ! carrying?
      CALL RSPEAK(527)                          ! no, joke.
      RETURN
C
21250 IF(QEMPTY(PRSO)) GO TO 10                 ! empty?  fails.
      IF(QOPEN(PRSO)) GO TO 21300               ! open?  spill.
      CALL RSPSUB(396,ODO2)                     ! no, describe noise.
      RETURN
C
21300 CALL RSPSUB(397,ODO2)                     ! spill the works.
      DO 21500 I=1,OLNT                         ! spill contents.
        IF(OCAN(I).NE.PRSO) GO TO 21500         ! inside?
        OFLAG2(I)=OFLAG2(I).OR.TCHBT            ! touch object.
        IF(AV.EQ.0) GO TO 21400                 ! in vehicle?
        CALL NEWSTA(I,0,0,AV,0)                 ! yes, spill in there.
        GO TO 21500
C
21400   CALL NEWSTA(I,0,HERE,0,0)               ! no, spill on floor,
        IF(I.EQ.WATER) CALL NEWSTA(I,133,0,0,0) ! but water disappears.
21500 CONTINUE
      RETURN

C VAPPLI, PAGE 6
C
C V122--        Move
C
22000 IF(.NOT.QHERE(PRSO,HERE)) GO TO 22100     ! is it here?
      IF(OBJACT(X)) RETURN                      ! obj handle?
      I=399                                     ! assume not takeable.
      IF((OFLAG1(PRSO).AND.TAKEBT).NE.0) I=887
      CALL RSPSUB(I,ODO2)                       ! joke.
      RETURN
C
22100 CALL RSPEAK(398)                          ! not here.
      RETURN
C
C V123--        Turn on
C
23000 IF(OBJACT(X)) RETURN                      ! object handle?
      IF(((OFLAG1(PRSO).AND.LITEBT).NE.0).AND.
     1(OADV(PRSO).EQ.WINNER)) GO TO 23100
      CALL RSPEAK(400)                          ! cant do it.
      RETURN
C
23100 IF((OFLAG1(PRSO).AND.ONBT).EQ.0) GO TO 23200
      CALL RSPEAK(401)                          ! already on.
      RETURN
C
23200 OFLAG1(PRSO)=OFLAG1(PRSO).OR.ONBT         ! turn it on.
      CALL RSPSUB(404,ODO2)
      RETURN
C
C V124--        Turn off
C
24000 IF(OBJACT(X)) RETURN                      ! obj handle?
      IF(((OFLAG1(PRSO).AND.LITEBT).NE.0).AND.
     1(OADV(PRSO).EQ.WINNER)) GO TO 24100
      CALL RSPEAK(402)                          ! cant do it.
      RETURN
C
24100 IF((OFLAG1(PRSO).AND.ONBT).NE.0) GO TO 24200
      CALL RSPEAK(403)                          ! already off.
      RETURN
C
24200 OFLAG1(PRSO)=OFLAG1(PRSO).AND. .NOT.ONBT
      CALL RSPSUB(405,ODO2)
      GO TO 50                                  ! go see if now dark.
C
C V125--        Open
C
25000 IF(OBJACT(X)) RETURN                      ! obj handle?
      IF((OFLAG1(PRSO).AND.DOORBT).NE.0) GO TO 25150 ! door?
      IF((OFLAG1(PRSO).AND.CONTBT).NE.0) GO TO 25100 ! container?
25050 CALL RSPSUB(407,ODO2)                     ! not door or container.
      RETURN
C
25100 IF(OCAPAC(PRSO).NE.0) GO TO 25200         ! openable container?
25150 CALL RSPSUB(408,ODO2)                     ! door or not openable.
      RETURN
C
25200 IF(.NOT.QOPEN(PRSO)) GO TO 25225
      CALL RSPEAK(412)                          ! already open.
      RETURN
C
25225 OFLAG2(PRSO)=OFLAG2(PRSO).OR.OPENBT       ! open it.
      IF(((OFLAG1(PRSO).AND.TRANBT).NE.0).OR.QEMPTY(PRSO))
     1GO TO 25300
      CALL PRINCO(PRSO,410,.FALSE.)             ! print contents.
      RETURN
C
25300 CALL RSPEAK(409)                          ! done
      RETURN
C
C V126--        Close
C
26000 IF(OBJACT(X)) RETURN                      ! obj handle?
      IF((OFLAG1(PRSO).AND.DOORBT).NE.0) GO TO 26050 ! door?
      IF((OFLAG1(PRSO).AND.CONTBT).EQ.0) GO TO 25050 ! container?
      IF(OCAPAC(PRSO).NE.0) GO TO 26100         ! closable container?
26050 CALL RSPSUB(411,ODO2)                     ! door or not closable.
      RETURN
C
26100 IF(QOPEN(PRSO)) GO TO 26200               ! open?
      CALL RSPEAK(413)                          ! no, joke.
      RETURN
C
26200 OFLAG2(PRSO)=OFLAG2(PRSO).AND. .NOT.OPENBT
      CALL RSPEAK(414)                          ! done.
      GO TO 50                                  ! go see if now dark.

C VAPPLI, PAGE 7
C
C V127--        Find
C
27000 IF(OBJACT(X)) RETURN                      ! obj handle?
      I=415                                     ! room string.
      IF(QHERE(PRSO,HERE)) GO TO 27200          ! in room?
      I=416                                     ! winner string.
      IF(OADV(PRSO).EQ.WINNER) GO TO 27200      ! on winner?
      J=OCAN(PRSO)                              ! down one level.
      IF(J.EQ.0) GO TO 10
      IF((((OFLAG1(J).AND.TRANBT).EQ.0).AND.
     2(.NOT.QOPEN(J).OR.((OFLAG1(J).AND.(DOORBT+CONTBT)).EQ.0))))
     3GO TO 10                                  ! if not visible, punt.
      I=417                                     ! assume in room.
      IF(QHERE(J,HERE)) GO TO 27100
      I=418                                     ! assume on winner.
      IF(OADV(J).NE.WINNER) GO TO 10            ! not here or on person.
27100 CALL RSPSUB(I,ODESC2(J))                  ! describe findings.
      RETURN
C
27200 CALL RSPSUB(I,ODO2)                       ! describe findings.
      RETURN
C
C V128--        Wait
C
28000 CALL RSPEAK(419)                          ! time passes.
      DO 28100 I=1,3
        IF(CLOCKD(X)) RETURN
        IF(.NOT.DEADF) CALL FIGHTD
        IF(PRSCON.EQ.0) RETURN                  ! fighting happened.
28100 CONTINUE
      RETURN
C
C V129--        Spin
C V159--        Turn to
C
29000 CONTINUE
59000 IF(OBJACT(X)) RETURN                      ! object handle?
      IF((OFLAG1(PRSO).AND.TURNBT).NE.0) GO TO 59100
      CALL RSPEAK(390)                          ! can't turn?
      RETURN
C
59100 CALL RSPSUB(663,ODO2)                     ! won't budge.
      RETURN
C
C V130--        Board
C
30000 IF((OFLAG2(PRSO).AND.VEHBT).NE.0) GO TO 30100
      CALL RSPSUB(421,ODO2)                     ! not vehicle, joke.
      PRSCON=0                                  ! kill cmd stream.
      RETURN
C
30100 IF(QHERE(PRSO,HERE)) GO TO 30200          ! here?
      CALL RSPSUB(420,ODO2)                     ! no, joke.
      PRSCON=0                                  ! kill cmd stream.
      RETURN
C
30200 IF(AV.EQ.0) GO TO 30300                   ! already got one?
      CALL RSPSUB(422,ODO2)                     ! yes, joke.
      PRSCON=0                                  ! kill cmd stream.
      RETURN
C
30300 IF(OBJACT(X)) RETURN                      ! obj handle?
      CALL RSPSUB(423,ODO2)                     ! describe.
      AVEHIC(WINNER)=PRSO
      IF(WINNER.NE.PLAYER) CALL NEWSTA(AOBJ(WINNER),0,0,PRSO,0)
      RETURN
C
C V131--        Disembark
C
31000 IF(AV.EQ.PRSO) GO TO 31100                ! from vehicle?
      CALL RSPEAK(424)                          ! no, joke.
      PRSCON=0                                  ! kill cmd stream.
      RETURN
C
31100 IF(OBJACT(X)) RETURN                      ! obj handle?
      IF((RFLAG(HERE).AND.RLAND).NE.0) GO TO 31200
      CALL RSPEAK(425)                          ! not on land.
      PRSCON=0                                  ! kill cmd stream.
      RETURN
C
31200 AVEHIC(WINNER)=0
      CALL RSPEAK(426)
      IF(WINNER.NE.PLAYER) CALL NEWSTA(AOBJ(WINNER),0,HERE,0,0)
      RETURN
C
C V132--        Take
C
32000 VAPPLI=TAKE(.TRUE.)
      RETURN
C
C V133--        Inventory
C
33000 CALL INVENT(WINNER)
      RETURN

C VAPPLI, PAGE 8
C
C V134--        Fill
C
34000 IF(PRSI.NE.0) GO TO 34050                 ! any obj specified?
      IF((RFLAG(HERE).AND.(RWATER+RFILL)).NE.0) GO TO 34025
      CALL RSPEAK(516)                          ! nothing to fill with.
      PRSWON=.FALSE.                            ! you lose.
      CALL ORPHAN(-1,ACT,PREP1,PRSO,2,' ',0,0)! orphan "fill obj with"
      GO TO 10                                  ! return false.
C
34025 PRSI=GWATE                                ! use global water.
34050 IF(OBJACT(X)) RETURN                      ! obj handle?
      IF((PRSI.EQ.GWATE).OR.(PRSI.EQ.WATER)) GO TO 10
      I=PRSO                                    ! fill x with y becomes
      PRSO=PRSI                                 ! put y in x
      PRSI=I
      VAPPLI=PUT(.TRUE.)
      RETURN
C
C V135,V136--   Eat/Drink
C
35000 CONTINUE
36000 IF(OBJACT(X)) RETURN                      ! obj handle?
      IF(PRSO.EQ.GWATE) GO TO 36500             ! drink global water?
      IF(.NOT.EDIBLE(PRSO)) GO TO 36400         ! edible?
      IF(OADV(PRSO).EQ.WINNER) GO TO 36200      ! yes, on winner?
36100 CALL RSPSUB(454,ODO2)                     ! not accessible.
      RETURN
C
36200 IF(PRSA.EQ.DRINKW) GO TO 36300            ! drink food?
      CALL NEWSTA(PRSO,455,0,0,0)               ! no, it disappears.
      RETURN
C
36300 CALL RSPEAK(456)                          ! yes, joke.
      RETURN
C
36400 IF(.NOT.DRKBLE(PRSO)) GO TO 36600         ! drinkable?
      IF(OCAN(PRSO).EQ.0) GO TO 36100           ! yes, in something?
      IF(OADV(OCAN(PRSO)).NE.WINNER) GO TO 36100
      IF(QOPEN(OCAN(PRSO))) GO TO 36500         ! cont open?
      CALL RSPEAK(457)                          ! no, joke.
      RETURN
C
36500 CALL NEWSTA(PRSO,458,0,0,0)               ! gone.
      RETURN
C
36600 CALL RSPSUB(453,ODO2)                     ! not food or drink.
      RETURN
C
C V137--        Burn
C
37000 IF((OFLAG1(PRSI).AND.(FLAMBT+LITEBT+ONBT)).NE.
     1(FLAMBT+LITEBT+ONBT)) GO TO 37600                 ! with flame?
      IF(OBJACT(X)) RETURN                      ! obj handle?
      IF((OFLAG1(PRSO).AND.BURNBT).EQ.0) GO TO 37500 ! burnable?
      IF(OADV(PRSO).EQ.WINNER) GO TO 37400      ! carrying it?
      IF(QHERE(PRSO,HERE)) GO TO 37200          ! here?
      J=OCAN(PRSO)                              ! get container.
      IF(J.EQ.0) GO TO 37100                    ! is there one?
      IF(.NOT.QOPEN(J)) GO TO 37100             ! open?
      IF(J.EQ.RECEP) GO TO 37300                ! in balloon receptacle?
      IF(OADV(J).EQ.WINNER) GO TO 37400         ! carrying?
      IF(QHERE(J,HERE)) GO TO 37200             ! here?
37100 CALL RSPEAK(461)                          ! cant reach it.
      RETURN
C
37200 CALL RSPSUB(462,ODO2)                     ! burn it.
      CALL NEWSTA(PRSO,0,0,0,0)
      RETURN
C
37300 VAPPLI=OAPPLI(OACTIO(BALLO),0)            ! fire in receptacle.
      RETURN
C
37400 CALL RSPSUB(459,ODO2)                     ! burnable on player.
      CALL JIGSUP(460)
      RETURN
C
37500 CALL RSPSUB(463,ODO2)                     ! cant burn it.
      RETURN
C
37600 CALL RSPSUB(301,ODI2)                     ! cant burn it with that.
      RETURN

C VAPPLI, PAGE 9
C
C V138--        Mung
C
38000 I=466                                     ! choose phrase.
      IF((OFLAG2(PRSO).AND.VILLBT).NE.0) GO TO 41100
      IF(.NOT.OBJACT(X)) CALL RSPSB2(466,ODO2,RMK)
      RETURN
C
C V139--        Kill
C
39000 I=467                                     ! choose phrase.
      GO TO 41100
C
C V140--        Swing
C
40000 J=PRSO                                    ! invert.
      PRSO=PRSI
      PRSI=J
      J=ODO2
      ODO2=ODI2
      ODI2=J
      PRSA=ATTACW                               ! for objact.
C
C V141--        Attack
C
41000 I=468
C
C Common mung/attack/swing/kill code.
C
41100 IF(PRSO.NE.0) GO TO 41200                 ! anything?
      CALL RSPEAK(469)                          ! no, joke.
      RETURN
C
41200 IF(OBJACT(X)) RETURN                      ! obj handle?
      IF((OFLAG2(PRSO).AND.VILLBT).NE.0) GO TO 41300
      IF((OFLAG1(PRSO).AND.VICTBT).EQ.0)
     1CALL RSPSUB(470,ODO2)                     ! not a villain.
      RETURN
C
41300 J=471                                     ! assume no weapon.
      IF(PRSI.EQ.0) GO TO 41500
      IF((OFLAG2(PRSI).AND.WEAPBT).EQ.0) GO TO 41400
      MELEE=1                                   ! assume sword.
      IF(PRSI.NE.SWORD) MELEE=2                 ! must be knife.
      I=BLOW(PLAYER,PRSO,MELEE,.TRUE.,0)        ! strike blow.
      RETURN
C
41400 J=472                                     ! not a weapon.
41500 CALL RSPSB2(I,ODO2,J)                     ! joke.
      RETURN

C VAPPLI, PAGE 10
C
C V142--        Walk
C
42000 VAPPLI=WALK(X)
      RETURN
C
C V143--        Tell
C
43000 CALL RSPEAK(603)
      PRSCON=0                                  ! kill cmd stream.
      RETURN
C
C V144--        Put
C
44000 VAPPLI=PUT(.TRUE.)
      RETURN
C
C V145,V148--   Drop/Throw
C
45000 CONTINUE                                  ! throw.
48000 VAPPLI=DROP(.TRUE.)                       ! drop.
      RETURN
C
C V146--        Give
C
46000 IF(OADV(PRSO).EQ.WINNER) GO TO 46100      ! is he carrying obj?
      X=OCAN(PRSO)                              ! get container.
      IF(X.EQ.0) GO TO 46200                    ! container?
      IF(.NOT.QOPEN(X)) GO TO 46200             ! open?
      IF(OADV(X).NE.WINNER) GO TO 46200         ! carrying?
46100 VAPPLI=OBJACT(X)                          ! iobject must handle.
      RETURN
C
46200 CALL RSPEAK(527)                          ! don't have it.
      RETURN
C
C V147--        Pour
C
47000 IF(PRSO.EQ.WATER) GO TO 47100             ! pour? must be water.
      CALL RSPEAK(1075)                         ! otherwise, joke.
      RETURN
C
47100 IF(PRSI.EQ.0) GO TO 48000                 ! pour x, treat like drop.
      PRSA=PUTW                                 ! else, treat like put.
      VAPPLI=PUT(.TRUE.)
      RETURN
C
C V149--        Save
C
49000 IF((RFLAG(TSTRS).AND.RSEEN).EQ.0) GO TO 49100
      CALL RSPEAK(828)                          ! no saves in endgame.
      RETURN
C
49100 CALL SAVEGM                               ! save game.
      PRSWON=.FALSE.                            ! disable rest of move.
      PRSCON=0
      RETURN
C
C V150--        Restore
C
50000 IF((RFLAG(TSTRS).AND.RSEEN).EQ.0) GO TO 50100
      CALL RSPEAK(829)                          ! no restores in endgame.
      RETURN
C
50100 CALL RSTRGM                               ! restore game.
      PRSWON=.FALSE.                            ! disable rest of move.
      PRSCON=0
      RETURN

C VAPPLI, PAGE 11
C
C V151--        Hello
C
51000 IF(PRSO.NE.0) GO TO 51100                 ! any obj?
      CALL RSPEAK(346+RND(4))                   ! no, vanilla hello.
      RETURN
C
51100 IF(PRSO.NE.AVIAT) GO TO 51200             ! hello aviator?
      CALL RSPEAK(350)                          ! nothing happens.
      RETURN
C
51200 IF(PRSO.NE.SAILO) GO TO 51300             ! hello sailor?
      HS=HS+1                                   ! count.
      I=351                                     ! give normal or
      IF(MOD(HS,10).EQ.0) I=352                 ! random message.
      IF(MOD(HS,20).EQ.0) I=353
      CALL RSPEAK(I)                            ! speak up.
      RETURN
C
51300 IF(OBJACT(X)) RETURN                      ! obj handle?
      I=354                                     ! assume villain.
      IF((OFLAG2(PRSO).AND.(VILLBT+ACTRBT)).EQ.0) I=355
      CALL RSPSUB(I,ODO2)                       ! hello there!
      RETURN
C
C V152--        Look into
C
52000 IF(OBJACT(X)) RETURN                      ! obj handle?
      IF((OFLAG1(PRSO).AND.DOORBT).EQ.0) GO TO 52300 ! door?
      IF(.NOT.QOPEN(PRSO)) GO TO 52200          ! open?
      CALL RSPSUB(628,ODO2)                     ! open door- uninteresting.
      RETURN
C
52200 CALL RSPSUB(525,ODO2)                     ! closed door- cant see.
      RETURN
C
52300 IF((OFLAG1(PRSO).AND.CONTBT).NE.0) GO TO 52500 ! container?
      IF(QOPEN(PRSO)) GO TO 52400               ! open anyway?
      CALL RSPSUB(630,ODO2)                     ! cant look inside.
      RETURN
C
52400 IF(.NOT.QEMPTY(PRSO)) GO TO 52700         ! not empty?
      CALL RSPSUB(1054,ODO2)                    ! doesn't contain anything.
      RETURN
C
52500 IF(QOPEN(PRSO).OR.((OFLAG1(PRSO).AND.TRANBT).NE.0))
     1GO TO 52600                               ! open or see inside?
      CALL RSPSUB(525,ODO2)                     ! closed.
      RETURN
C
52600 IF(QEMPTY(PRSO)) GO TO 52800              ! see in.  empty?
52700 CALL PRINCO(PRSO,573,.TRUE.)              ! no, list contents.
      RETURN
C
52800 CALL RSPSUB(629,ODO2)                     ! empty.
      RETURN

C VAPPLI, PAGE 12
C
C V153--        Look under
C
53000 IF(.NOT.OBJACT(X)) CALL RSPEAK(631)       ! object handle?
      RETURN
C
C V154--        Pump
C
54000 IF((OROOM(PUMP).EQ.HERE).OR.(OADV(PUMP).EQ.WINNER))
     1GO TO 54100                               ! pump here?
      CALL RSPEAK(632)                          ! no.
      RETURN
C
54100 PRSI=PUMP                                 ! becomes inflate
      PRSA=INFLAW                               ! x with pump.
      GO TO 2000                                ! done.
C
C V155--        Wind
C
55000 IF(.NOT.OBJACT(X)) CALL RSPSUB(634,ODO2)          ! obj handle?
      RETURN
C
C V156--        Climb
C V157--        Climb up
C V158--        Climb down
C
56000 CONTINUE
57000 CONTINUE
58000 IF(OBJACT(X)) RETURN                      ! object handle?
      I=XUP                                     ! assume up.
      IF(PRSA.EQ.CLMBDW) I=XDOWN                ! unless climb dn.
      F=(OFLAG2(PRSO).AND.CLMBBT).NE.0
      IF(F.AND.FINDXT(I,HERE)) GO TO 58500      ! anything to climb?
      I=657
      IF(F) I=524                               ! variety of jokes.
      IF(.NOT.F .AND.((PRSO.EQ.WALL).OR.(PRSO.EQ.GRWAL).OR.
     1((PRSO.GE.WNORT).AND.(PRSO.LE.WNORT+3))))
     2I=656                                     ! if walls.
      CALL RSPEAK(I)                            ! joke.
      RETURN
C
58500 PRSA=WALKW                                ! walk
      PRSO=I                                    ! in specified dir.
      GO TO 42000                               ! treat as walk.

C VAPPLI, PAGE 13
C
C V160--        Pour on
C
60000 IF(PRSO.NE.WATER) GO TO 60500             ! pour water?
      IF(OBJACT(X)) RETURN                      ! object handle?
      CALL NEWSTA(WATER,0,0,0,0)                ! vanish water.
      IF(OCAN(PRSI).NE.RECEP) GO TO 60100       ! onto obj in receptacle?
      CALL RSPSUB(977,ODI2)                     ! doesn't work.
      RETURN
C
60100 IF((OFLAG1(PRSI).AND.(LITEBT+FLAMBT+ONBT)).NE.
     1(LITEBT+FLAMBT+ONBT)) GO TO 60300                 ! on flame?
      IF(PRSI.NE.TORCH) GO TO 60200             ! on torch?
      CALL RSPEAK(978)                          ! doesn't work.
      RETURN
C
60200 OFLAG1(PRSI)=OFLAG1(PRSI).AND..NOT.ONBT   ! extinguish.
      CALL RSPSUB(979,ODI2)                     ! describe.
      IF(PRSI.EQ.CANDL) CFLAG(CEVCND)=.FALSE.   ! if candle, disable timer.
      IF(PRSI.EQ.MATCH) CTICK(CEVMAT)=0         ! if match, gone.
      GO TO 50                                  ! go see if now dark.
C
60300 CALL RSPSUB(980,ODI2)                     ! doesn't work.
      RETURN
C
60500 CALL RSPEAK(981)                          ! not water, joke.
      RETURN
C
C V161--        Put under
C
61000 IF(OBJACT(X)) RETURN                      ! object handle.
      I=1037                                    ! can't do.
      IF((OFLAG1(PRSO).AND.DOORBT).NE.0) I=982          ! if door, won't fit.
      CALL RSPEAK(I)
      RETURN
C
C V162--        Untie from
C
62000 IF(((PRSO.EQ.BROPE).AND.(BTIEF.NE.0)).OR.
     1 ((PRSO.EQ.ROPE).AND.(TTIE.EQ.PRSI)).OR.
     2 ((PRSO.EQ.ROPE).AND.(PRSI.EQ.RAILI).AND.DOMEF))
     3 GO TO 62100                              ! untie rope?
      CALL RSPEAK(1070)                         ! not attached to that.
      RETURN
C
62100 PRSA=UNTIEW                               ! treat as normal untie.
      GO TO 13000

C VAPPLI, PAGE 14
C
C V163--        Make
C V169--        Wish
C
63000 IF(PRSO.NE.GWISH) GO TO 10                ! make a wish?
69000 IF(HERE.NE.BWELL) GO TO 63100             ! at well?
      IF(OROOM(BAGCO).EQ.HERE) GO TO 63200      ! coins here?
      IF(OROOM(ZORKM).EQ.HERE) GO TO 63300      ! zorkmid here?
63100 CALL RSPEAK(937)                          ! doesn't work.
      RETURN
C
63200 CALL NEWSTA(BAGCO,938,0,0,0)              ! vanish coins
      RETURN
C
63300 CALL NEWSTA(ZORKM,938,0,0,0)              ! vanish zorkmid.
      RETURN
C
C V164--        Oil
C
64000 IF(PRSI.NE.PUTTY) GO TO 64100             ! with putty?
      IF(OBJACT(X)) RETURN                      ! object handle?
      CALL RSPEAK(904)                          ! doesn't work.
      RETURN
C
64100 CALL RSPEAK(905)                          ! joke.
      RETURN
C
C V165--        Play
C
65000 IF(PRSO.NE.STRAD) GO TO 65200             ! play violin?
      IF(PRSI.EQ.0) GO TO 65100                 ! with anything?
      IF((OFLAG2(PRSI).AND.WEAPBT).EQ.0) GO TO 65100
      OTVAL(STRAD)=0                            ! with weapon, ruined.
      CALL RSPEAK(933)
      RETURN
C
65100 CALL RSPEAK(934)                          ! offensive noise.
      RETURN
C
65200 IF((OFLAG2(PRSO).AND.VILLBT).EQ.0) GO TO 10 ! play villain?
      CALL RSPSUB(935,ODO2)                     ! you're dead.
      CALL JIGSUP(0)
      RETURN
C
C V166--        Send
C
66000 IF(OBJACT(X)) RETURN                      ! object handle?
      I=940                                     ! can't do it.
      IF((OFLAG2(PRSO).AND.VILLBT).NE.0) I=941  ! why do it?
      CALL RSPSUB(I,ODO2)
      RETURN

C VAPPLI, PAGE 15
C
C V167--        Enter
C
67000 PRSA=WALKW                                ! treat as walk.
      PRSO=XENTER
      GO TO 42000
C
C V168--        Leave
C
68000 PRSA=WALKW                                ! treat as walk.
      PRSO=XEXIT
      GO TO 42000
C
C V65-- Room
C
65001 VAPPLI=RMDESC(2)                          ! describe room only.
      RETURN
C
C V66-- Objects
C
66001 VAPPLI=RMDESC(1)                          ! describe obj only.
      IF(.NOT.TELFLG) CALL RSPEAK(138)          ! no objects.
      RETURN
C
C V67-- Rname
C
67001 CALL RSPEAK(RDESC2-HERE)                  ! short room name.
      RETURN
C
C V68-- Squeeze
C
68001 IF(OBJACT(X)) RETURN                      ! object handle?
      I=901                                     ! can't.
      IF((OFLAG2(PRSO).AND.VILLBT).NE.0) I=902  ! don't understand.
      CALL RSPSUB(I,ODO2)
      RETURN
C
C V69-- Smell
C
69001 CALL RSPSUB(903,ODO2)                     ! joke.
      RETURN

C VAPPLI, PAGE 16
C
C V70-- Brief
C
70000 BRIEFF=.TRUE.                             ! brief descriptions.
      SUPERF=.FALSE.
      CALL RSPEAK(326)
      RETURN
C
C V71-- Verbose
C
71000 BRIEFF=.FALSE.                            ! long descriptions.
      SUPERF=.FALSE.
      CALL RSPEAK(327)
      RETURN
C
C V72-- Superbrief
C
72000 SUPERF=.TRUE.
      CALL RSPEAK(328)
      RETURN
C
C V73-- Stay (used in endgame)
C
73000 IF(WINNER.NE.AMASTR) GO TO 73100          ! tell master, stay.
      CALL RSPEAK(781)                          ! he does.
      CTICK(CEVFOL)=0                           ! not following.
      RETURN
C
73100 IF(WINNER.EQ.PLAYER) CALL RSPEAK(664)     ! joke.
      RETURN
C
C V74-- Version
C
74000 WRITE(OUTCH,74010) VMAJ,VMIN,VEDIT
74010 FORMAT(' V',I1,'.',I1,A)
      TELFLG=.TRUE.
      RETURN
C
C V75-- Swim
C
75000 I=330                                     ! assume water.
      IF((RFLAG(HERE).AND.(RWATER+RFILL)).EQ.0)
     1I=331+RND(3)                              ! if no water, joke.
      CALL RSPEAK(I)
      RETURN
C
C V76-- Geronimo
C
76000 IF(AVEHIC(WINNER).EQ.BARRE) GO TO 76100   ! in barrel?
      CALL RSPEAK(334)                          ! no, joke.
      RETURN
C
76100 CALL JIGSUP(335)                          ! over falls.
      RETURN
C
C V77-- Sinbad et al
C
77000 IF((HERE.EQ.MCYCL).AND.(OROOM(CYCLO).EQ.HERE)) GO TO 77100
      CALL RSPEAK(336)                          ! not here, joke.
      RETURN
C
77100 CALL NEWSTA(CYCLO,337,0,0,0)              ! cyclops flees.
      CYCLOF=.TRUE.                             ! set all flags.
      MAGICF=.TRUE.
      OFLAG2(CYCLO)=OFLAG2(CYCLO).AND. .NOT.FITEBT
      RETURN
C
C V78-- unused
C
78000 GO TO 10
C
C V79-- Pray
c
79000 IF(HERE.NE.TEMP2) GO TO 79050             ! in temple?
      IF(MOVETO(FORE1,WINNER)) GO TO 79100      ! fore1 still there?
79050 CALL RSPEAK(340)                          ! joke.
      RETURN
C
79100 F=RMDESC(3)                               ! moved, describe.
      RETURN
C
C V80-- Treasure
c
80000 IF(HERE.NE.TEMP1) GO TO 80050             ! in temple?
      IF(MOVETO(TREAS,WINNER)) GO TO 79100      ! treasure room there?
80050 CALL RSPEAK(341)                          ! nothing happens.
      RETURN
C
C V81-- Temple
c
81000 IF(HERE.NE.TREAS) GO TO 81050             ! in treasure?
      IF(MOVETO(TEMP1,WINNER)) GO TO 79100      ! temp1 still there?
81050 CALL RSPEAK(341)                          ! nothing happens.
      RETURN
C
C V82-- Blast
C
82000 I=342                                     ! dont understand.
      IF(PRSO.EQ.SAFE) I=252                    ! joke for safe.
      CALL RSPEAK(I)
      RETURN
C
C V83-- Score
C
83000 CALL SCORE(.FALSE.)
      RETURN
C
C V84-- Quit
C
84000 CALL SCORE(.TRUE.)                        ! tell score.
      IF(.NOT.YESNO(343,10,0)) RETURN           ! ask for y/n decision.
      STOP ' '                                 ! bye.

C VAPPLI, PAGE 17
C
C V85-- Follow (used in endgame)
C
85000 IF(WINNER.NE.AMASTR) GO TO 85100          ! tell master, follow.
      CALL RSPEAK(782)
      CFLAG(CEVFOL)=.TRUE.
      CTICK(CEVFOL)=-1                          ! starts following.
      RETURN
C
85100 I=10                                      ! assume ok.
      IF(PRSO.EQ.0) GO TO 85200                 ! any object?
      I=964                                     ! joke 1
      IF((OFLAG2(PRSO).AND.VILLBT).NE.0) I=965  ! joke 2.
85200 CALL RSPEAK(I)
      RETURN
C
C V86-- Walk through
C
86000 IF(OBJACT(X)) RETURN                      ! object handle?
      IF((SCOLRM.EQ.0).OR.((PRSO.NE.SCOL).AND.
     1((PRSO.NE.WNORT).OR.(HERE.NE.BKBOX)))) GO TO 86100
      SCOLAC=SCOLRM                             ! walked thru scol.
      PRSO=0                                    ! fake out fromdr.
      CFLAG(CEVSCL)=.TRUE.
      CTICK(CEVSCL)=6                           ! start alarm.
      CALL RSPEAK(668)                          ! disorient him.
      F=MOVETO(SCOLRM,WINNER)                   ! into room.
      F=RMDESC(0)                               ! describe.
      RETURN
C
86100 IF(HERE.NE.SCOLAC) GO TO 86300            ! on other side of scol?
      DO 86200 I=1,12,3                         ! walk thru proper wall?
        IF((SCOLWL(I).EQ.HERE).AND.(SCOLWL(I+1).EQ.PRSO))
     1GO TO 86500                               ! in specified room?
86200 CONTINUE
C
86300 IF((OFLAG1(PRSO).AND.TAKEBT).NE.0) GO TO 86400 ! tkble?
      I=669                                     ! no, joke.
      IF(PRSO.EQ.SCOL) I=670                    ! special joke for scol.
      CALL RSPSUB(I,ODO2)
      RETURN
C
86400 I=671                                     ! joke.
      IF(OROOM(PRSO).NE.0) I=552+RND(6)         ! special jokes if carry.
      CALL RSPEAK(I)
      RETURN
C
86500 PRSO=SCOLWL(I+2)                          ! thru scol wall...
      DO 86600 I=1,8,2                          ! find matching room.
        IF(PRSO.EQ.SCOLDR(I)) SCOLRM=SCOLDR(I+1)
86600 CONTINUE                                  ! declare new scolrm.
      CTICK(CEVSCL)=0                           ! cancel alarm.
      CALL RSPEAK(668)                          ! disorient him.
      F=MOVETO(BKBOX,WINNER)                    ! back in box room.
      F=RMDESC(0)
      RETURN
C
C V87-- Ring
C
87000 IF(OBJACT(X)) RETURN                      ! object handle?
      I=359                                     ! cant ring.
      IF(PRSO.EQ.BELL) I=360                    ! ding, dong.
      CALL RSPEAK(I)                            ! joke.
      RETURN
C
C V88-- Brush
C
88000 IF(PRSO.EQ.TEETH) GO TO 88100             ! brush teeth?
      CALL RSPEAK(362)                          ! no, joke.
      RETURN
C
88100 IF(PRSI.NE.0) GO TO 88200                 ! with something?
      CALL RSPEAK(363)                          ! no, joke.
      RETURN
C
88200 IF((PRSI.EQ.PUTTY).AND.(OADV(PUTTY).EQ.WINNER))
     1GO TO 88300                               ! with putty?
      CALL RSPSUB(364,ODI2)                     ! no, joke.
      RETURN
C
88300 CALL JIGSUP(365)                          ! yes, dead!!!!!
      RETURN

C VAPPLI, PAGE 18
C
C V89-- Dig
C
89000 IF(PRSI.NE.SHOVE) GO TO 89100             ! shovel?
      VAPPLI=OBJACT(X)                          ! must handle.
      RETURN
C
89100 I=392                                     ! assume tool.
      IF((OFLAG1(PRSI).AND.TOOLBT).EQ.0) I=393
      CALL RSPSUB(I,ODI2)
      RETURN
C
C V90-- Time
C
90000 CALL GTTIME(K)                            ! get play time.
      I=K/60
      J=MOD(K,60)
      WRITE(OUTCH,90010)
      IF(I.NE.0) WRITE(OUTCH,90011) I
      IF(I.GE.2) WRITE(OUTCH,90012)
      IF(I.EQ.1) WRITE(OUTCH,90013)
      IF(J.EQ.1) WRITE(OUTCH,90014) J
      IF(J.NE.1) WRITE(OUTCH,90015) J
      TELFLG=.TRUE.
      RETURN
C
90010 FORMAT(' You have been playing Dungeon for ',$)
90011 FORMAT('+',I3,' hour',$)
90012 FORMAT('+s and ',$)
90013 FORMAT('+ and ',$)
90014 FORMAT('+',I2,' minute.')
90015 FORMAT('+',I2,' minutes.')
C
C V91-- Leap
C
91000 IF(PRSO.EQ.0) GO TO 91200                 ! over something?
      IF(QHERE(PRSO,HERE)) GO TO 91100          ! here?
      CALL RSPEAK(447)                          ! no, joke.
      RETURN
C
91100 IF((OFLAG2(PRSO).AND.VILLBT).EQ.0) GO TO 91300
      CALL RSPSUB(448,ODO2)                     ! cant jump villain.
      RETURN
C
91200 IF(.NOT.FINDXT(XDOWN,HERE)) GO TO 91300   ! down exit?
      IF(XTYPE.EQ.XNO) GO TO 91400              ! invalid?
      IF(XTYPE.NE.XCOND) GO TO 91300            ! conditional?
      IF(.NOT.FLAGS(XFLAG)) GO TO 91400         ! blocked off?
91300 CALL RSPEAK(314+RND(5))                   ! wheeee!
      RETURN
C
91400 IF(WINNER.EQ.PLAYER) GO TO 91500          ! tell x, jump?
      CALL JIGSUP(452)                          ! Geronimo!
      RETURN
C
91500 CALL JIGSUP(449+RND(4))                   ! fatal leap.
      RETURN

C VAPPLI, PAGE 19
C
C V92-- Lock
C
92000 IF(OBJACT(X)) RETURN                      ! object handle?
      IF((PRSO.EQ.GRATE).AND..NOT.QOPEN(GRATE).AND.(HERE.EQ.MGRAT))
     1GO TO 92200                               ! lock closed grate?
92100 CALL RSPEAK(464)                          ! not lock grate.
      RETURN
C
92200 GRUNLF=.FALSE.                            ! grate now locked.
      CALL RSPEAK(214)
      TRAVEL(REXIT(HERE)+1)=214                 ! change exit status.
      RETURN
C
C V93-- Unlock
C
93000 IF(OBJACT(X)) RETURN                      ! object handle?
      IF((PRSO.NE.GRATE).OR.(HERE.NE.MGRAT))
     1GO TO 92100                               ! not unlock grate.
      IF(PRSI.EQ.KEYS) GO TO 93200              ! got keys?
      CALL RSPSUB(465,ODI2)                     ! no, joke.
      RETURN
C
93200 GRUNLF=.TRUE.                             ! unlock grate.
      CALL RSPEAK(217)
      TRAVEL(REXIT(HERE)+1)=1041                ! change exit status.
      RETURN
C
C V94-- Diagnose
C
94000 I=FIGHTS(WINNER,.FALSE.)                  ! get fights strength.
      J=ASTREN(WINNER)                          ! get health.
      K=MIN0(I+J,4)                             ! get state.
      IF(.NOT.CFLAG(CEVCUR)) J=0                ! if no wounds.
      L=MIN0(4,IABS(J))                         ! scale.
      CALL RSPEAK(473+L)                        ! describe health.
      I=(30*(-J-1))+CTICK(CEVCUR)               ! compute wait.
      IF(J.NE.0) WRITE(OUTCH,94100) I
94100 FORMAT(' You will be cured after ',I3,' moves.')
      CALL RSPEAK(478+K)                        ! how much more?
      IF(DEATHS.NE.0) CALL RSPEAK(482+DEATHS)   ! how many deaths?
      RETURN

C VAPPLI, PAGE 20
C
C V95-- Incant
C
95000 IF(WINNER.NE.PLAYER) GO TO 10             ! must do yourself.
      IF((RFLAG(MREYE).AND.RSEEN).NE.0) GO TO 95800 ! too late?
      IF(SUBLNT.EQ.0) GO TO 95350               ! any input?
      PW(1)=' '                                 ! set up parse.
      PW(2)=' '
      WP=1
      CP=1
      DO 95200 I=1,SUBLNT                       ! scan substring
        IF(SUBBUF(I:I).NE.' ') GO TO 95150      ! blank?
        IF(CP.EQ.1) GO TO 95200                 ! anything in word yet?
        WP=MIN0(2,WP+1)                         ! advance word pointer.
        CP=1                                    ! reset char pointer.
        GO TO 95200
95150   IF(CP.LE.WRDLNT) PW(WP)(CP:CP)=SUBBUF(I:I) ! add char to word.
        CP=CP+1
95200 CONTINUE
C
      IF(PW(1).NE.' ') GO TO 95400              ! any input?
95350 CALL RSPEAK(856)                          ! no, ho hum.
95375 PRSCON=0                                  ! kill cmd stream.
      RETURN
C
95400 CALL ENCRYP(PW(1),CH)                     ! compute response.
      IF(PW(2).NE.' ') GO TO 95600              ! two phrases?
C
      IF(SPELLF) GO TO 95550                    ! he's trying to learn.
      IF((RFLAG(TSTRS).AND.RSEEN).EQ.0) GO TO 95575 ! really in end game?
      SPELLF=.TRUE.                             ! tell him.
      TELFLG=.TRUE.
      WRITE(OUTCH,95510) PW(1)(1:NBLEN(PW(1))),CH
95510 FORMAT(' A hollow voice replies: "',A,1X,A,'".')
      RETURN
C
95550 CALL RSPEAK(857)                          ! he's got one already.
      GO TO 95375
C
95575 CALL RSPEAK(858)                          ! he's not in endgame.
      GO TO 95375
C
95600 CALL ENCRYP(PW(2),CH2)                    ! try both ways.
      IF(SPELLF.OR.((PW(1).NE.CH2).AND.(PW(2).NE.CH)))
     1 GO TO 95900                              ! wrong or second use.
      SPELLF=.TRUE.                             ! it works.
      CALL RSPEAK(859)
      CFLAG(CEVSTE)=.TRUE.
      CTICK(CEVSTE)=1                           ! force start.
      RETURN
C
95800 CALL RSPEAK(855)                          ! too late.
      GO TO 95375
C
95900 CALL RSPEAK(1052)                         ! got it wrong.
      GO TO 95375

C VAPPLI, PAGE 21
C
C V96-- Answer
C
96000 IF(WINNER.NE.PLAYER) GO TO 10             ! must answer for himself.
      IF(SUBLNT.EQ.0) GO TO 96050               ! any substring?
      IF((HERE.EQ.RIDDL).AND..NOT.RIDDLF) GO TO 96700 ! riddle room?
      IF(HERE.EQ.FDOOR) GO TO 96100             ! end game front door?
96050 CALL RSPEAK(799)                          ! no one listens.
      PRSCON=0                                  ! kill cmd stream.
      RETURN
C
96100 IF(INQSTF.AND.(NQATT.LT.5).AND.(CORRCT.LT.3))
     1GO TO 96200                               ! knocked, didn't lose or win?
      CALL RSPEAK(783)                          ! no reply.
      PRSCON=0                                  ! kill cmd stream.
      RETURN
C
96200 DO 96300 J=1,NUMANS                       ! check answers.
        IF(QUESNO.NE.ANSWER(J)) GO TO 96300     ! only check proper ans.
        IF(SUBBUF.EQ.ANSSTR(J)(1:NBLEN(ANSSTR(J)))) GO TO 96500
96300 CONTINUE
C
      PRSCON=0                                  ! kill cmd stream.
      NQATT=NQATT+1                             ! wrong, cretin.
      IF(NQATT.GE.5) GO TO 96400                ! too many wrong?
      CALL RSPEAK(800+NQATT)                    ! no, try again.
      RETURN
C
96400 CALL RSPEAK(826)                          ! all over.
      CFLAG(CEVINQ)=.FALSE.                     ! lose.
      RETURN
C
96500 CORRCT=CORRCT+1                           ! got it right.
      CALL RSPEAK(800)                          ! hooray.
      IF(CORRCT.GE.3) GO TO 96600               ! won totally?
      CFLAG(CEVINQ)=.TRUE.
      CTICK(CEVINQ)=2                           ! no, start again.
      QUESNO=MOD(QUESNO+3,8)
      NQATT=0
      CALL RSPEAK(769)                          ! ask next question.
      CALL RSPEAK(770+QUESNO)
      RETURN
C
96600 CALL RSPEAK(827)                          ! quiz over,
      CFLAG(CEVINQ)=.FALSE.
      OFLAG2(QDOOR)=OFLAG2(QDOOR).OR.OPENBT     ! open door.
      RETURN
C
96700 IF(SUBBUF.NE.'WELL') GO TO 96050          ! right answer?
      RIDDLF=.TRUE.                             ! solved riddle.
      CALL RSPEAK(338)
      RETURN

C V97-- Count (valuables, possessions in VALUAC)
C
97000 IF(PRSO.NE.MATCH) GO TO 97100             ! matches?
      IF(ORMTCH.EQ.1) WRITE(OUTCH,97010) ORMTCH ! print number.
      IF(ORMTCH.NE.1) WRITE(OUTCH,97020) ORMTCH
97010 FORMAT(' You have ',I1,' match.')
97020 FORMAT(' You have ',I1,' matches.')
      TELFLG=.TRUE.
      RETURN
C
97100 I=1062                                    ! default.
      IF(PRSO.EQ.BAGCO) I=561                   ! bag of coins.
      IF(PRSO.EQ.CANDL) I=1058                  ! candles.
      IF(PRSO.EQ.BILLS) I=1059                  ! stack of bills.
      IF(PRSO.EQ.LEAVE) I=1060                  ! pile of leaves.
      IF(PRSO.EQ.GWISH) I=1061                  ! blessings.
      IF(PRSO.EQ.HEADS) I=1084                  ! heads.
      CALL RSPEAK(I)                            ! print response.
      RETURN
C
      END

C TAKE-- Basic take sequence
C
C Take an object (for verbs take, put, drop, read, etc.)
C
      LOGICAL FUNCTION TAKE(FLG)
C
C Declarations
C
      IMPLICIT INTEGER (A-Z)
      LOGICAL FLG,OBJACT,OAPPLI,QHERE
      INCLUDE 'dparam.for'

C TAKE, PAGE 2
C
      IF((PRSO.LE.STRBIT).AND.
     1((OFLAG2(PRSO).AND.NOCHBT).EQ.0)) GO TO 100 ! star or nocheck?
      TAKE=OBJACT(X)                            ! yes, let it handle.
      RETURN
C
100   TAKE=.FALSE.                              ! assume loses.
      X=OCAN(PRSO)                              ! inside?
      IF((PRSI.EQ.0).OR.(PRSI.EQ.X)) GO TO 200  ! take x from ocan(x)?
      CALL RSPEAK(1038)                         ! not in that.
      RETURN
C
200   IF(PRSO.NE.AVEHIC(WINNER)) GO TO 400      ! his vehicle?
      CALL RSPEAK(672)                          ! dummy.
      RETURN
C
400   IF((OFLAG1(PRSO).AND.TAKEBT).NE.0) GO TO 500 ! takeable?
      IF(.NOT.OAPPLI(OACTIO(PRSO),0)) CALL RSPEAK(552+RND(6))
      RETURN
C
C Object is takeable and in position to be taken.
C
500   IF((X.NE.0).OR. QHERE(PRSO,HERE)) GO TO 600
      I=103                                     ! assume player.
      IF(WINNER.NE.PLAYER) I=1080
      IF(OADV(PRSO).EQ.WINNER) CALL RSPEAK(I)   ! already got it?
      RETURN
C
600   IF(X.EQ.0) GO TO 650                      ! contained?
      IF(OADV(X).EQ.WINNER) GO TO 700           ! already carrying cont?
650   IF((WEIGHR(PRSO,WINNER)+OSIZE(PRSO)).LE.MXLOAD)
     2GO TO 700                                 ! can he carry?
      I=558                                     ! assume player.
      IF(WINNER.NE.PLAYER) I=1079
      CALL RSPEAK(I)                            ! too much weight.
      PRSCON=0                                  ! kill cmd stream.
      RETURN
C
700   TAKE=.TRUE.                               ! at last.
      IF(OAPPLI(OACTIO(PRSO),0)) RETURN         ! did it handle?
      CALL NEWSTA(PRSO,0,0,0,WINNER)            ! take object for winner.
      OFLAG2(PRSO)=OFLAG2(PRSO).OR.TCHBT        ! has been touched.
      CALL SCRUPD(OFVAL(PRSO))                  ! update score.
      OFVAL(PRSO)=0                             ! cant be scored again.
      IF(FLG) CALL RSPEAK(559)                  ! tell taken.
      RETURN
C
      END

C DROP- Drop verb processor (also throw, pour water)
C
C Declarations
C
      LOGICAL FUNCTION DROP(FLG)
      IMPLICIT INTEGER (A-Z)
      INCLUDE 'dparam.for'
      LOGICAL F,PUT,OBJACT,FLG
C
      IF((OFLAG2(PRSO).AND.NOCHBT).EQ.0) GO TO 100
      DROP=OBJACT(X)                            ! no check, let obj handle.
      RETURN
C
100   DROP=.TRUE.                               ! assume wins.
      X=OCAN(PRSO)                              ! get container.
      IF(X.EQ.0) GO TO 200                      ! is it inside?
      IF(OADV(X).NE.WINNER) GO TO 1000          ! is he carrying con?
      IF((OFLAG2(X).AND.OPENBT).NE.0) GO TO 300 ! is it open?
      CALL RSPSUB(525,ODESC2(X))                ! cant reach.
      RETURN
C
200   IF(OADV(PRSO).NE.WINNER) GO TO 1000       ! is he carrying obj?
300   IF(AVEHIC(WINNER).EQ.0) GO TO 400         ! is he in vehicle?
      PRSI=AVEHIC(WINNER)                       ! yes,
      F=PUT(.TRUE.)                             ! drop into vehicle.
      PRSI=0                                    ! disarm parser.
      RETURN                                    ! done.
C
400   CALL NEWSTA(PRSO,0,HERE,0,0)              ! drop into room.
      CALL SCRUPD(OFVAL(PRSO))                  ! score object.
      OFVAL(PRSO)=0                             ! cant be scored again.
      OFLAG2(PRSO)=OFLAG2(PRSO).OR.TCHBT        ! has been touched.
C
      IF(OBJACT(X)) RETURN                      ! did it handle?
      IF(PRSA.EQ.DROPW) CALL RSPEAK(528)
      IF(PRSA.EQ.THROWW) CALL RSPEAK(529)
      RETURN
C
1000  I=527                                     ! assume player.
      IF(WINNER.NE.PLAYER) I=1078
      CALL RSPEAK(I)                            ! dont have it.
      RETURN
C
      END

C PUT- Put verb processor
C
C Declarations
C
      LOGICAL FUNCTION PUT(FLG)
      IMPLICIT INTEGER (A-Z)
      INCLUDE 'dparam.for'
      LOGICAL QOPEN,QHERE,OBJACT,FLG,TAKE
C
C Functions and data
C
      QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0

C PUT, PAGE 2
C
      IF((OFLAG2(PRSO).AND.NOCHBT).EQ.0) GO TO 100
      PUT=OBJACT(X)                             ! no check, let obj handle.
      RETURN
C
100   PUT=.FALSE.
      IF((PRSO.LE.STRBIT).AND.(PRSI.LE.STRBIT)) GO TO 200
      IF(.NOT.OBJACT(X)) CALL RSPEAK(560)       ! star
      PUT=.TRUE.
      RETURN
C
200   IF(QOPEN(PRSI).OR.((OFLAG1(PRSI).AND.(DOORBT+CONTBT)).NE.0)
     1.OR.((OFLAG2(PRSI).AND.VEHBT).NE.0)) GO TO 300
      CALL RSPEAK(561)                          ! cant put in that.
      RETURN
C
300   IF(QOPEN(PRSI)) GO TO 400                 ! is it open?
      CALL RSPEAK(562)                          ! no, joke
      RETURN
C
400   IF(PRSO.NE.PRSI) GO TO 500                ! into itself?
      CALL RSPEAK(563)                          ! yes, joke.
      RETURN
C
500   IF(OCAN(PRSO).NE.PRSI) GO TO 600          ! already inside.
      CALL RSPSB2(564,ODESC2(PRSO),ODESC2(PRSI))
      PUT=.TRUE.
      RETURN
C
600   IF((WEIGHR(PRSO,0)+WEIGHR(PRSI,0)+OSIZE(PRSO))
     1.LE.OCAPAC(PRSI)) GO TO 700               ! not too full?
      IF(PRSI.NE.AVEHIC(WINNER)) GO TO 650      ! into vehicle?
      CALL RSPSUB(889,ODESC2(PRSI))             ! too full.
      RETURN
C
650   CALL RSPEAK(565)                          ! then cant do it.
      RETURN
C
C Now see if object (or its container) is in room
C
700   J=PRSO                                    ! start search.
725   IF(QHERE(J,HERE)) GO TO 750               ! is it here?
      J=OCAN(J)
      IF(J.NE.0) GO TO 725                      ! more to do?
      GO TO 800                                 ! no, sch fails.
C
750   IF((PRSO.EQ.WATER).OR.(PRSO.EQ.GWATE)) GO TO 800
      SVO=PRSO                                  ! save parser.
      SVI=PRSI
      PRSA=TAKEW
      PRSI=0
      IF(.NOT.TAKE(.FALSE.)) RETURN             ! take object.
      PRSA=PUTW
      PRSO=SVO
      PRSI=SVI
      GO TO 1000
C
C Now see if object is on person.
C
800   IF(OCAN(PRSO).EQ.0) GO TO 1000            ! inside?
      IF(QOPEN(OCAN(PRSO))) GO TO 900           ! open?
      CALL RSPSUB(566,ODESC2(PRSO))             ! lose.
      RETURN
C
900   CALL SCRUPD(OFVAL(PRSO))                  ! score object.
      OFVAL(PRSO)=0
      OFLAG2(PRSO)=OFLAG2(PRSO).OR.TCHBT        ! has been touched.
      CALL NEWSTA(PRSO,0,0,0,WINNER)            ! temporarily on winner.
C
1000  IF(OBJACT(X)) RETURN                      ! no, give object a shot.
      CALL NEWSTA(PRSO,2,0,PRSI,0)              ! contained inside.
      PUT=.TRUE.
      RETURN
C
      END

C VALUAC- Handles valuables/everything/possessions/bunch object
C         for take, put, drop, count
C
C Declarations
C
      SUBROUTINE VALUAC(V)
      IMPLICIT INTEGER (A-Z)
      INCLUDE 'dparam.for'
      LOGICAL LIT,F,F1,TAKE,PUT,DROP,NOTHIS,NOHERE,QHERE,QBUNCH
C
C Functions and data
C
      NOTHIS(R)=((SAVEP.EQ.BUNOBJ).AND.QBUNCH(R)) .OR.
     1  ((OTVAL(R).LE.0).AND.((SAVEP.EQ.VALUA).OR.
     2   ((SAVEP.EQ.BUNOBJ).AND.(BUNSUB.EQ.VALUA)))) .OR.
     3  ((OADV(R).NE.WINNER).AND.((SAVEP.EQ.POSSE).OR.
     4   ((SAVEP.EQ.BUNOBJ).AND.(BUNSUB.EQ.POSSE))))

      NOHERE(R)=((AV.EQ.0).AND..NOT.QHERE(R,HERE)) .OR.
     1  ((AV.NE.0).AND.(OCAN(R).NE.AV))

C VALUAC, PAGE 2
C Count
C
      IF((PRSA.NE.COUNTW).OR.(PRSO.NE.POSSE)) GO TO 100
      K=0
      DO 50 J=1,OLNT                            ! count possessions.
        IF(OADV(J).EQ.WINNER) K=K+1
50    CONTINUE
      IF(K.EQ.1) WRITE(OUTCH,60) K
      IF(K.NE.1) WRITE(OUTCH,70) K
60    FORMAT(' You have ',I1,' possession.')
70    FORMAT(' You have ',I2,' possessions.')
      TELFLG=.TRUE.
      RETURN
C
100   IF((PRSA.NE.COUNTW).OR.(PRSO.NE.VALUA)) GO TO 200
      K=0
      L=0
      DO 150 J=1,OLNT                           ! count treasures.
        IF((OADV(J).EQ.WINNER).AND.(OTVAL(J).GT.0)) K=K+1
        IF((OCAN(J).EQ.TCASE).AND.(OTVAL(J).GT.0)) L=L+1
150   CONTINUE
      IF(K.EQ.1) WRITE(OUTCH,160) K
      IF(K.NE.1) WRITE(OUTCH,170) K
160   FORMAT(' You have ',I1,' valuable.')
170   FORMAT(' You have ',I2,' valuables.')
      TELFLG=.TRUE.
      IF(HERE.NE.LROOM) RETURN
      IF(L.EQ.1) WRITE(OUTCH,180) L
      IF(L.NE.1) WRITE(OUTCH,190) L
180   FORMAT(' Your adventure has netted ',I1,' treasure.')
190   FORMAT(' Your adventure has netted ',I2,' treasures.')
      RETURN

C VALUAC, PAGE 3
C Take
C
200   SAVEP=PRSO                                ! save prso.
      SAVEH=HERE                                ! save here.
      F=.TRUE.                                  ! assume no actions.
      I=579                                     ! assume not lit.
      AV=AVEHIC(WINNER)                         ! get vehicle.
C
      IF(PRSA.NE.TAKEW) GO TO 1000              ! take?
      IF(.NOT.LIT(HERE)) GO TO 4500             ! if not lit, punt.
      IF((PRSO.NE.BUNOBJ).OR.(BUNSUB.NE.0)) GO TO 400 ! bunch, no except?
      DO 300 I=1,BUNLNT                         ! loop through bunch.
        PRSO=BUNVEC(I)                          ! get next item.
        F=.FALSE.
        CALL RSPSUB(580,ODESC2(PRSO))
        F1=TAKE(.TRUE.)
        IF(SAVEH.NE.HERE) GO TO 4500
300   CONTINUE
      GO TO 4000                                ! go clean up.
C
400   DO 500 PRSO=1,OLNT                        ! loop thru objects.
        IF((((OFLAG1(PRSO).AND.TAKEBT).EQ.0).AND.
     1((OFLAG2(PRSO).AND.TRYBT).EQ.0)).OR.
     2((OFLAG1(PRSO).AND.VISIBT).EQ.0).OR.
     3((OFLAG2(PRSO).AND.ACTRBT).NE.0).OR.
     4NOTHIS(PRSO)) GO TO 500
        IF(.NOT.NOHERE(PRSO)) GO TO 450         ! is it here?
        J=OCAN(PRSO)                            ! get container.
        IF((J.EQ.0).OR.(PRSO.EQ.WATER)) GO TO 500 ! in a cont?
        IF(((OFLAG2(J).AND.OPENBT).EQ.0).OR.
     1(NOHERE(J).AND.(OADV(J).NE.WINNER)))
     2GO TO 500                                 ! in open cont here?
C
450     F=.FALSE.
        CALL RSPSUB(580,ODESC2(PRSO))
        F1=TAKE(.TRUE.)
        IF(SAVEH.NE.HERE) GO TO 4500
500   CONTINUE
      GO TO 4000                                ! go clean up.

C VALUAC, PAGE 4
C Drop
C
1000  IF(PRSA.NE.DROPW) GO TO 2000              ! drop?
      IF((PRSO.NE.BUNOBJ).OR.(BUNSUB.NE.0)) GO TO 1400 ! bunch, no except?
      DO 1300 I=1,BUNLNT                        ! loop through bunch.
        PRSO=BUNVEC(I)                          ! get next item.
        F=.FALSE.
        CALL RSPSUB(580,ODESC2(PRSO))
        F1=DROP(.TRUE.)
        IF(SAVEH.NE.HERE) GO TO 4500
1300  CONTINUE
      GO TO 4000                                ! go clean up.
C
1400  DO 1500 PRSO=1,OLNT                       ! loop through inventory.
        IF((OADV(PRSO).NE.WINNER).OR.NOTHIS(PRSO))
     1GO TO 1500
        F=.FALSE.
        CALL RSPSUB(580,ODESC2(PRSO))
        F1=DROP(.TRUE.)
        IF(SAVEH.NE.HERE) GO TO 4500
1500  CONTINUE
      GO TO 4000                                ! go clean up.

C VALUAC, PAGE 5
C Put
C
2000  IF(PRSA.NE.PUTW) GO TO 3000               ! put?
      IF(.NOT.LIT(HERE)) GO TO 4500             ! if not lit, punt.
      IF((PRSO.NE.BUNOBJ).OR.(BUNSUB.NE.0)) GO TO 2400 ! bunch, no except?
      DO 2300 I=1,BUNLNT                        ! loop through bunch.
        PRSO=BUNVEC(I)                          ! get next item.
        F=.FALSE.
        CALL RSPSUB(580,ODESC2(PRSO))
        F1=PUT(.TRUE.)
        IF(SAVEH.NE.HERE) GO TO 4500
2300  CONTINUE
      GO TO 4000                                ! go clean up.
C
2400  DO 2500 PRSO=1,OLNT                       ! loop thru objects.
        IF(((OADV(PRSO).NE.WINNER).AND.
     1(NOHERE(PRSO).OR.
     2(((OFLAG1(PRSO).AND.TAKEBT).EQ.0).AND.
     3 ((OFLAG2(PRSO).AND.TRYBT).EQ.0)))) .OR.
     4(PRSO.EQ.PRSI).OR.NOTHIS(PRSO).OR.
     5((OFLAG1(PRSO).AND.VISIBT).EQ.0)) GO TO 2500
        F=.FALSE.
        CALL RSPSUB(580,ODESC2(PRSO))
        F1=PUT(.TRUE.)
        IF(SAVEH.NE.HERE) GO TO 4500
2500  CONTINUE
      GO TO 4000                                ! go clean up.
C
C Wrong verb.
C
3000  I=677                                     ! wrong verb.
      GO TO 4500
C
C Clean up.
C
4000  I=581                                     ! right verb, choose
      IF(SAVEP.EQ.VALUA) I=582                  ! nothing happened message.
4500  IF(F) CALL RSPEAK(I)                      ! not lit, nothing, wrong verb?
      PRSO=SAVEP                                ! restore PRSO.
      BUNSUB=0                                  ! cancel EXCEPT/BUT.
      RETURN
      END

C QBUNCH-       Is object in bunch vector?
C
C Declarations
C
      LOGICAL FUNCTION QBUNCH(OBJ)
      IMPLICIT INTEGER (A-Z)
      INCLUDE 'dparam.for'
C
      IF(BUNLNT.EQ.0) GO TO 200                 ! bunch vector empty?
      QBUNCH=.TRUE.                             ! assume found.
      DO 100 I=1,BUNLNT                         ! search bunch vector.
        IF(OBJ.EQ.BUNVEC(I)) RETURN             ! got one.
100   CONTINUE
200   QBUNCH=.FALSE.                            ! not found.
      RETURN
C
      END

C SAVE- Save game state
C
C Declarations
C
      SUBROUTINE SAVEGM
      IMPLICIT INTEGER (A-Z)
      INCLUDE 'dparam.for'
C
      IF(SUBLNT.EQ.0) SUBBUF='DSAVE.DAT'
      OPEN (UNIT=1,FILE=SUBBUF,ACCESS='SEQUENTIAL',
     1STATUS='UNKNOWN',FORM='UNFORMATTED',ERR=100)
C
      CALL GTTIME(I)                            ! get time.
      WRITE(1) VMAJ,VMIN
      WRITE(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
     1SWDACT,SWDSTA,CPVEC
      WRITE(1) I,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD,
     1LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC
      WRITE(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
     1OSIZE,OCAPAC,OROOM,OADV,OCAN
      WRITE(1) RDESC1,RVAL,RFLAG,TRAVEL
      WRITE(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
      WRITE(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK,CCNCEL
C
      CALL RSPEAK(597)
      CLOSE (UNIT=1)
      RETURN
C
100   CALL RSPEAK(598)                          ! cant do it.
      RETURN
      END

C RESTORE- Restore game state
C
C Declarations
C
      SUBROUTINE RSTRGM
      IMPLICIT INTEGER (A-Z)
      INCLUDE 'dparam.for'
C
      IF(SUBLNT.EQ.0) SUBBUF='DSAVE.DAT'
      OPEN (UNIT=1,FILE=SUBBUF,ACCESS='SEQUENTIAL',
     1STATUS='OLD',MODE='READ',FORM='UNFORMATTED',ERR=100)
C
      READ(1) I,J
      IF((I.NE.VMAJ).OR.(J.NE.VMIN)) GO TO 200
C
      READ(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
     1SWDACT,SWDSTA,CPVEC
      READ(1) PLTIME,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD,
     1LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC
      READ(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
     1OSIZE,OCAPAC,OROOM,OADV,OCAN
      READ(1) RDESC1,RVAL,RFLAG,TRAVEL
      READ(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
      READ(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK,CCNCEL
C
      CALL RSPEAK(599)
      CLOSE (UNIT=1)
      RETURN
C
100   CALL RSPEAK(598)                          ! cant do it.
      RETURN
C
200   CALL RSPEAK(600)                          ! obsolete version
      CLOSE (UNIT=1)
      RETURN
      END

C WALK- Move in specified direction
C
C Declarations
C
      LOGICAL FUNCTION WALK(X)
      IMPLICIT INTEGER (A-Z)
      INCLUDE 'dparam.for'
      LOGICAL FINDXT,QOPEN,LIT,PROB,MOVETO,RMDESC
C
C Functions and data
C
      QOPEN(O)=(OFLAG2(O).AND.OPENBT).NE.0

C WALK, PAGE 2
C
      WALK=.TRUE.                               ! assume wins.
      IF((WINNER.NE.PLAYER).OR.LIT(HERE).OR.PROB(25,25))
     1GO TO 500
      IF(.NOT.FINDXT(PRSO,HERE)) GO TO 450      ! invalid exit? grue!
      GO TO (400,200,100,300),XTYPE             ! decode exit type.
      CALL BUG(9,XTYPE)
C
100   IF(CXAPPL(XACTIO).NE.0) GO TO 400         ! cexit... returned room?
      IF(FLAGS(XFLAG)) GO TO 400                ! no, flag on?
200   CALL JIGSUP(523)                          ! bad exit, grue!
      RETURN
C
300   IF(CXAPPL(XACTIO).NE.0) GO TO 400         ! door... returned room?
      IF(QOPEN(XOBJ)) GO TO 400                 ! no, door open?
      CALL JIGSUP(523)                          ! bad exit, grue!
      RETURN
C
400   IF(LIT(XROOM1)) GO TO 900                 ! valid room, is it lit?
450   CALL JIGSUP(522)                          ! no, grue!
      RETURN
C
C Room is lit, or winner is not player (no grue).
C
500   IF(FINDXT(PRSO,HERE)) GO TO 550           ! exit exist?
525   XSTRNG=678                                ! assume wall.
      IF(PRSO.EQ.XUP) XSTRNG=679                ! if up, cant.
      IF(PRSO.EQ.XDOWN) XSTRNG=680              ! if down, cant.
      IF(((RFLAG(HERE).AND.RNWALL).NE.0).AND.(WINNER.EQ.PLAYER))
     1XSTRNG=524                                ! no wall for player.
      CALL RSPEAK(XSTRNG)
      PRSCON=0                                  ! stop cmd stream.
      RETURN
C
550   GO TO (900,600,700,800),XTYPE             ! branch on exit type.
      CALL BUG(9,XTYPE)
C
700   IF(CXAPPL(XACTIO).NE.0) GO TO 900         ! cexit... returned room?
      IF(FLAGS(XFLAG)) GO TO 900                ! no, flag on?
600   IF(XSTRNG.EQ.0) GO TO 525                 ! if no reason, use std.
      CALL RSPEAK(XSTRNG)                       ! deny exit.
      PRSCON=0                                  ! stop cmd stream.
      RETURN
C
800   IF(CXAPPL(XACTIO).NE.0) GO TO 900         ! door... returned room?
      IF(QOPEN(XOBJ)) GO TO 900                 ! no, door open?
      IF(XSTRNG.EQ.0) XSTRNG=525                ! if no reason, use std.
      CALL RSPSUB(XSTRNG,ODESC2(XOBJ))
      PRSCON=0                                  ! stop cmd stream.
      RETURN
C
900   WALK=MOVETO(XROOM1,WINNER)                ! move to room.
      IF(WALK) WALK=RMDESC(0)                   ! describe room.
      RETURN
      END

C CXAPPL- Conditional exit processors
C
C Declarations
C
      INTEGER FUNCTION CXAPPL(RI)
      IMPLICIT INTEGER (A-Z)
      INCLUDE 'dparam.for'
C
      CXAPPL=0                                  ! no return.
      IF(RI.EQ.0) RETURN                        ! if no action, done.
      GO TO (1000,2000,3000,4000,5000,6000,7000,8000,
     19000,10000,11000,12000,13000,14000,15000),RI
      CALL BUG(5,RI)

C CXAPPL, PAGE 2
C
C C1-   Coffin-cure
C
1000  EGYPTF=OADV(COFFI).NE.WINNER              ! t if no coffin.
      RETURN
C
C C2-   Carousel exit
C C5-   Carousel out
C
2000  IF(CAROFF) RETURN                         ! if flipped, nothing.
2500  CALL RSPEAK(121)                          ! can't tell directions.
5000  I=XELNT(XCOND)*RND(8)                     ! choose random exit.
      XROOM1=(TRAVEL(REXIT(HERE)+I)).AND.XRMASK
      CXAPPL=XROOM1                             ! return exit.
      RETURN
C
C C3-   Chimney function
C
3000  LITLDF=.FALSE.                            ! assume heavy load.
      IF(DEADF) GO TO 3300                      ! if dead, always ok.
      J=0
      DO 3100 I=1,OLNT                          ! count objects.
        IF(OADV(I).EQ.WINNER) J=J+1
3100  CONTINUE
C
      IF(J.GT.2) RETURN                         ! carrying too much?
      IF(J.NE.0) GO TO 3200                     ! carrying too little?
      XSTRNG=890                                ! bad idea.
      RETURN
C
3200  IF(OADV(LAMP).EQ.WINNER) GO TO 3300       ! no lamp?
      XSTRNG=446                                ! bad idea.
      RETURN
C
3300  LITLDF=.TRUE.                             ! he can do it.
      IF((OFLAG2(DOOR).AND.OPENBT).EQ.0)
     1OFLAG2(DOOR)=OFLAG2(DOOR).AND. .NOT.TCHBT
      RETURN
C
C C4-   Frobozz flag (Magnet Room, fake exit)
C C6-   Frobozz flag (Magnet Room, real exit)
C
4000  IF(CAROFF) GO TO 2500                     ! if flipped, go spin.
      FROBZF=.FALSE.                            ! otherwise, not an exit.
      RETURN
C
6000  IF(CAROFF) GO TO 2500                     ! if flipped, go spin.
      FROBZF=.TRUE.                             ! otherwise, an exit.
      RETURN

C CXAPPL, PAGE 3
C
C C7-   Frobozz flag (bank alarm)
C
7000  FROBZF=.FALSE.                            ! assume fails.
      J=BILLS                                   ! check for bills.
7100  IF(OADV(J).EQ.WINNER) RETURN              ! winner's got it, fail.
      J=OCAN(J)                                 ! get container.
      IF(J.NE.0) GO TO 7100                     ! if inside, loop
      J=PORTR                                   ! check for portrait.
7200  IF(OADV(J).EQ.WINNER) RETURN              ! winner's got it, fail.
      J=OCAN(J)                                 ! get container.
      IF(J.NE.0) GO TO 7200                     ! if inside, loop
      FROBZF=.TRUE.                             ! wins.
      RETURN
C
C C8-   Frobozz flag (MRGO)
C
8000  FROBZF=.FALSE.                            ! assume cant move.
      IF(MLOC.NE.XROOM1) GO TO 8100             ! mirror in way?
      IF((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XSOUTH)) GO TO 8200
      IF(MOD(MDIR,180).NE.0) GO TO 8300         ! mirror must be n-s.
      XROOM1=((XROOM1-MRA)*2)+MRAE              ! calc east room.
      IF(PRSO.GT.XSOUTH) XROOM1=XROOM1+1        ! if sw/nw, calc west.
8100  CXAPPL=XROOM1
      RETURN
C
8200  XSTRNG=814                                ! assume struc blocks.
      IF(MOD(MDIR,180).EQ.0) RETURN             ! if mirror n-s, done.
8300  LDIR=MDIR                                 ! see which mirror.
      IF(PRSO.EQ.XSOUTH) LDIR=180
      XSTRNG=815                                ! mirror blocks.
      IF(((LDIR.GT.180).AND..NOT.MR1F).OR.
     1 ((LDIR.LT.180).AND..NOT.MR2F)) XSTRNG=816 ! mirror broken.
      RETURN
C
C C9-   Frobozz flag (MIRIN)
C
9000  IF(MRHERE(HERE).NE.1) GO TO 9100          ! mirror 1 here?
      IF(MR1F) XSTRNG=805                       ! see if broken.
      FROBZF=MROPNF                             ! enter if open.
      RETURN
C
9100  FROBZF=.FALSE.                            ! not here,
      XSTRNG=817                                ! lose.
      RETURN

C CXAPPL, PAGE 4
C
C C10-  Frobozz flag (mirror exit)
C
10000 FROBZF=.FALSE.                            ! assume cant.
      LDIR=((PRSO-XNORTH)/XNORTH)*45            ! xlate dir to degrees.
      IF(.NOT.MROPNF .OR.
     1((MOD(MDIR+270,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
     2GO TO 10200                               ! exit via mirror?
      XROOM1=((MLOC-MRA)*2)+MRAE+1-(MDIR/180)   ! assume e-w exit.
      IF(MOD(MDIR,180).EQ.0) GO TO 10100        ! if n-s, ok.
      XROOM1=MLOC+1                             ! assume n exit.
      IF(MDIR.GT.180) XROOM1=MLOC-1             ! if south.
10100 CXAPPL=XROOM1
      RETURN
C
10200 IF(.NOT.WDOPNF .OR.
     1((MOD(MDIR+180,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
     2RETURN                                    ! exit via open door?
      XROOM1=MLOC+1                             ! assume n.
      IF(MDIR.EQ.0) XROOM1=MLOC-1               ! if s.
      CALL RSPEAK(818)                          ! close door.
      WDOPNF=.FALSE.
      CXAPPL=XROOM1
      RETURN
C
C C11-  Maybe door.  Normal message is that door is closed.
C       But if LCELL.NE.4, door isn't there.
C
11000 IF(LCELL.NE.4) XSTRNG=678                 ! set up msg.
      RETURN
C
C C12-  Frobozz flag (Puzzle Room main entrance)
C
12000 CPHERE=10                                 ! set substate.
      FROBZF=CPVEC(CPHERE).EQ.0                 ! enter if not blocked.
      RETURN
C
C C13-  CPOUTF (Puzzle Room size entrance)
C
13000 CPHERE=52                                 ! set substate.
      RETURN

C CXAPPL, PAGE 5
C
C C14-  Frobozz flag (Puzzle Room transitions)
C
14000 FROBZF=.FALSE.                            ! asssume lose.
      IF(PRSO.NE.XUP) GO TO 14100               ! up?
      IF(CPHERE.NE.10) RETURN                   ! at exit?
      XSTRNG=881                                ! assume no ladder.
      IF(CPVEC(CPHERE+1).NE.-2) RETURN          ! ladder here?
      CALL RSPEAK(882)                          ! you win.
      RFLAG(CPUZZ)=RFLAG(CPUZZ).AND..NOT.RSEEN          ! reset seen.
      FROBZF=.TRUE.                             ! let him out.
      RETURN
C
14100 IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST).OR..NOT.CPOUTF)
     1GO TO 14200                               ! w exit at door?
      RFLAG(CPUZZ)=RFLAG(CPUZZ).AND..NOT.RSEEN          ! reset seen.
      FROBZF=.TRUE.                             ! yes, let him out.
      RETURN
C
14200 IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST)) GO TO 14250
      XSTRNG=932                                ! door in way.
      RETURN
C
14250 DO 14300 I=1,16,2                         ! locate exit.
        IF(PRSO.EQ.CPDR(I)) GO TO 14400
14300 CONTINUE
      RETURN                                    ! no such exit.
C
14400 J=CPDR(I+1)                               ! get directional offset.
      NXT=CPHERE+J                              ! get next state.
      K=8                                       ! get orthogonal dir.
      IF(J.LT.0) K=-8
      IF((((IABS(J).EQ.1).OR.(IABS(J).EQ.8)).OR.
     1  ((CPVEC(CPHERE+K).EQ.0).OR.(CPVEC(NXT-K).EQ.0))).AND.
     2   (CPVEC(NXT).EQ.0)) GO TO 14500         ! cant do it?
      RETURN
C
14500 CALL CPGOTO(NXT)                          ! move to state.
      XROOM1=CPUZZ                              ! stay in room.
      CXAPPL=XROOM1
      RETURN
C
C C15-  Frobozz flag (slide exit)
C
15000 FROBZF=.TRUE.                             ! works.
      IF((TTIE.EQ.0).OR.DEADF) RETURN           ! if no rope or dead, cellar.
      IF(OROOM(TTIE).NE.HERE) RETURN            ! if rope elsewhere, cellar.
      CALL RSPEAK(1014)                         ! slippery.
      CFLAG(CEVSLI)=.TRUE.                      ! turn on slide clock.
      CTICK(CEVSLI)=MAX0(2,100/WEIGHR(0,WINNER))
      XROOM1=SLID1                              ! on the ropes.
      CXAPPL=XROOM1
      RETURN
C
      END
