# 2.11BSD#431 - /usr/src/new/PORT/dungeon/dverb1.F

       1: C TAKE-- BASIC TAKE SEQUENCE
       2: C
       3: C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
       4: C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
       5: C WRITTEN BY R. M. SUPNIK
       6: C
       7: C TAKE AN OBJECT (FOR VERBS TAKE, PUT, DROP, READ, ETC.)
       8: C
       9:         LOGICAL FUNCTION TAKE(FLG)
      10: C
      11: C DECLARATIONS
      12: C
      13:         IMPLICIT INTEGER (A-Z)
      14:         LOGICAL FLG,OBJACT,OAPPLI,QOPEN,QHERE
      15: #include "parser.h"
      16: #include "gamestate.h"
      17: #include "state.h"
      18:         COMMON /STAR/ MBASE,STRBIT
      19: #include "objects.h"
      20: #include "oflags.h"
      21: C
      22: #include "advers.h"
      23: C
      24: C FUNCTIONS AND DATA
      25: C
      26:         QOPEN(O)=(and(OFLAG2(O),OPENBT).NE.0)
      27: C TAKE, PAGE 2
      28: C
      29:         TAKE=.FALSE.
      30: C						!ASSUME LOSES.
      31:         OA=OACTIO(PRSO)
      32: C						!GET OBJECT ACTION.
      33:         IF(PRSO.LE.STRBIT) GO TO 100
      34: C						!STAR?
      35:         TAKE=OBJACT(X)
      36: C						!YES, LET IT HANDLE.
      37:         RETURN
      38: C
      39: 100     X=OCAN(PRSO)
      40: C						!INSIDE?
      41:         IF(PRSO.NE.AVEHIC(WINNER)) GO TO 400
      42: C						!HIS VEHICLE?
      43:         CALL RSPEAK(672)
      44: C						!DUMMY.
      45:         RETURN
      46: C
      47: 400     IF(and(OFLAG1(PRSO),TAKEBT).NE.0) GO TO 500
      48:         IF(.NOT.OAPPLI(OA,0)) CALL RSPEAK(552+RND(5))
      49:         RETURN
      50: C
      51: C OBJECT IS TAKEABLE AND IN POSITION TO BE TAKEN.
      52: C
      53: 500     IF((X.NE.0).OR. QHERE(PRSO,HERE)) GO TO 600
      54:         IF(OADV(PRSO).EQ.WINNER) CALL RSPEAK(557)
      55: C						!ALREADY GOT IT?
      56:         RETURN
      57: C
      58: 600     IF(((X.NE.0).AND.(OADV(X).EQ.WINNER)).OR.
      59: &               ((WEIGHT(0,PRSO,WINNER)+OSIZE(PRSO)).LE.MXLOAD))
      60: &               GO TO 700
      61:         CALL RSPEAK(558)
      62: C						!TOO MUCH WEIGHT.
      63:         RETURN
      64: C
      65: 700     TAKE=.TRUE.
      66: C						!AT LAST.
      67:         IF(OAPPLI(OA,0)) RETURN
      68: C						!DID IT HANDLE?
      69:         CALL NEWSTA(PRSO,0,0,0,WINNER)
      70: C						!TAKE OBJECT FOR WINNER.
      71:         OFLAG2(PRSO)=or(OFLAG2(PRSO),TCHBT)
      72:         CALL SCRUPD(OFVAL(PRSO))
      73: C						!UPDATE SCORE.
      74:         OFVAL(PRSO)=0
      75: C						!CANT BE SCORED AGAIN.
      76:         IF(FLG) CALL RSPEAK(559)
      77: C						!TELL TAKEN.
      78:         RETURN
      79: C
      80:         END
      81: C DROP- DROP VERB PROCESSOR
      82: C
      83: C DECLARATIONS
      84: C
      85:         LOGICAL FUNCTION DROP(Z)
      86:         IMPLICIT INTEGER (A-Z)
      87:         LOGICAL F,PUT,OBJACT
      88: #include "parser.h"
      89: #include "gamestate.h"
      90: C
      91: C ROOMS
      92: #include "rindex.h"
      93: #include "objects.h"
      94: #include "oflags.h"
      95: C
      96: #include "advers.h"
      97: #include "verbs.h"
      98: C DROP, PAGE 2
      99: C
     100:         DROP=.TRUE.
     101: C						!ASSUME WINS.
     102:         X=OCAN(PRSO)
     103: C						!GET CONTAINER.
     104:         IF(X.EQ.0) GO TO 200
     105: C						!IS IT INSIDE?
     106:         IF(OADV(X).NE.WINNER) GO TO 1000
     107: C						!IS HE CARRYING CON?
     108:         IF(and(OFLAG2(X),OPENBT).NE.0) GO TO 300
     109:         CALL RSPSUB(525,ODESC2(X))
     110: C						!CANT REACH.
     111:         RETURN
     112: C
     113: 200     IF(OADV(PRSO).NE.WINNER) GO TO 1000
     114: C						!IS HE CARRYING OBJ?
     115: 300     IF(AVEHIC(WINNER).EQ.0) GO TO 400
     116: C						!IS HE IN VEHICLE?
     117:         PRSI=AVEHIC(WINNER)
     118: C						!YES,
     119:         F=PUT(.TRUE.)
     120: C						!DROP INTO VEHICLE.
     121:         PRSI=0
     122: C						!DISARM PARSER.
     123:         RETURN
     124: C						!DONE.
     125: C
     126: 400     CALL NEWSTA(PRSO,0,HERE,0,0)
     127: C						!DROP INTO ROOM.
     128:         IF(HERE.EQ.MTREE) CALL NEWSTA(PRSO,0,FORE3,0,0)
     129:         CALL SCRUPD(OFVAL(PRSO))
     130: C						!SCORE OBJECT.
     131:         OFVAL(PRSO)=0
     132: C						!CANT BE SCORED AGAIN.
     133:         OFLAG2(PRSO)=or(OFLAG2(PRSO),TCHBT)
     134: C
     135:         IF(OBJACT(X)) RETURN
     136: C						!DID IT HANDLE?
     137:         I=0
     138: C						!ASSUME NOTHING TO SAY.
     139:         IF(PRSA.EQ.DROPW) I=528
     140:         IF(PRSA.EQ.THROWW) I=529
     141:         IF((I.NE.0).AND.(HERE.EQ.MTREE)) I=659
     142:         CALL RSPSUB(I,ODESC2(PRSO))
     143:         RETURN
     144: C
     145: 1000    CALL RSPEAK(527)
     146: C						!DONT HAVE IT.
     147:         RETURN
     148: C
     149:         END
     150: C PUT- PUT VERB PROCESSOR
     151: C
     152: C DECLARATIONS
     153: C
     154:         LOGICAL FUNCTION PUT(FLG)
     155:         IMPLICIT INTEGER (A-Z)
     156:         LOGICAL TAKE,QOPEN,QHERE,OBJACT,FLG
     157: #include "parser.h"
     158: #include "gamestate.h"
     159: C
     160: C MISCELLANEOUS VARIABLES
     161: C
     162:         COMMON /STAR/ MBASE,STRBIT
     163: #include "objects.h"
     164: #include "oflags.h"
     165: #include "advers.h"
     166: #include "verbs.h"
     167: C
     168: C FUNCTIONS AND DATA
     169: C
     170:         QOPEN(R)=((and(OFLAG2(R),OPENBT)).NE.0)
     171: C PUT, PAGE 2
     172: C
     173:         PUT=.FALSE.
     174:         IF((PRSO.LE.STRBIT).AND.(PRSI.LE.STRBIT)) GO TO 200
     175:         IF(.NOT.OBJACT(X)) CALL RSPEAK(560)
     176: C						!STAR
     177:         PUT=.TRUE.
     178:         RETURN
     179: C
     180: 200     IF((QOPEN(PRSI))
     181: &               .OR.(and(OFLAG1(PRSI),(DOORBT+CONTBT)).NE.0)
     182: &               .OR.(and(OFLAG2(PRSI),VEHBT).NE.0)) GO TO 300
     183:         CALL RSPEAK(561)
     184: C						!CANT PUT IN THAT.
     185:         RETURN
     186: C
     187: 300     IF(QOPEN(PRSI)) GO TO 400
     188: C						!IS IT OPEN?
     189:         CALL RSPEAK(562)
     190: C						!NO, JOKE
     191:         RETURN
     192: C
     193: 400     IF(PRSO.NE.PRSI) GO TO 500
     194: C						!INTO ITSELF?
     195:         CALL RSPEAK(563)
     196: C						!YES, JOKE.
     197:         RETURN
     198: C
     199: 500     IF(OCAN(PRSO).NE.PRSI) GO TO 600
     200: C						!ALREADY INSIDE.
     201:         CALL RSPSB2(564,ODESC2(PRSO),ODESC2(PRSI))
     202:         PUT=.TRUE.
     203:         RETURN
     204: C
     205: 600     IF((WEIGHT(0,PRSO,0)+WEIGHT(0,PRSI,0)+OSIZE(PRSO))
     206: &               .LE.OCAPAC(PRSI)) GO TO 700
     207:         CALL RSPEAK(565)
     208: C						!THEN CANT DO IT.
     209:         RETURN
     210: C
     211: C NOW SEE IF OBJECT (OR ITS CONTAINER) IS IN ROOM
     212: C
     213: 700     J=PRSO
     214: C						!START SEARCH.
     215: 725     IF(QHERE(J,HERE)) GO TO 750
     216: C						!IS IT HERE?
     217:         J=OCAN(J)
     218:         IF(J.NE.0) GO TO 725
     219: C						!MORE TO DO?
     220:         GO TO 800
     221: C						!NO, SCH FAILS.
     222: C
     223: 750     SVO=PRSO
     224: C						!SAVE PARSER.
     225:         SVI=PRSI
     226:         PRSA=TAKEW
     227:         PRSI=0
     228:         IF(.NOT.TAKE(.FALSE.)) RETURN
     229: C						!TAKE OBJECT.
     230:         PRSA=PUTW
     231:         PRSO=SVO
     232:         PRSI=SVI
     233:         GO TO 1000
     234: C
     235: C NOW SEE IF OBJECT IS ON PERSON.
     236: C
     237: 800     IF(OCAN(PRSO).EQ.0) GO TO 1000
     238: C						!INSIDE?
     239:         IF(QOPEN(OCAN(PRSO))) GO TO 900
     240: C						!OPEN?
     241:         CALL RSPSUB(566,ODESC2(PRSO))
     242: C						!LOSE.
     243:         RETURN
     244: C
     245: 900     CALL SCRUPD(OFVAL(PRSO))
     246: C						!SCORE OBJECT.
     247:         OFVAL(PRSO)=0
     248:         OFLAG2(PRSO)=or(OFLAG2(PRSO),TCHBT)
     249:         CALL NEWSTA(PRSO,0,0,0,WINNER)
     250: C						!TEMPORARILY ON WINNER.
     251: C
     252: 1000    IF(OBJACT(X)) RETURN
     253: C						!NO, GIVE OBJECT A SHOT.
     254:         CALL NEWSTA(PRSO,2,0,PRSI,0)
     255: C						!CONTAINED INSIDE.
     256:         PUT=.TRUE.
     257:         RETURN
     258: C
     259:         END
     260: C VALUAC- HANDLES VALUABLES/EVERYTHING
     261: C
     262: C DECLARATIONS
     263: C
     264:         SUBROUTINE VALUAC(V)
     265:         IMPLICIT INTEGER (A-Z)
     266:         LOGICAL LIT,F,F1,TAKE,PUT,DROP,NOTVAL,QHERE
     267: #include "parser.h"
     268: #include "gamestate.h"
     269: #include "objects.h"
     270: #include "oflags.h"
     271: #include "verbs.h"
     272: C
     273: C FUNCTIONS AND DATA
     274: C
     275:         NOTVAL(R)=(SAVEP.EQ.V).AND.(OTVAL(R).LE.0)
     276: C VALUAC, PAGE 2
     277: C
     278:         F=.TRUE.
     279: C						!ASSUME NO ACTIONS.
     280:         I=579
     281: C						!ASSUME NOT LIT.
     282:         IF(.NOT.LIT(HERE)) GO TO 4000
     283: C						!IF NOT LIT, PUNT.
     284:         I=677
     285: C						!ASSUME WRONG VERB.
     286:         SAVEP=PRSO
     287: C						!SAVE PRSO.
     288:         SAVEH=HERE
     289: C						!SAVE HERE.
     290: C
     291: 100     IF(PRSA.NE.TAKEW) GO TO 1000
     292: C						!TAKE EVERY/VALUA?
     293:         DO 500 PRSO=1,OLNT
     294: C						!LOOP THRU OBJECTS.
     295:           IF(.NOT.QHERE(PRSO,HERE).OR.
     296: &               (and(OFLAG1(PRSO),VISIBT).EQ.0).OR.
     297: &               (and(OFLAG2(PRSO),ACTRBT).NE.0).OR.
     298: &               NOTVAL(PRSO)) GO TO 500
     299:           IF((and(OFLAG1(PRSO),TAKEBT).EQ.0).AND.
     300: &               (and(OFLAG2(PRSO),TRYBT).EQ.0)) GO TO 500
     301:           F=.FALSE.
     302:           CALL RSPSUB(580,ODESC2(PRSO))
     303:           F1=TAKE(.TRUE.)
     304:           IF(SAVEH.NE.HERE) RETURN
     305: 500     CONTINUE
     306:         GO TO 3000
     307: C
     308: 1000    IF(PRSA.NE.DROPW) GO TO 2000
     309: C						!DROP EVERY/VALUA?
     310:         DO 1500 PRSO=1,OLNT
     311:           IF((OADV(PRSO).NE.WINNER).OR.NOTVAL(PRSO))
     312: &               GO TO 1500
     313:           F=.FALSE.
     314:           CALL RSPSUB(580,ODESC2(PRSO))
     315:           F1=DROP(.TRUE.)
     316:           IF(SAVEH.NE.HERE) RETURN
     317: 1500    CONTINUE
     318:         GO TO 3000
     319: C
     320: 2000    IF(PRSA.NE.PUTW) GO TO 3000
     321: C						!PUT EVERY/VALUA?
     322:         DO 2500 PRSO=1,OLNT
     323: C						!LOOP THRU OBJECTS.
     324:           IF((OADV(PRSO).NE.WINNER)
     325: &               .OR.(PRSO.EQ.PRSI).OR.NOTVAL(PRSO).OR.
     326: &               (and(OFLAG1(PRSO),VISIBT).EQ.0)) GO TO 2500
     327:           F=.FALSE.
     328:           CALL RSPSUB(580,ODESC2(PRSO))
     329:           F1=PUT(.TRUE.)
     330:           IF(SAVEH.NE.HERE) RETURN
     331: 2500    CONTINUE
     332: C
     333: 3000    I=581
     334:         IF(SAVEP.EQ.V) I=582
     335: C						!CHOOSE MESSAGE.
     336: 4000    IF(F) CALL RSPEAK(I)
     337: C						!IF NOTHING, REPORT.
     338:         RETURN
     339:         END

Last modified: 1988-10-21 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 602 |