![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dso1.F CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon|
Return to dso1.F CVS log | Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon |
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.