1 C JIGSUP- You are dead
  2 C
  3 C Declarations
  4 C
  5           SUBROUTINE JIGSUP(DESC)
  6           IMPLICIT INTEGER (A-Z)
  7           %include dparam
  8           LOGICAL MOVETO,QHERE,F
  9           INTEGER RLIST(8)
 10 C
 11 C Functions and data
 12 C
 13           DATA RLIST/KITCH,CLEAR,FORE3,FORE2,SHOUS,FORE2,KITCH,EHOUS/
 14 C
 15           CALL RSPEAK(DESC)                       ! describe sad state.
 16           PRSCON=0                                ! stop parser.
 17           IF(DBGFLG.NE.0) RETURN                            ! if dbg, exit.
 18           AVEHIC(WINNER)=0                        ! get rid of vehicle.
 19           IF(WINNER.EQ.PLAYER) GO TO 10           ! himself?
 20           CALL RSPSUB(432,ODESC2(AOBJ(WINNER)))   ! no, say who died.
 21           CALL NEWSTA(AOBJ(WINNER),0,0,0,0)       ! send object to hyper space.
 22           AROOM(WINNER)=0                                   ! send actor to hyper space.
 23           RETURN
 24 C
 25 10        CALL SCRUPD(-10)                        ! charge 10 points.
 26           IF(ENDGMF) GO TO 900                              ! no recovery in end game.
 27           IF(DEATHS.GE.2) GO TO 1000              ! dead twice? kick him off.
 28           DEATHS=DEATHS+1                                   ! record deaths.
 29           DEADF=.TRUE.                                      ! flag dead player.
 30           I=8                                               ! normal message.
 31           IF(LLDF) I=1074                                   ! ghosts exorcised?
 32           CALL RSPEAK(I)                                    ! tell him bad news.
 33           AACTIO(PLAYER)=PLAYER                             ! turn on dead player func.
 34 C
 35           DO 50 J=1,OLNT                                    ! turn off fighting.
 36 C old       IF(QHERE(J,HERE)) OFLAG2(J)=OFLAG2(J).AND. .NOT.FITEBT
 37             IF(QHERE(J,HERE)) OFLAG2(J)=AND(OFLAG2(J), COMPL(FITEBT))
 38 50        CONTINUE
 39 C
 40           F=MOVETO(LLD1,WINNER)                             ! reposition him.
 41           EGYPTF=.TRUE.                                     ! restore coffin.
 42           IF(OADV(COFFI).EQ.WINNER) CALL NEWSTA(COFFI,0,EGYPT,0,0)
 43 C old     OFLAG2(DOOR)=OFLAG2(DOOR).AND. .NOT.TCHBT ! restore door.
 44           OFLAG2(DOOR)=AND(OFLAG2(DOOR), COMPL(TCHBT)) ! restore door.
 45 C old     OFLAG1(ROBOT)=(OFLAG1(ROBOT).OR.VISIBT) .AND. .NOT.NDSCBT
 46           OFLAG1(ROBOT)=AND(OR(OFLAG1(ROBOT),VISIBT), COMPL(NDSCBT))
 47           CALL NEWSTA(LAMP,0,LROOM,0,0)           ! lamp to living room,
 48 C old     OFLAG1(LAMP)=OFLAG1(LAMP).OR.VISIBT     ! visible
 49           OFLAG1(LAMP)=OR(OFLAG1(LAMP),VISIBT)    ! visible
 50           DO 100 I=1,CLNT                                   ! disable cevnts if needed.
 51             IF(CCNCEL(I)) CFLAG(I)=.FALSE.
 52 100       CONTINUE
 53 C page
 54 C JIGSUP, PAGE 2
 55 C
 56 C Now redistribute his valuables and other belongings.
 57 C
 58 C The lamp has been placed in the living room.
 59 C The first 8 non-valuables are placed in locations around the house.
 60 C His valuables are placed starting at Troll Room.
 61 C Remaining non-valuables are after that.
 62 C
 63           I=0
 64           DO 200 J=1,OLNT                                   ! loop thru objects.
 65             IF((OADV(J).NE.WINNER).OR.(OTVAL(J).NE.0))
 66           &         GO TO 200                     ! get his non-val objs.
 67             I=I+1
 68             IF(I.GT.8) GO TO 400                            ! move to random locations.
 69             CALL NEWSTA(J,0,RLIST(I),0,0)
 70 200       CONTINUE
 71 C
 72 400       I=MTROL                                           ! now move valuables.
 73           NONOFL=RAIR+RWATER+REND                           ! dont move here.
 74           DO 300 J=1,OLNT
 75             IF((OADV(J).NE.WINNER).OR.(OTVAL(J).EQ.0))
 76           &         GO TO 300                     ! on adv and valuable?
 77 250         I=I+1                                           ! find next room.
 78 C old       IF((RFLAG(I).AND.NONOFL).NE.0) GO TO 250        ! skip if nono.
 79             IF((AND(RFLAG(I),NONOFL)).NE.0) GO TO 250       ! skip if nono.
 80             CALL NEWSTA(J,0,I,0,0)                ! yes, move.
 81 300       CONTINUE
 82 C
 83           DO 500 J=1,OLNT                                   ! now get rid of remainder.
 84             IF(OADV(J).NE.WINNER) GO TO 500
 85 450         I=I+1                                           ! find next room.
 86 C old       IF((RFLAG(I).AND.NONOFL).NE.0) GO TO 450        ! skip if nono.
 87             IF((AND(RFLAG(I),NONOFL)).NE.0) GO TO 450       ! skip if nono.
 88             CALL NEWSTA(J,0,I,0,0)
 89 500       CONTINUE
 90           RETURN
 91 C
 92 C Cant or wont continue, clean up and exit.
 93 C
 94 900       CALL RSPEAK(625)                        ! in endgame, lose.
 95           GO TO 1100
 96 C
 97 1000      CALL RSPEAK(7)                                    ! involuntary exit.
 98 1100      CALL SCORE(.FALSE.)                     ! tell score.
 99           CALL EXIT
100 C
101           END
102 C page
103 C OACTOR- Get actor associated with object
104 C
105 C Declarations
106 C
107           INTEGER FUNCTION OACTOR(OBJ)
108           IMPLICIT INTEGER (A-Z)
109           %include dparam
110 C
111           DO 100 OACTOR=1,ALNT                              ! loop thru actors.
112             IF(AOBJ(OACTOR).EQ.OBJ) RETURN        ! found it?
113 100       CONTINUE
114           CALL BUG(40,OBJ)                        ! no, die.
115           RETURN
116 C
117           END
118 C page
119 C PROB-             Compute probability
120 C
121 C Declarations
122 C
123           LOGICAL FUNCTION PROB(G,B)
124           IMPLICIT INTEGER (A-Z)
125           %include dparam
126 C
127           I=G                                               ! assume good luck.
128           IF(BADLKF) I=B                                    ! if bad, too bad.
129           PROB=RND(100).LT.I                      ! compute.
130           RETURN
131 C
132           END
133 C page
134 C RMDESC-- Print room description
135 C
136 C RMDESC prints a description of the current room.
137 C It is also the processor for verbs 'LOOK' and 'EXAMINE'
138 C when there is no direct object.
139 C
140           LOGICAL FUNCTION RMDESC(FULL)
141 C
142 C FULL=   0/1/2/3=  full/obj/room/full but no applicable
143 C
144 C Declarations
145 C
146           IMPLICIT INTEGER (A-Z)
147           LOGICAL PROB,LIT
148           %include dparam
149 C
150           RMDESC=.TRUE.                                     ! assume wins.
151           RA=RACTIO(HERE)                                   ! get room action.
152           IF(PRSO.LT.XMIN) GO TO 50               ! if direction,
153           FROMDR=PRSO                                       ! save and
154           PRSO=0                                            ! clear.
155 50        IF(FULL.EQ.1) GO TO 600                           ! objects only?
156           IF(HERE.EQ.AROOM(PLAYER)) GO TO 100     ! player just move?
157           CALL RSPEAK(2)                                    ! no, just say done.
158           PRSA=WALKIW                                       ! set up walk in action.
159           RETURN
160 C
161 100       IF(LIT(HERE)) GO TO 300                           ! lit?
162           CALL RSPEAK(430)                        ! warn of grue.
163           RMDESC=.FALSE.
164           RETURN
165 C
166 300       I=RDESC2-HERE                                     ! assume short desc.
167 C old     IF((FULL.EQ.0)
168 C old     &         .AND. (SUPERF.OR.(((RFLAG(HERE).AND.RSEEN).NE.0)
169 C old     &         .AND. (BRIEFF.OR.PROB(80,80))))) GO TO 400
170           IF((FULL.EQ.0)
171           &         .AND. (SUPERF.OR.(((AND(RFLAG(HERE),RSEEN)).NE.0)
172           &         .AND. (BRIEFF.OR.PROB(80,80))))) GO TO 400
173           I=RDESC1(HERE)                                    ! use long.
174           IF((I.NE.0).OR.(RA.EQ.0)) GO TO 400     ! if got desc, skip.
175           PRSA=LOOKW                                        ! pretend look around.
176           PRSO=0                                            ! no object referenced.
177           CALL RAPPLI(RA)                                   ! let room handle.
178           PRSA=FOOW                               ! nop parser.
179           GO TO 500
180 C
181 400       CALL RSPEAK(I)                                    ! output description.
182 500       IF(AVEHIC(WINNER).NE.0) CALL RSPSUB(431,ODESC2(AVEHIC(WINNER)))
183 C old     RFLAG(HERE)=RFLAG(HERE).OR.RSEEN        ! indicate room seen.
184           RFLAG(HERE)=OR(RFLAG(HERE),RSEEN)       ! indicate room seen.
185 C
186 600       IF(LIT(HERE)) GO TO 700                           ! if lit, do objects
187           CALL RSPEAK(1036)                       ! can't see anything
188           RETURN
189 C
190 700       IF(FULL.NE.2) CALL PRINCR(FULL,HERE)    ! print room contents
191           IF((FULL.NE.0).OR.(RA.EQ.0)) RETURN     ! anything more?
192           PRSA=WALKIW                                       ! give him a surpise.
193           CALL RAPPLI(RA)                                   ! let room handle
194           PRSA=FOOW
195           RETURN
196 C
197           END
198 C page
199 C PRINCR- Print contents of room
200 C
201 C Declarations
202 C
203           SUBROUTINE PRINCR(FULL,RM)
204           IMPLICIT INTEGER (A-Z)
205           %include dparam
206           LOGICAL QEMPTY,QHERE
207 C
208           J=329                                             ! assume superbrief format.
209           DO 500 I=1,OLNT                                   ! loop on objects
210 C old       IF(.NOT.QHERE(I,RM).OR.((OFLAG1(I).AND.VISIBT).EQ.0).OR.
211 C old     &         (((OFLAG1(I).AND.NDSCBT).NE.0).AND.(FULL.NE.1)).OR.
212 C old     &         (I.EQ.AVEHIC(WINNER))) GO TO 500
213             IF(.NOT.QHERE(I,RM).OR.((AND(OFLAG1(I),VISIBT)).EQ.0).OR.
214           &         (((AND(OFLAG1(I),NDSCBT)).NE.0).AND.(FULL.NE.1)).OR.
215           &         (I.EQ.AVEHIC(WINNER))) GO TO 500
216 C old       IF((FULL.EQ.0).AND.(SUPERF.OR.(BRIEFF.AND.
217 C old     &         ((RFLAG(HERE).AND.RSEEN).NE.0)))) GO TO 200
218             IF((FULL.EQ.0).AND.(SUPERF.OR.(BRIEFF.AND.
219           &         ((AND(RFLAG(HERE),RSEEN)).NE.0)))) GO TO 200
220 C
221 C Do long description of object.
222 C
223             K=ODESCO(I)                                     ! get untouched.
224 C old       IF((K.EQ.0).OR.((OFLAG2(I).AND.TCHBT).NE.0)) K=ODESC1(I)
225             IF((K.EQ.0).OR.((AND(OFLAG2(I),TCHBT)).NE.0)) K=ODESC1(I)
226             IF((K.EQ.0).AND.(FULL.EQ.1)) CALL RSPSUB(936,ODESC2(I))
227             CALL RSPEAK(K)                        ! describe.
228             GO TO 500
229 C
230 C Do short description of object.
231 C
232 200         CALL RSPSUB(J,ODESC2(I))              ! you can see it.
233             J=502
234 C
235 500       CONTINUE
236 C
237 C Now loop to print contents of objects in room.
238 C
239           DO 1000 I=1,OLNT                        ! loop on objects.
240 C old       IF(.NOT.QHERE(I,RM).OR.((OFLAG1(I).AND.VISIBT).EQ.0).OR.
241 C old     &         (((OFLAG1(I).AND.NDSCBT).NE.0).AND.(FULL.NE.1)))
242 C old     &         GO TO 1000
243             IF(.NOT.QHERE(I,RM).OR.((AND(OFLAG1(I),VISIBT)).EQ.0).OR.
244           &         (((AND(OFLAG1(I),NDSCBT)).NE.0).AND.(FULL.NE.1)))
245           &         GO TO 1000
246 C old       IF((OFLAG2(I).AND.ACTRBT).NE.0) CALL INVENT(OACTOR(I))
247             IF((AND(OFLAG2(I),ACTRBT)).NE.0) CALL INVENT(OACTOR(I))
248 C old       IF((((OFLAG1(I).AND.TRANBT).EQ.0).AND.((OFLAG2(I).AND.OPENBT)
249 C old     &         .EQ.0)).OR.QEMPTY(I)) GO TO 1000
250             IF((((AND(OFLAG1(I),TRANBT)).EQ.0).AND.((AND(OFLAG2(I),OPENBT))
251           &         .EQ.0)).OR.QEMPTY(I)) GO TO 1000
252 C
253 C Object is not empty and is open or transparent.
254 C
255             IF(I.NE.TCASE) GO TO 600              ! trophy case?
256             IF((.NOT.(BRIEFF.OR.SUPERF)).OR.(FULL.EQ.1))
257           &         CALL PRINCO(I,1053,.FALSE.)   ! print contents.
258             GO TO 1000
259 600         CALL PRINCO(I,573,.TRUE.)             ! print contents
260 1000      CONTINUE
261           RETURN
262 C
263           END
264 C page
265 C INVENT- Print contents of adventurer
266 C
267 C Declarations
268 C
269           SUBROUTINE INVENT(ADV)
270           IMPLICIT INTEGER (A-Z)
271           %include dparam
272           LOGICAL QEMPTY
273 C
274           I=575                                             ! first line.
275           IF(ADV.NE.PLAYER) I=576                           ! if not me.
276           DO 10 J=1,OLNT                                    ! loop
277 C old       IF((OADV(J).NE.ADV).OR.((OFLAG1(J).AND.VISIBT).EQ.0))
278 C old     &         GO TO 10
279             IF((OADV(J).NE.ADV).OR.((AND(OFLAG1(J),VISIBT)).EQ.0))
280           &         GO TO 10
281             CALL RSPSUB(I,ODESC2(AOBJ(ADV)))
282             I=0
283             CALL RSPSUB(502,ODESC2(J))
284 10        CONTINUE
285 C
286           IF(I.EQ.0) GO TO 25                     ! any objects?
287           IF(ADV.EQ.PLAYER) CALL RSPEAK(578)      ! no, tell him.
288           RETURN
289 C
290 25        DO 100 J=1,OLNT                                   ! loop.
291 C old       IF((OADV(J).NE.ADV).OR.((OFLAG1(J).AND.VISIBT).EQ.0).OR.
292 C old     &         (((OFLAG1(J).AND.TRANBT).EQ.0).AND.
293 C old     &         ((OFLAG2(J).AND.OPENBT).EQ.0))) GO TO 100
294             IF((OADV(J).NE.ADV).OR.((AND(OFLAG1(J),VISIBT)).EQ.0).OR.
295           &         (((AND(OFLAG1(J),TRANBT)).EQ.0).AND.
296           &         ((AND(OFLAG2(J),OPENBT)).EQ.0))) GO TO 100
297             IF(.NOT.QEMPTY(J)) CALL PRINCO(J,573,.TRUE.) ! if not empty, list.
298 100       CONTINUE
299           RETURN
300 C
301           END