1 C TAKEIT- Parser based take of object
  2 C
  3 C Declarations
  4 C
  5           LOGICAL FUNCTION TAKEIT(OBJ,SFLAG)
  6           IMPLICIT INTEGER(A-Z)
  7           %include dparam
  8           LOGICAL TAKE,LIT
  9 C
 10           TAKEIT=.FALSE.                                    ! assume loses.
 11           IF((OBJ.EQ.0).OR.(OBJ.GT.STRBIT).OR.DEADF)
 12           &         GO TO 4000                              ! null/stars/dead win.
 13           ODO2=ODESC2(OBJ)                        ! get desc.
 14           X=OCAN(OBJ)                                       ! get container.
 15 C old     IF((X.EQ.0).OR.((SFLAG.AND.VFBIT).EQ.0)) GO TO 500
 16           IF((X.EQ.0).OR.(AND(SFLAG,VFBIT).EQ.0)) GO TO 500
 17 C old     IF((OFLAG2(X).AND.OPENBT).NE.0) GO TO 500
 18           IF(AND(OFLAG2(X),OPENBT).NE.0) GO TO 500
 19           CALL RSPSUB(566,ODO2)                             ! cant reach.
 20           RETURN
 21 C
 22 C old 500 IF((SFLAG.AND.VRBIT).EQ.0) GO TO 1000   ! shld be in room?
 23 500       IF(AND(SFLAG,VRBIT).EQ.0) GO TO 1000    ! shld be in room?
 24 C old     IF((SFLAG.AND.VTBIT).EQ.0) GO TO 2000   ! can be taken?
 25           IF(AND(SFLAG,VTBIT).EQ.0) GO TO 2000    ! can be taken?
 26 C
 27 C Should be in room (VRBIT NE 0) and can be taken (VTBIT NE 0)
 28 C
 29           IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000 ! if not, ok.
 30 C
 31 C Its in the room and can be taken.
 32 C
 33 C old     IF((OFLAG1(OBJ).AND.TAKEBT).NE.0) GO TO 3000
 34           IF(AND(OFLAG1(OBJ),TAKEBT).NE.0) GO TO 3000
 35 C
 36 C Not takeable.  If we care, fail.
 37 C
 38 C old     IF((SFLAG.AND.VCBIT).EQ.0) GO TO 4000   ! if no care, return.
 39           IF(AND(SFLAG,VCBIT).EQ.0) GO TO 4000    ! if no care, return.
 40           CALL RSPSUB(445,ODO2)
 41           RETURN
 42 C
 43 C 1000--  It should not be in the room.
 44 C 2000--  It cant be taken.
 45 C
 46 C old 2000          IF((SFLAG.AND.VCBIT).EQ.0) GO TO 4000   ! if no care, return
 47 2000      IF(AND(SFLAG,VCBIT).EQ.0) GO TO 4000    ! if no care, return
 48 1000      IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000
 49           I=665                                             ! assume player.
 50           IF(WINNER.NE.PLAYER) I=1082
 51           CALL RSPSUB(I,ODO2)                     ! doesn't have it.
 52           RETURN
 53 C
 54 C 3000--  Take object.
 55 C
 56 3000      IF(LIT(HERE)) GO TO 3500                ! lit?
 57           CALL RSPEAK(579)                        ! can't do it.
 58           RETURN
 59 C
 60 3500      SVA=PRSA                                ! save parse vector
 61           SVO=PRSO
 62           SVI=PRSI
 63           PRSA=TAKEW                                        ! make 'take obj'
 64           PRSO=OBJ
 65           PRSI=0                                            ! no indirect object
 66           TAKEIT=TAKE(.TRUE.)                     ! try to take object
 67           PRSA=SVA                                ! restore parse vector.
 68           PRSO=SVO
 69           PRSI=SVI
 70           RETURN
 71 C
 72 C 4000--  Win on general principles.
 73 C
 74 4000      TAKEIT=.TRUE.
 75           RETURN
 76 C
 77           END
 78 C page
 79 C GWIM- Get what I mean in ambiguous situations
 80 C
 81 C Declarations
 82 C
 83           INTEGER FUNCTION GWIM(SFLAG,SFW1,SFW2)
 84           IMPLICIT INTEGER(A-Z)
 85           %include dparam
 86           LOGICAL TAKEIT,NOCARE,LIT
 87 C
 88           GWIM=0                                            ! no result.
 89           IF(DEADF) RETURN                        ! dead? gwim disabled.
 90           AV=AVEHIC(WINNER)
 91 C old     NOCARE=(SFLAG.AND.VCBIT).EQ.0
 92           NOCARE=AND(SFLAG,VCBIT).EQ.0
 93 C
 94 C First search adventurer
 95 C
 96 C old     IF((SFLAG.AND.VABIT).NE.0)
 97 C old     &         GWIM=FWIM(SFW1,SFW2,0,0,WINNER,NOCARE)
 98           IF(AND(SFLAG,VABIT).NE.0)
 99           &         GWIM=FWIM(SFW1,SFW2,0,0,WINNER,NOCARE)
100 C old     IF((GWIM.LT.0).OR..NOT.LIT(HERE).OR.
101 C old     &  ((SFLAG.AND.VRBIT).EQ.0)) RETURN
102           IF((GWIM.LT.0).OR..NOT.LIT(HERE).OR.
103           &  (AND(SFLAG,VRBIT).EQ.0)) RETURN
104 C
105 C Also search room
106 C
107 100       ROBJ=FWIM(SFW1,SFW2,HERE,0,0,NOCARE)
108           IF(ROBJ) 500,600,200                              ! test result.
109 C
110 C ROBJ > 0: if prev object, fail
111 C
112 C old 200 IF((AV.EQ.0).OR.(ROBJ.EQ.AV).OR.
113 C old     &         ((OFLAG2(ROBJ).AND.FINDBT).NE.0)) GO TO 300
114 200       IF((AV.EQ.0).OR.(ROBJ.EQ.AV).OR.
115           &         (AND(OFLAG2(ROBJ),FINDBT).NE.0)) GO TO 300
116           IF(OCAN(ROBJ).NE.AV) RETURN             ! unreachable? use prev obj.
117 C
118 300       IF(GWIM.EQ.0) GO TO 400                           ! prev obj?
119           GWIM=-GWIM                                        ! yes, ambiguous.
120           RETURN
121 C
122 400       IF(.NOT.TAKEIT(ROBJ,SFLAG)) RETURN      ! if untakeable, return prev.
123 500       GWIM=ROBJ                               ! return room seach.
124 600       RETURN
125 C
126           END
127 C page
128 C NOADJS- See if any adjectives for object
129 C
130 C Declarations
131 C
132           LOGICAL FUNCTION NOADJS(OBJ)
133           IMPLICIT INTEGER(A-Z)
134           %include dparam
135 C
136           NOADJS=.FALSE.                                    ! assume false.
137           DO 100 I=1,AVMAX                        ! search adj.
138             IF(IABS(AVOC(I)).EQ.OBJ) RETURN       ! found adjective?
139             IF(AVOC(I).EQ.0) GO TO 200            ! end of list?
140 100       CONTINUE
141 200       NOADJS=.TRUE.                                     ! true.
142           RETURN
143 C
144           END
145 C page
146 C LCIFY-  "Lower case"-ify a string for printing
147 C
148 C Declarations
149 C
150           CHARACTER*(*) FUNCTION LCIFY(STRING,START)
151           IMPLICIT INTEGER(A-Z)
152           CHARACTER*(*) STRING
153 C
154           LCIFY=STRING                                      ! assume input = output.
155           K=LEN(STRING)                                     ! get input length.
156           IF(START.GT.K) RETURN                             ! anything to convert?
157 C
158           ULCVT=ICHAR('a')-ICHAR('A')             ! conversion factor
159           DO 100 I=START,K                        ! loop on characters
160             IF((STRING(I:I).GE.'A').AND.(STRING(I:I).LE.'Z'))
161           &         LCIFY(I:I)=CHAR(ICHAR(STRING(I:I))+ULCVT)
162 100       CONTINUE
163           RETURN
164 C
165           END
166 C page
167 C FINDVB- Find verb string corresponding to syntax.
168 C
169 C Declarations
170 C
171           CHARACTER*(*) FUNCTION FINDVB(SYNTAX)
172           IMPLICIT INTEGER(A-Z)
173           %include dparam
174 C
175           J=1
176           DO 100 K=1,VWMAX                        ! loop through verbs
177             NEWJ=J+VVOC(J)+1                      ! start of next syntax
178             IF((J.LE.SYNTAX).AND.(SYNTAX.LT.NEWJ)) GO TO 200
179             IF(VWORD(K)(1:1).NE.'*') J=NEWJ       ! if last synonym, advance.
180 100       CONTINUE
181           FINDVB=' '                                        ! disaster
182           RETURN
183 C
184 200       FINDVB=VWORD(K)                                   ! return string
185           IF(VWORD(K)(1:1).EQ.'*') FINDVB=VWORD(K)(2:WRDLNT)
186           RETURN
187 C
188           END
189 C page
190 C FINDPR- Find preposition string corresponding to index.
191 C
192 C Declarations
193 C
194           CHARACTER*(*) FUNCTION FINDPR(PREPNO)
195           IMPLICIT INTEGER(A-Z)
196           %include dparam
197 C
198           DO 100 I=1,PWMAX                        ! loop through prepositions.
199             IF(PVOC(I).EQ.PREPNO) GO TO 200
200 100       CONTINUE
201           FINDPR=' '
202           RETURN
203 C
204 200       FINDPR=PWORD(I)
205           RETURN
206 C
207           END