|
|
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.