1 C WEIGHR- Returns sum of weight of qualifying objects
  2 C
  3 C Declarations
  4 C
  5           INTEGER FUNCTION WEIGHR(CN,AD)
  6           IMPLICIT INTEGER (A-Z)
  7           %include dparam
  8           LOGICAL QHERE
  9 C
 10           WEIGHR=0
 11           DO 100 I=1,OLNT                                   ! omit big fixed items.
 12             IF(OSIZE(I).GE.10000) GO TO 100       ! if fixed, forget it.
 13             IF((OADV(I).EQ.AD).AND.(AD.NE.0)) GO TO 50      ! on adv?
 14             J=I                                             ! see if contained.
 15 25          J=OCAN(J)                                       ! get next level up.
 16             IF(J.EQ.0) GO TO 100                            ! end of list?
 17             IF(((OADV(J).NE.AD).OR.(AD.EQ.0)) .AND.
 18           &         (J.NE.CN)) GO TO 25           ! cont on adv, or argument?
 19 50          WEIGHR=WEIGHR+OSIZE(I)                ! add in weight.
 20 100       CONTINUE
 21           RETURN
 22 C
 23           END
 24 C page
 25 C GHERE-- Is global actually in this room?
 26 C
 27 C Declarations
 28 C
 29           LOGICAL FUNCTION GHERE(OBJ,RM)
 30           IMPLICIT INTEGER (A-Z)
 31           %include dparam
 32 C
 33           GHERE=.TRUE.                                      ! assume wins.
 34           IF(OBJ.LE.GLOBAL) RETURN                ! if untested, return.
 35           GO TO (  100,1000,2000,3000,4000,5000,5000,5000,6000,
 36           &         7000,8000,9000,9100,8000,10000,11000,12000,
 37           &         13000,14000,15000),OBJ-GLOBAL
 38           CALL BUG(60,OBJ)
 39 C
 40 C 100-- Granite Wall
 41 C
 42 100       GHERE=(RM.EQ.TEMP1).OR.(RM.EQ.TREAS).OR.(RM.EQ.SLIDE)
 43           RETURN
 44 C
 45 C 1000--  House
 46 C
 47 1000      GHERE=((RM.GE.WHOUS).AND.(RM.LE.EHOUS)).OR.
 48           &         ((RM.GE.FORE1).AND.(RM.LE.CLEAR)).OR.(RM.EQ.MTREE)
 49           RETURN
 50 C
 51 C 2000--  Bird
 52 C
 53 2000      GHERE=((RM.GE.FORE1).AND.(RM.LT.CLEAR)).OR.(RM.EQ.MTREE)
 54           RETURN
 55 C
 56 C 3000--  Tree
 57 C
 58 3000      GHERE=((RM.GE.FORE1).AND.(RM.LT.CLEAR)).AND.(RM.NE.FORE3)
 59           RETURN
 60 C
 61 C 4000--  North wall
 62 C
 63 4000      GHERE=((RM.GE.BKVW).AND.(RM.LE.BKBOX)).OR.(RM.EQ.CPUZZ)
 64           RETURN
 65 C
 66 C 5000--  East, south, west walls
 67 C
 68 5000      GHERE=((RM.GE.BKVW).AND.(RM.LT.BKBOX)).OR.(RM.EQ.CPUZZ)
 69           RETURN
 70 C
 71 C 6000--  Global water
 72 C
 73 C old 6000          GHERE=(RFLAG(RM).AND.(RWATER+RFILL)).NE.0
 74 6000      GHERE=AND(RFLAG(RM),(RWATER+RFILL)).NE.0
 75           RETURN
 76 C
 77 C 7000--  Global guardians
 78 C
 79 7000      GHERE=((RM.GE.MRC).AND.(RM.LE.MRD)).OR.
 80           &         ((RM.GE.MRCE).AND.(RM.LE.MRDW)).OR.(RM.EQ.INMIR)
 81           RETURN
 82 C
 83 C 8000--  Rose/channel
 84 C
 85 8000      GHERE=((RM.GE.MRA).AND.(RM.LE.MRD)).OR.(RM.EQ.INMIR)
 86           RETURN
 87 C
 88 C 9000--  Mirror
 89 C 9100              Panel
 90 C
 91 9100      IF(RM.EQ.FDOOR) RETURN                            ! panel at fdoor.
 92 9000      GHERE=((RM.GE.MRA).AND.(RM.LE.MRC)).OR.
 93           &         ((RM.GE.MRAE).AND.(RM.LE.MRCW))
 94           RETURN
 95 C
 96 C 10000-- Master
 97 C
 98 10000     GHERE=(RM.EQ.FDOOR).OR.(RM.EQ.NCORR).OR.(RM.EQ.PARAP).OR.
 99           &         (RM.EQ.CELL).OR.(RM.EQ.PCELL).OR.(RM.EQ.NCELL)
100           RETURN
101 C
102 C 11000-- Ladder
103 C
104 11000     GHERE=(RM.EQ.CPUZZ)
105           RETURN
106 C
107 C 12000-- Well
108 C
109 12000     GHERE=(RM.EQ.TWELL).OR.(RM.EQ.BWELL)
110           RETURN
111 C
112 C 13000-- Rope in slide
113 C
114 13000     GHERE=(RM.GE.SLID1).AND.(RM.LE.SLEDG)
115           RETURN
116 C
117 C 14000-- Slide
118 C
119 14000     GHERE=(RM.GE.SLIDE).OR.((RM.GE.SLID1).AND.(RM.LE.SLEDG))
120           RETURN
121 C
122 C 15000-- Bunch pseudo object
123 C
124 15000     GHERE=.FALSE.                           ! never present
125           RETURN
126 C
127           END
128 C page
129 C MRHERE--          Is mirror here?
130 C
131 C Declarations
132 C
133           INTEGER FUNCTION MRHERE(RM)
134           IMPLICIT INTEGER (A-Z)
135           %include dparam
136 C
137           IF((RM.LT.MRAE).OR.(RM.GT.MRDW)) GO TO 100
138 C
139 C Room is an e-w room, mirror must be n-s (mdir= 0 or 180)
140 C
141           MRHERE=1                                ! assume mirror 1 here.
142           IF(MOD(RM-MRAE,2).EQ.(MDIR/180)) MRHERE=2
143           RETURN
144 C
145 C Room is north or south of mirror.  If mirror is n-s or not
146 c within one room of room, lose.
147 C
148 100       MRHERE=0
149           IF((IABS(MLOC-RM).NE.1).OR.(MOD(MDIR,180).EQ.0)) RETURN
150 C
151 C Room is within one of mloc, and mdir is e-w
152 C
153           MRHERE=1
154           IF(((RM.LT.MLOC).AND.(MDIR.LT.180)).OR.
155           &  ((RM.GT.MLOC).AND.(MDIR.GT.180))) MRHERE=2
156           RETURN
157 C
158           END
159 C page
160 C ENCRYP--          Encrypt password
161 C
162 C Declarations
163 C
164           SUBROUTINE ENCRYP(INW,OUTW)
165           IMPLICIT INTEGER (A-Z)
166           %include dparam
167           CHARACTER*(WRDLNT) INW,OUTW,KEYW
168           INTEGER UINW(8),UKEYW(8)
169           DATA KEYW/'ECOVXRMS'/
170 C
171           ICHARA=ICHAR('A')-1                     ! character base.
172           UINWS=0                                           ! unbiased inw sum.
173           UKEYWS=0                                ! unbiased keyw sum.
174           J=1                                               ! pointer in keyword.
175           DO 100 I=1,WRDLNT                       ! unbias, compute sums.
176             UKEYW(I)=ICHAR(KEYW(I:I))-ICHARA      ! strip ascii.
177             IF(ICHAR(INW(J:J)).LE.ICHARA) J=1     ! recycle on bad.
178             UINW(I)=ICHAR(INW(J:J))-ICHARA
179             UKEYWS=UKEYWS+UKEYW(I)
180             UINWS=UINWS+UINW(I)
181             J=J+1
182 100       CONTINUE
183 C
184           USUM=MOD(UINWS,8)+(8*MOD(UKEYWS,8))     ! compute mask.
185           DO 200 I=1,8
186 C old       J=(UINW(I).XOR.UKEYW(I).XOR.USUM).AND.31
187             J=AND(XOR(UINW(I),UKEYW(I),USUM),31)
188             USUM=MOD(USUM+1,32)
189             IF(J.GT.26) J=MOD(J,26)
190             OUTW(I:I)=CHAR(MAX0(1,J)+ICHARA)
191 200       CONTINUE
192           RETURN
193 C
194           END
195 C page
196 C CPGOTO--          Move to next state in puzzle room
197 C
198 C Declarations
199 C
200           SUBROUTINE CPGOTO(ST)
201           IMPLICIT INTEGER (A-Z)
202           %include dparam
203 C
204 C old     RFLAG(CPUZZ)=RFLAG(CPUZZ).AND..NOT.RSEEN
205           RFLAG(CPUZZ)=AND(RFLAG(CPUZZ),COMPL(RSEEN))
206           DO 100 I=1,OLNT                                   ! relocate objects.
207 C old       IF((OROOM(I).EQ.CPUZZ).AND.
208 C old     &         ((OFLAG2(I).AND.(ACTRBT+VILLBT)).EQ.0))
209 C old     &         CALL NEWSTA(I,0,CPHERE*HFACTR,0,0)
210             IF((OROOM(I).EQ.CPUZZ).AND.
211           &         ((AND(OFLAG2(I),(ACTRBT+VILLBT))).EQ.0))
212           &         CALL NEWSTA(I,0,CPHERE*HFACTR,0,0)
213             IF(OROOM(I).EQ.(ST*HFACTR))
214           &         CALL NEWSTA(I,0,CPUZZ,0,0)
215 100       CONTINUE
216           CPHERE=ST
217           RETURN
218 C
219           END
220 C page
221 C CPINFO--          Describe puzzle room
222 C
223 C Declarations
224 C
225           SUBROUTINE CPINFO(RMK,ST)
226           IMPLICIT INTEGER (A-Z)
227           %include dparam
228           INTEGER DGMOFT(8)
229           CHARACTER*2 DGM(8),PICT(5),QMK
230 C
231 C Functions and local data
232 C
233           DATA DGMOFT/-9,-8,-7,-1,1,7,8,9/
234           DATA PICT/'SS','SS','SS','  ','MM'/
235           DATA QMK/'??'/
236 C
237           CALL RSPEAK(RMK)
238           DO 100 I=1,8
239             J=DGMOFT(I)
240             DGM(I)=PICT(CPVEC(ST+J)+4)            ! get picture element.
241             IF((IABS(J).EQ.1).OR.(IABS(J).EQ.8)) GO TO 100
242             K=8
243             IF(J.LT.0) K=-8                       ! get ortho dir.
244             L=J-K
245             IF((CPVEC(ST+K).NE.0).AND.(CPVEC(ST+L).NE.0))
246           &         DGM(I)=QMK
247 100       CONTINUE
248           WRITE(OUTCH,10) DGM
249 C
250           IF(ST.EQ.10) CALL RSPEAK(870)           ! at hole?
251           IF(ST.EQ.37) CALL RSPEAK(871)           ! at niche?
252           I=872                                             ! door open?
253           IF(CPOUTF) I=873
254           IF(ST.EQ.52) CALL RSPEAK(I)             ! at door?
255           IF(CPVEC(ST+1).EQ.-2) CALL RSPEAK(874)  ! east ladder?
256           IF(CPVEC(ST-1).EQ.-3) CALL RSPEAK(875)  ! west ladder?
257           RETURN
258 C
259 10        FORMAT('       |',A,1X,A,1X,A,'|'/,
260           &' West  |',A,' .. ',A,'|  East'/,
261           &'       |',A,1X,A,1X,A,'|')
262 C
263           END