xref: /original-bsd/contrib/dungeon/dso5.F (revision 2301fdfb)
1C
2C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
3C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
4C WRITTEN BY R. M. SUPNIK
5C
6#ifndef PDP	/* replaced by C function for pdp */
7C GTTIME-- GET TOTAL TIME PLAYED
8C
9C DECLARATIONS
10C
11 	SUBROUTINE GTTIME(T)
12 	IMPLICIT INTEGER(A-Z)
13C
14 	COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
15C
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
23C OPNCLS-- PROCESS OPEN/CLOSE FOR DOORS
24C
25C DECLARATIONS
26C
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"
34C
35C FUNCTIONS AND DATA
36C
37	QOPEN(O)=and(OFLAG2(O),OPENBT).NE.0
38C
39	OPNCLS=.TRUE.
40C						!ASSUME WINS.
41	IF(PRSA.EQ.CLOSEW) GO TO 100
42C						!CLOSE?
43	IF(PRSA.EQ.OPENW) GO TO 50
44C						!OPEN?
45	OPNCLS=.FALSE.
46C						!LOSE
47	RETURN
48C
4950	IF(QOPEN(OBJ)) GO TO 200
50C						!OPEN... IS IT?
51	CALL RSPEAK(SO)
52	OFLAG2(OBJ)=or(OFLAG2(OBJ),OPENBT)
53	RETURN
54C
55100	IF(.NOT.QOPEN(OBJ)) GO TO 200
56C						!CLOSE... IS IT?
57	CALL RSPEAK(SC)
58	OFLAG2(OBJ)=and(OFLAG2(OBJ),not(OPENBT))
59	RETURN
60C
61200	CALL RSPEAK(125+RND(3))
62C						!DUMMY.
63	RETURN
64	END
65C LIT-- IS ROOM LIT?
66C
67C DECLARATIONS
68C
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"
77C
78	LIT=.TRUE.
79C						!ASSUME WINS
80	IF(and(RFLAG(RM),RLIGHT).NE.0) RETURN
81C
82	DO 1000 I=1,OLNT
83C						!LOOK FOR LIT OBJ
84	  IF(QHERE(I,RM)) GO TO 100
85C						!IN ROOM?
86	  OA=OADV(I)
87C						!NO
88	  IF(OA.LE.0) GO TO 1000
89C						!ON ADV?
90	  IF(AROOM(OA).NE.RM) GO TO 1000
91C						!ADV IN ROOM?
92C
93C OBJ IN ROOM OR ON ADV IN ROOM
94C
95100	  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
99C
100C OBJ IS VISIBLE AND OPEN OR TRANSPARENT
101C
102	  DO 500 J=1,OLNT
103	    IF((OCAN(J).EQ.I).AND.(and(OFLAG1(J),ONBT).NE.0))
104&		RETURN
105500	  CONTINUE
1061000	CONTINUE
107	LIT=.FALSE.
108	RETURN
109	END
110C WEIGHT- RETURNS SUM OF WEIGHT OF QUALIFYING OBJECTS
111C
112C DECLARATIONS
113C
114	INTEGER FUNCTION WEIGHT(RM,CN,AD)
115	IMPLICIT INTEGER (A-Z)
116	LOGICAL QHERE
117#include "objects.h"
118C
119	WEIGHT=0
120	DO 100 I=1,OLNT
121C						!OMIT BIG FIXED ITEMS.
122	  IF(OSIZE(I).GE.10000) GO TO 100
123C						!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
127C						!SEE IF CONTAINED.
12825	  J=OCAN(J)
129C						!GET NEXT LEVEL UP.
130	  IF(J.EQ.0) GO TO 100
131C						!END OF LIST?
132	  IF(J.NE.CN) GO TO 25
13350	  WEIGHT=WEIGHT+OSIZE(I)
134100	CONTINUE
135	RETURN
136	END
137