Return to dso5.F CVS log

Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon

Annotation of 43BSDReno/games/dungeon/dso5.F, revision 1.1

1.1     ! root        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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.