xref: /csrg-svn/contrib/dungeon/dso5.F (revision 35973)
1*35973SbosticC
2*35973SbosticC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
3*35973SbosticC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
4*35973SbosticC WRITTEN BY R. M. SUPNIK
5*35973SbosticC
6*35973Sbostic#ifndef PDP	/* replaced by C function for pdp */
7*35973SbosticC GTTIME-- GET TOTAL TIME PLAYED
8*35973SbosticC
9*35973SbosticC DECLARATIONS
10*35973SbosticC
11*35973Sbostic 	SUBROUTINE GTTIME(T)
12*35973Sbostic 	IMPLICIT INTEGER(A-Z)
13*35973SbosticC
14*35973Sbostic 	COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
15*35973SbosticC
16*35973Sbostic 	CALL ITIME(H,M,S)
17*35973Sbostic 	T=((H*60)+M)-((SHOUR*60)+SMIN)
18*35973Sbostic 	IF(T.LT.0) T=T+1440
19*35973Sbostic 	T=T+PLTIME
20*35973Sbostic 	RETURN
21*35973Sbostic 	END
22*35973Sbostic#endif PDP
23*35973SbosticC OPNCLS-- PROCESS OPEN/CLOSE FOR DOORS
24*35973SbosticC
25*35973SbosticC DECLARATIONS
26*35973SbosticC
27*35973Sbostic	LOGICAL FUNCTION OPNCLS(OBJ,SO,SC)
28*35973Sbostic	IMPLICIT INTEGER (A-Z)
29*35973Sbostic	LOGICAL QOPEN
30*35973Sbostic#include "parser.h"
31*35973Sbostic#include "objects.h"
32*35973Sbostic#include "oflags.h"
33*35973Sbostic#include "verbs.h"
34*35973SbosticC
35*35973SbosticC FUNCTIONS AND DATA
36*35973SbosticC
37*35973Sbostic	QOPEN(O)=and(OFLAG2(O),OPENBT).NE.0
38*35973SbosticC
39*35973Sbostic	OPNCLS=.TRUE.
40*35973SbosticC						!ASSUME WINS.
41*35973Sbostic	IF(PRSA.EQ.CLOSEW) GO TO 100
42*35973SbosticC						!CLOSE?
43*35973Sbostic	IF(PRSA.EQ.OPENW) GO TO 50
44*35973SbosticC						!OPEN?
45*35973Sbostic	OPNCLS=.FALSE.
46*35973SbosticC						!LOSE
47*35973Sbostic	RETURN
48*35973SbosticC
49*35973Sbostic50	IF(QOPEN(OBJ)) GO TO 200
50*35973SbosticC						!OPEN... IS IT?
51*35973Sbostic	CALL RSPEAK(SO)
52*35973Sbostic	OFLAG2(OBJ)=or(OFLAG2(OBJ),OPENBT)
53*35973Sbostic	RETURN
54*35973SbosticC
55*35973Sbostic100	IF(.NOT.QOPEN(OBJ)) GO TO 200
56*35973SbosticC						!CLOSE... IS IT?
57*35973Sbostic	CALL RSPEAK(SC)
58*35973Sbostic	OFLAG2(OBJ)=and(OFLAG2(OBJ),not(OPENBT))
59*35973Sbostic	RETURN
60*35973SbosticC
61*35973Sbostic200	CALL RSPEAK(125+RND(3))
62*35973SbosticC						!DUMMY.
63*35973Sbostic	RETURN
64*35973Sbostic	END
65*35973SbosticC LIT-- IS ROOM LIT?
66*35973SbosticC
67*35973SbosticC DECLARATIONS
68*35973SbosticC
69*35973Sbostic	LOGICAL FUNCTION LIT(RM)
70*35973Sbostic	IMPLICIT INTEGER (A-Z)
71*35973Sbostic	LOGICAL QHERE
72*35973Sbostic#include "rooms.h"
73*35973Sbostic#include "rflag.h"
74*35973Sbostic#include "objects.h"
75*35973Sbostic#include "oflags.h"
76*35973Sbostic#include "advers.h"
77*35973SbosticC
78*35973Sbostic	LIT=.TRUE.
79*35973SbosticC						!ASSUME WINS
80*35973Sbostic	IF(and(RFLAG(RM),RLIGHT).NE.0) RETURN
81*35973SbosticC
82*35973Sbostic	DO 1000 I=1,OLNT
83*35973SbosticC						!LOOK FOR LIT OBJ
84*35973Sbostic	  IF(QHERE(I,RM)) GO TO 100
85*35973SbosticC						!IN ROOM?
86*35973Sbostic	  OA=OADV(I)
87*35973SbosticC						!NO
88*35973Sbostic	  IF(OA.LE.0) GO TO 1000
89*35973SbosticC						!ON ADV?
90*35973Sbostic	  IF(AROOM(OA).NE.RM) GO TO 1000
91*35973SbosticC						!ADV IN ROOM?
92*35973SbosticC
93*35973SbosticC OBJ IN ROOM OR ON ADV IN ROOM
94*35973SbosticC
95*35973Sbostic100	  IF(and(OFLAG1(I),ONBT).NE.0) RETURN
96*35973Sbostic	  IF((and(OFLAG1(I),VISIBT).EQ.0).OR.
97*35973Sbostic&		((and(OFLAG1(I),TRANBT).EQ.0).AND.
98*35973Sbostic&		(and(OFLAG2(I),OPENBT).EQ.0))) GO TO 1000
99*35973SbosticC
100*35973SbosticC OBJ IS VISIBLE AND OPEN OR TRANSPARENT
101*35973SbosticC
102*35973Sbostic	  DO 500 J=1,OLNT
103*35973Sbostic	    IF((OCAN(J).EQ.I).AND.(and(OFLAG1(J),ONBT).NE.0))
104*35973Sbostic&		RETURN
105*35973Sbostic500	  CONTINUE
106*35973Sbostic1000	CONTINUE
107*35973Sbostic	LIT=.FALSE.
108*35973Sbostic	RETURN
109*35973Sbostic	END
110*35973SbosticC WEIGHT- RETURNS SUM OF WEIGHT OF QUALIFYING OBJECTS
111*35973SbosticC
112*35973SbosticC DECLARATIONS
113*35973SbosticC
114*35973Sbostic	INTEGER FUNCTION WEIGHT(RM,CN,AD)
115*35973Sbostic	IMPLICIT INTEGER (A-Z)
116*35973Sbostic	LOGICAL QHERE
117*35973Sbostic#include "objects.h"
118*35973SbosticC
119*35973Sbostic	WEIGHT=0
120*35973Sbostic	DO 100 I=1,OLNT
121*35973SbosticC						!OMIT BIG FIXED ITEMS.
122*35973Sbostic	  IF(OSIZE(I).GE.10000) GO TO 100
123*35973SbosticC						!IF FIXED, FORGET IT.
124*35973Sbostic	  IF((QHERE(I,RM).AND.(RM.NE.0)).OR.
125*35973Sbostic&		((OADV(I).EQ.AD).AND.(AD.NE.0))) GO TO 50
126*35973Sbostic	  J=I
127*35973SbosticC						!SEE IF CONTAINED.
128*35973Sbostic25	  J=OCAN(J)
129*35973SbosticC						!GET NEXT LEVEL UP.
130*35973Sbostic	  IF(J.EQ.0) GO TO 100
131*35973SbosticC						!END OF LIST?
132*35973Sbostic	  IF(J.NE.CN) GO TO 25
133*35973Sbostic50	  WEIGHT=WEIGHT+OSIZE(I)
134*35973Sbostic100	CONTINUE
135*35973Sbostic	RETURN
136*35973Sbostic	END
137