# 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

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