Return to dso1.F CVS log

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

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

1.1     ! root        1: C PRINCR- PRINT CONTENTS OF ROOM
        !             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 DECLARATIONS
        !             8: C
        !             9:        SUBROUTINE PRINCR(FULL,RM)
        !            10:        IMPLICIT INTEGER (A-Z)
        !            11:        LOGICAL QEMPTY,QHERE,FULL
        !            12: #include "gamestate.h"
        !            13: #include "rooms.h"
        !            14: #include "rflag.h"
        !            15: C
        !            16: #include "objects.h"
        !            17: #include "oflags.h"
        !            18: #include "oindex.h"
        !            19: #include "advers.h"
        !            20: #include "flags.h"
        !            21: C PRINCR, PAGE 2
        !            22: C
        !            23:        J=329
        !            24: C                                              !ASSUME SUPERBRIEF FORMAT.
        !            25:        DO 500 I=1,OLNT
        !            26: C                                              !LOOP ON OBJECTS
        !            27:          IF(.NOT.QHERE(I,RM).OR.(and(OFLAG1(I),(VISIBT+NDSCBT)).NE.
        !            28: &              VISIBT).OR.(I.EQ.AVEHIC(WINNER))) GO TO 500
        !            29:          IF(.NOT.FULL.AND.(SUPERF.OR.(BRIEFF.AND.
        !            30: &              (and(RFLAG(HERE),RSEEN).NE.0)))) GO TO 200
        !            31: C
        !            32: C DO LONG DESCRIPTION OF OBJECT.
        !            33: C
        !            34:          K=ODESCO(I)
        !            35: C                                              !GET UNTOUCHED.
        !            36:          IF((K.EQ.0).OR.(and(OFLAG2(I),TCHBT).NE.0)) K=ODESC1(I)
        !            37:          CALL RSPEAK(K)
        !            38: C                                              !DESCRIBE.
        !            39:          GO TO 500
        !            40: C DO SHORT DESCRIPTION OF OBJECT.
        !            41: C
        !            42: 200      CALL RSPSUB(J,ODESC2(I))
        !            43: C                                              !YOU CAN SEE IT.
        !            44:          J=502
        !            45: C
        !            46: 500    CONTINUE
        !            47: C
        !            48: C NOW LOOP TO PRINT CONTENTS OF OBJECTS IN ROOM.
        !            49: C
        !            50:        DO 1000 I=1,OLNT
        !            51: C                                              !LOOP ON OBJECTS.
        !            52:          IF(.NOT.QHERE(I,RM).OR.(and(OFLAG1(I),(VISIBT+NDSCBT)).NE.
        !            53: &              VISIBT)) GO TO 1000
        !            54:          IF(and(OFLAG2(I),ACTRBT).NE.0) CALL INVENT(OACTOR(I))
        !            55:          IF(((and(OFLAG1(I),TRANBT).EQ.0)
        !            56: &              .AND.(and(OFLAG2(I),OPENBT).EQ.0))
        !            57: &              .OR.QEMPTY(I)) GO TO 1000
        !            58: C
        !            59: C OBJECT IS NOT EMPTY AND IS OPEN OR TRANSPARENT.
        !            60: C
        !            61:          J=573
        !            62:          IF(I.NE.TCASE) GO TO 600
        !            63: C                                              !TROPHY CASE?
        !            64:          J=574
        !            65:          IF((BRIEFF.OR.SUPERF).AND. .NOT.FULL) GO TO 1000
        !            66: 600      CALL PRINCO(I,J)
        !            67: C                                              !PRINT CONTENTS.
        !            68: C
        !            69: 1000   CONTINUE
        !            70:        RETURN
        !            71: C
        !            72:        END
        !            73: C INVENT- PRINT CONTENTS OF ADVENTURER
        !            74: C
        !            75: C DECLARATIONS
        !            76: C
        !            77:        SUBROUTINE INVENT(ADV)
        !            78:        IMPLICIT INTEGER (A-Z)
        !            79:        LOGICAL QEMPTY
        !            80: #include "gamestate.h"
        !            81: #include "objects.h"
        !            82: #include "oflags.h"
        !            83: C
        !            84: #include "advers.h"
        !            85: C INVENT, PAGE 2
        !            86: C
        !            87:        I=575
        !            88: C                                              !FIRST LINE.
        !            89:        IF(ADV.NE.PLAYER) I=576
        !            90: C                                              !IF NOT ME.
        !            91:        DO 10 J=1,OLNT
        !            92: C                                              !LOOP
        !            93:          IF((OADV(J).NE.ADV).OR.(and(OFLAG1(J),VISIBT).EQ.0))
        !            94: &              GO TO 10
        !            95:          CALL RSPSUB(I,ODESC2(AOBJ(ADV)))
        !            96:          I=0
        !            97:          CALL RSPSUB(502,ODESC2(J))
        !            98: 10     CONTINUE
        !            99: C
        !           100:        IF(I.EQ.0) GO TO 25
        !           101: C                                              !ANY OBJECTS?
        !           102:        IF(ADV.EQ.PLAYER) CALL RSPEAK(578)
        !           103: C                                              !NO, TELL HIM.
        !           104:        RETURN
        !           105: C
        !           106: 25     DO 100 J=1,OLNT
        !           107: C                                              !LOOP.
        !           108:          IF((OADV(J).NE.ADV).OR.(and(OFLAG1(J),VISIBT).EQ.0).OR.
        !           109: &              ((and(OFLAG1(J),TRANBT).EQ.0).AND.
        !           110: &              (and(OFLAG2(J),OPENBT).EQ.0))) GO TO 100
        !           111:          IF(.NOT.QEMPTY(J)) CALL PRINCO(J,573)
        !           112: C                                              !IF NOT EMPTY, LIST.
        !           113: 100    CONTINUE
        !           114:        RETURN
        !           115: C
        !           116:        END
        !           117: C PRINCO-      PRINT CONTENTS OF OBJECT
        !           118: C
        !           119: C DECLARATIONS
        !           120: C
        !           121:        SUBROUTINE PRINCO(OBJ,DESC)
        !           122:        IMPLICIT INTEGER(A-Z)
        !           123: #include "objects.h"
        !           124: C
        !           125:        CALL RSPSUB(DESC,ODESC2(OBJ))
        !           126: C                                              !PRINT HEADER.
        !           127:        DO 100 I=1,OLNT
        !           128: C                                              !LOOP THRU.
        !           129:          IF(OCAN(I).EQ.OBJ) CALL RSPSUB(502,ODESC2(I))
        !           130: 100    CONTINUE
        !           131:        RETURN
        !           132: C
        !           133:        END

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