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

   1: C
   2: C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
   3: C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
   4: C WRITTEN BY R. M. SUPNIK
   5: C
   6: #ifndef PDP     /* replaced by C function for pdp */
   7: C GTTIME-- GET TOTAL TIME PLAYED
   8: C
   9: C DECLARATIONS
  10: C
  11:         SUBROUTINE GTTIME(T)
  12:         IMPLICIT INTEGER(A-Z)
  13: C
  14:         COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
  15: C
  16:         CALL ITIME(H,M,S)
  17:         T=((H*60)+M)-((SHOUR*60)+SMIN)
  18:         IF(T.LT.0) T=T+1440
  19:         T=T+PLTIME
  20:         RETURN
  21:         END
  22: #endif PDP
  23: C OPNCLS-- PROCESS OPEN/CLOSE FOR DOORS
  24: C
  25: C DECLARATIONS
  26: C
  27:         LOGICAL FUNCTION OPNCLS(OBJ,SO,SC)
  28:         IMPLICIT INTEGER (A-Z)
  29:         LOGICAL QOPEN
  30: #include "parser.h"
  31: #include "objects.h"
  32: #include "oflags.h"
  33: #include "verbs.h"
  34: C
  35: C FUNCTIONS AND DATA
  36: C
  37:         QOPEN(O)=and(OFLAG2(O),OPENBT).NE.0
  38: C
  39:         OPNCLS=.TRUE.
  40: C						!ASSUME WINS.
  41:         IF(PRSA.EQ.CLOSEW) GO TO 100
  42: C						!CLOSE?
  43:         IF(PRSA.EQ.OPENW) GO TO 50
  44: C						!OPEN?
  45:         OPNCLS=.FALSE.
  46: C						!LOSE
  47:         RETURN
  48: C
  49: 50      IF(QOPEN(OBJ)) GO TO 200
  50: C						!OPEN... IS IT?
  51:         CALL RSPEAK(SO)
  52:         OFLAG2(OBJ)=or(OFLAG2(OBJ),OPENBT)
  53:         RETURN
  54: C
  55: 100     IF(.NOT.QOPEN(OBJ)) GO TO 200
  56: C						!CLOSE... IS IT?
  57:         CALL RSPEAK(SC)
  58:         OFLAG2(OBJ)=and(OFLAG2(OBJ),not(OPENBT))
  59:         RETURN
  60: C
  61: 200     CALL RSPEAK(125+RND(3))
  62: C						!DUMMY.
  63:         RETURN
  64:         END
  65: C LIT-- IS ROOM LIT?
  66: C
  67: C DECLARATIONS
  68: C
  69:         LOGICAL FUNCTION LIT(RM)
  70:         IMPLICIT INTEGER (A-Z)
  71:         LOGICAL QHERE
  72: #include "rooms.h"
  73: #include "rflag.h"
  74: #include "objects.h"
  75: #include "oflags.h"
  76: #include "advers.h"
  77: C
  78:         LIT=.TRUE.
  79: C						!ASSUME WINS
  80:         IF(and(RFLAG(RM),RLIGHT).NE.0) RETURN
  81: C
  82:         DO 1000 I=1,OLNT
  83: C						!LOOK FOR LIT OBJ
  84:           IF(QHERE(I,RM)) GO TO 100
  85: C						!IN ROOM?
  86:           OA=OADV(I)
  87: C						!NO
  88:           IF(OA.LE.0) GO TO 1000
  89: C						!ON ADV?
  90:           IF(AROOM(OA).NE.RM) GO TO 1000
  91: C						!ADV IN ROOM?
  92: C
  93: C OBJ IN ROOM OR ON ADV IN ROOM
  94: C
  95: 100       IF(and(OFLAG1(I),ONBT).NE.0) RETURN
  96:           IF((and(OFLAG1(I),VISIBT).EQ.0).OR.
  97: &               ((and(OFLAG1(I),TRANBT).EQ.0).AND.
  98: &               (and(OFLAG2(I),OPENBT).EQ.0))) GO TO 1000
  99: C
 100: C OBJ IS VISIBLE AND OPEN OR TRANSPARENT
 101: C
 102:           DO 500 J=1,OLNT
 103:             IF((OCAN(J).EQ.I).AND.(and(OFLAG1(J),ONBT).NE.0))
 104: &               RETURN
 105: 500       CONTINUE
 106: 1000    CONTINUE
 107:         LIT=.FALSE.
 108:         RETURN
 109:         END
 110: C WEIGHT- RETURNS SUM OF WEIGHT OF QUALIFYING OBJECTS
 111: C
 112: C DECLARATIONS
 113: C
 114:         INTEGER FUNCTION WEIGHT(RM,CN,AD)
 115:         IMPLICIT INTEGER (A-Z)
 116:         LOGICAL QHERE
 117: #include "objects.h"
 118: C
 119:         WEIGHT=0
 120:         DO 100 I=1,OLNT
 121: C						!OMIT BIG FIXED ITEMS.
 122:           IF(OSIZE(I).GE.10000) GO TO 100
 123: C						!IF FIXED, FORGET IT.
 124:           IF((QHERE(I,RM).AND.(RM.NE.0)).OR.
 125: &               ((OADV(I).EQ.AD).AND.(AD.NE.0))) GO TO 50
 126:           J=I
 127: C						!SEE IF CONTAINED.
 128: 25        J=OCAN(J)
 129: C						!GET NEXT LEVEL UP.
 130:           IF(J.EQ.0) GO TO 100
 131: C						!END OF LIST?
 132:           IF(J.NE.CN) GO TO 25
 133: 50        WEIGHT=WEIGHT+OSIZE(I)
 134: 100     CONTINUE
 135:         RETURN
 136:         END