1 C CXAPPL- Conditional exit processors
  2 C
  3 C Declarations
  4 C
  5           INTEGER FUNCTION CXAPPL(RI)
  6           IMPLICIT INTEGER (A-Z)
  7           %include dparam
  8 C
  9           CXAPPL=0                                ! no return.
 10           IF(RI.EQ.0) RETURN                      ! if no action, done.
 11           GO TO (1000,2000,3000,4000,5000,6000,7000,8000,
 12           &         9000,10000,11000,12000,13000,14000,15000),RI
 13           CALL BUG(5,RI)
 14 C page
 15 C CXAPPL, PAGE 2
 16 C
 17 C C1-     Coffin-cure
 18 C
 19 1000      EGYPTF=OADV(COFFI).NE.WINNER            ! t if no coffin.
 20           RETURN
 21 C
 22 C C2-     Carousel exit
 23 C C5-     Carousel out
 24 C
 25 2000      IF(CAROFF) RETURN                       ! if flipped, nothing.
 26 2500      CALL RSPEAK(121)                        ! can't tell directions.
 27 5000      I=XELNT(XCOND)*RND(8)                             ! choose random exit.
 28 C old     XROOM1=(TRAVEL(REXIT(HERE)+I)).AND.XRMASK
 29           XROOM1=AND((TRAVEL(REXIT(HERE)+I)),XRMASK)
 30           CXAPPL=XROOM1                                     ! return exit.
 31           RETURN
 32 C
 33 C C3-     Chimney function
 34 C
 35 3000      LITLDF=.FALSE.                                    ! assume heavy load.
 36           IF(DEADF) GO TO 3300                              ! if dead, always ok.
 37           J=0
 38           DO 3100 I=1,OLNT                        ! count objects.
 39             IF(OADV(I).EQ.WINNER) J=J+1
 40 3100      CONTINUE
 41 C
 42           IF(J.GT.2) RETURN                       ! carrying too much?
 43           IF(J.NE.0) GO TO 3200                             ! carrying too little?
 44           XSTRNG=890                                        ! bad idea.
 45           RETURN
 46 C
 47 3200      IF(OADV(LAMP).EQ.WINNER) GO TO 3300     ! no lamp?
 48           XSTRNG=446                                        ! bad idea.
 49           RETURN
 50 C
 51 3300      LITLDF=.TRUE.                                     ! he can do it.
 52 C old     IF((OFLAG2(DOOR).AND.OPENBT).EQ.0)
 53 C old     &         OFLAG2(DOOR)=OFLAG2(DOOR).AND. .NOT.TCHBT
 54           IF(AND(OFLAG2(DOOR),OPENBT).EQ.0)
 55           &         OFLAG2(DOOR)=AND(OFLAG2(DOOR), COMPL(TCHBT))
 56           RETURN
 57 C
 58 C C4-     Frobozz flag (Magnet Room, fake exit)
 59 C C6-     Frobozz flag (Magnet Room, real exit)
 60 C
 61 4000      IF(CAROFF) GO TO 2500                             ! if flipped, go spin.
 62           FROBZF=.FALSE.                                    ! otherwise, not an exit.
 63           RETURN
 64 C
 65 6000      IF(CAROFF) GO TO 2500                             ! if flipped, go spin.
 66           FROBZF=.TRUE.                                     ! otherwise, an exit.
 67           RETURN
 68 C page
 69 C CXAPPL, PAGE 3
 70 C
 71 C C7-     Frobozz flag (bank alarm)
 72 C
 73 7000      FROBZF=.FALSE.                                    ! assume fails.
 74           J=BILLS                                           ! check for bills.
 75 7100      IF(OADV(J).EQ.WINNER) RETURN            ! winner's got it, fail.
 76           J=OCAN(J)                               ! get container.
 77           IF(J.NE.0) GO TO 7100                             ! if inside, loop
 78           J=PORTR                                           ! check for portrait.
 79 7200      IF(OADV(J).EQ.WINNER) RETURN            ! winner's got it, fail.
 80           J=OCAN(J)                               ! get container.
 81           IF(J.NE.0) GO TO 7200                             ! if inside, loop
 82           FROBZF=.TRUE.                                     ! wins.
 83           RETURN
 84 C
 85 C C8-     Frobozz flag (MRGO)
 86 C
 87 8000      FROBZF=.FALSE.                                    ! assume cant move.
 88           IF(MLOC.NE.XROOM1) GO TO 8100           ! mirror in way?
 89           IF((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XSOUTH)) GO TO 8200
 90           IF(MOD(MDIR,180).NE.0) GO TO 8300       ! mirror must be n-s.
 91           XROOM1=((XROOM1-MRA)*2)+MRAE            ! calc east room.
 92           IF(PRSO.GT.XSOUTH) XROOM1=XROOM1+1      ! if sw/nw, calc west.
 93 8100      CXAPPL=XROOM1
 94           RETURN
 95 C
 96 8200      XSTRNG=814                                        ! assume struc blocks.
 97           IF(MOD(MDIR,180).EQ.0) RETURN           ! if mirror n-s, done.
 98 8300      LDIR=MDIR                               ! see which mirror.
 99           IF(PRSO.EQ.XSOUTH) LDIR=180
100           XSTRNG=815                                        ! mirror blocks.
101           IF(((LDIR.GT.180).AND..NOT.MR1F).OR.
102           &  ((LDIR.LT.180).AND..NOT.MR2F)) XSTRNG=816 ! mirror broken.
103           RETURN
104 C
105 C C9-     Frobozz flag (MIRIN)
106 C
107 9000      IF(MRHERE(HERE).NE.1) GO TO 9100        ! mirror 1 here?
108           IF(MR1F) XSTRNG=805                     ! see if broken.
109           FROBZF=MROPNF                                     ! enter if open.
110           RETURN
111 C
112 9100      FROBZF=.FALSE.                                    ! not here,
113           XSTRNG=817                                        ! lose.
114           RETURN
115 C page
116 C CXAPPL, PAGE 4
117 C
118 C C10-    Frobozz flag (mirror exit)
119 C
120 10000     FROBZF=.FALSE.                                    ! assume cant.
121           LDIR=((PRSO-XNORTH)/XNORTH)*45                    ! xlate dir to degrees.
122           IF(.NOT.MROPNF .OR.
123           &         ((MOD(MDIR+270,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
124           &         GO TO 10200                             ! exit via mirror?
125           XROOM1=((MLOC-MRA)*2)+MRAE+1-(MDIR/180) ! assume e-w exit.
126           IF(MOD(MDIR,180).EQ.0) GO TO 10100      ! if n-s, ok.
127           XROOM1=MLOC+1                                     ! assume n exit.
128           IF(MDIR.GT.180) XROOM1=MLOC-1           ! if south.
129 10100     CXAPPL=XROOM1
130           RETURN
131 C
132 10200     IF(.NOT.WDOPNF .OR.
133           &         ((MOD(MDIR+180,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
134           &         RETURN                                  ! exit via open door?
135           XROOM1=MLOC+1                                     ! assume n.
136           IF(MDIR.EQ.0) XROOM1=MLOC-1             ! if s.
137           CALL RSPEAK(818)                        ! close door.
138           WDOPNF=.FALSE.
139           CXAPPL=XROOM1
140           RETURN
141 C
142 C C11-    Maybe door.  Normal message is that door is closed.
143 C         But if LCELL.NE.4, door isn't there.
144 C
145 11000     IF(LCELL.NE.4) XSTRNG=678               ! set up msg.
146           RETURN
147 C
148 C C12-    Frobozz flag (Puzzle Room main entrance)
149 C
150 12000     CPHERE=10                               ! set substate.
151           FROBZF=CPVEC(CPHERE).EQ.0               ! enter if not blocked.
152           RETURN
153 C
154 C C13-    CPOUTF (Puzzle Room size entrance)
155 C
156 13000     CPHERE=52                               ! set substate.
157           RETURN
158 C page
159 C CXAPPL, PAGE 5
160 C
161 C C14-    Frobozz flag (Puzzle Room transitions)
162 C
163 14000     FROBZF=.FALSE.                                    ! asssume lose.
164           IF(PRSO.NE.XUP) GO TO 14100             ! up?
165           IF(CPHERE.NE.10) RETURN                           ! at exit?
166           XSTRNG=881                                        ! assume no ladder.
167           IF(CPVEC(CPHERE+1).NE.-2) RETURN        ! ladder here?
168           CALL RSPEAK(882)                        ! you win.
169 C old     RFLAG(CPUZZ)=RFLAG(CPUZZ).AND..NOT.RSEEN          ! reset seen.
170           RFLAG(CPUZZ)=AND(RFLAG(CPUZZ),COMPL(RSEEN))       ! reset seen.
171           FROBZF=.TRUE.                                     ! let him out.
172           RETURN
173 C
174 14100     IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST).OR..NOT.CPOUTF)
175           &         GO TO 14200                             ! w exit at door?
176 C old     RFLAG(CPUZZ)=RFLAG(CPUZZ).AND..NOT.RSEEN          ! reset seen.
177           RFLAG(CPUZZ)=AND(RFLAG(CPUZZ),COMPL(RSEEN))       ! reset seen.
178           FROBZF=.TRUE.                                     ! yes, let him out.
179           RETURN
180 C
181 14200     IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST)) GO TO 14250
182           XSTRNG=932                                        ! door in way.
183           RETURN
184 C
185 14250     DO 14300 I=1,16,2                       ! locate exit.
186             IF(PRSO.EQ.CPDR(I)) GO TO 14400
187 14300     CONTINUE
188           RETURN                                            ! no such exit.
189 C
190 14400     J=CPDR(I+1)                                       ! get directional offset.
191           NXT=CPHERE+J                                      ! get next state.
192           K=8                                               ! get orthogonal dir.
193           IF(J.LT.0) K=-8
194           IF((((IABS(J).EQ.1).OR.(IABS(J).EQ.8)).OR.
195           &   ((CPVEC(CPHERE+K).EQ.0).OR.(CPVEC(NXT-K).EQ.0))).AND.
196           &    (CPVEC(NXT).EQ.0)) GO TO 14500     ! cant do it?
197           RETURN
198 C
199 14500     CALL CPGOTO(NXT)                        ! move to state.
200           XROOM1=CPUZZ                                      ! stay in room.
201           CXAPPL=XROOM1
202           RETURN
203 C
204 C C15-    Frobozz flag (slide exit)
205 C
206 15000     FROBZF=.TRUE.                                     ! works.
207           IF((TTIE.EQ.0).OR.DEADF) RETURN                   ! if no rope or dead, cellar.
208           IF(OROOM(TTIE).NE.HERE) RETURN                    ! if rope elsewhere, cellar.
209           CALL RSPEAK(1014)                       ! slippery.
210           CFLAG(CEVSLI)=.TRUE.                              ! turn on slide clock.
211           CTICK(CEVSLI)=MAX0(2,100/WEIGHR(0,WINNER))
212           XROOM1=SLID1                                      ! on the ropes.
213           CXAPPL=XROOM1
214           RETURN
215 C
216           END