Commit | Line | Data |
---|---|---|
8b22683c KB |
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 |