xref: /original-bsd/contrib/dungeon/dso2.F (revision e59fb703)
1C MOVETO- MOVE PLAYER TO NEW ROOM
2C
3C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
4C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
5C WRITTEN BY R. M. SUPNIK
6C
7C DECLARATIONS
8C
9	LOGICAL FUNCTION MOVETO(NR,WHO)
10	IMPLICIT INTEGER (A-Z)
11	LOGICAL NLV,LHR,LNR
12#include "gamestate.h"
13#include "rooms.h"
14#include "rflag.h"
15#include "objects.h"
16#include "oindex.h"
17#include "advers.h"
18C MOVETO, PAGE 2
19C
20	MOVETO=.FALSE.
21C						!ASSUME FAILS.
22	LHR=and(RFLAG(HERE),RLAND).NE.0
23	LNR=and(RFLAG(NR),RLAND).NE.0
24	J=AVEHIC(WHO)
25C						!HIS VEHICLE
26C
27	IF(J.NE.0) GO TO 100
28C						!IN VEHICLE?
29	IF(LNR) GO TO 500
30C						!NO, GOING TO LAND?
31	CALL RSPEAK(427)
32C						!CAN'T GO WITHOUT VEHICLE.
33	RETURN
34C
35100	BITS=0
36C						!ASSUME NOWHERE.
37	IF(J.EQ.RBOAT) BITS=RWATER
38C						!IN BOAT?
39	IF(J.EQ.BALLO) BITS=RAIR
40C						!IN BALLOON?
41	IF(J.EQ.BUCKE) BITS=RBUCK
42C						!IN BUCKET?
43	NLV=and(RFLAG(NR),BITS).EQ.0
44	IF((.NOT.LNR .AND.NLV) .OR.
45&		(LNR.AND.LHR.AND.NLV.AND.(BITS.NE.RLAND)))
46&		GO TO 800
47C
48500	MOVETO=.TRUE.
49C						!MOVE SHOULD SUCCEED.
50	IF(and(RFLAG(NR),RMUNG).EQ.0) GO TO 600
51	CALL RSPEAK(RRAND(NR))
52C						!YES, TELL HOW.
53	RETURN
54C
55600	IF(WHO.NE.PLAYER) CALL NEWSTA(AOBJ(WHO),0,NR,0,0)
56	IF(J.NE.0) CALL NEWSTA(J,0,NR,0,0)
57	HERE=NR
58	AROOM(WHO)=HERE
59	CALL SCRUPD(RVAL(NR))
60C						!SCORE ROOM
61	RVAL(NR)=0
62	RETURN
63C
64800	CALL RSPSUB(428,ODESC2(J))
65C						!WRONG VEHICLE.
66	RETURN
67	END
68C SCORE-- PRINT OUT CURRENT SCORE
69C
70C DECLARATIONS
71C
72	SUBROUTINE SCORE(FLG)
73	IMPLICIT INTEGER (A-Z)
74	LOGICAL FLG
75	INTEGER RANK(10),ERANK(5)
76#include "gamestate.h"
77#include "state.h"
78C
79	COMMON /CHAN/ INPCH,OUTCH,DBCH
80#include "advers.h"
81#include "flags.h"
82C
83C FUNCTIONS AND DATA
84C
85	DATA RANK/20,19,18,16,12,8,4,2,1,0/
86	DATA ERANK/20,15,10,5,0/
87C SCORE, PAGE 2
88C
89	AS=ASCORE(WINNER)
90C
91	IF(ENDGMF) GO TO 60
92C						!ENDGAME?
93#ifdef PDP
94	call pscore(AS,MXSCOR,MOVES)
95#else
96#ifdef NOCC
97 	IF(FLG.AND.MOVES.NE.1) WRITE(OUTCH,100) AS,MXSCOR,MOVES
98 	IF(FLG.AND.MOVES.EQ.1) WRITE(OUTCH,120) AS,MXSCOR,MOVES
99 	IF(.NOT.FLG.AND.MOVES.NE.1) WRITE(OUTCH,110) AS,MXSCOR,MOVES
100 	IF(.NOT.FLG.AND.MOVES.EQ.1) WRITE(OUTCH,130) AS,MXSCOR,MOVES
101#else NOCC
102 	IF(FLG) WRITE(OUTCH,100)
103 	IF(.NOT.FLG) WRITE(OUTCH,110)
104 	IF(MOVES.NE.1) WRITE(OUTCH,120) AS,MXSCOR,MOVES
105 	IF(MOVES.EQ.1) WRITE(OUTCH,130) AS,MXSCOR,MOVES
106#endif NOCC
107#endif PDP
108C
109	DO 10 I=1,10
110	  IF((AS*20/MXSCOR).GE.RANK(I)) GO TO 50
11110	CONTINUE
11250	CALL RSPEAK(484+I)
113	RETURN
114C
115#ifdef PDP
11660	continue
117	call pscore(EGSCOR,EGMXSC,MOVES)
118#else
119#ifdef NOCC
12060	IF(FLG) WRITE(OUTCH,140) EGSCOR,EGMXSC,MOVES
121 	IF(.NOT.FLG) WRITE(OUTCH,150) EGSCOR,EGMXSC,MOVES
122#else NOCC
12360	IF(FLG) WRITE(OUTCH,140)
124 	IF(.NOT.FLG) WRITE(OUTCH,150)
125 	WRITE(OUTCH,120) EGSCOR,EGMXSC,MOVES
126#endif NOCC
127#endif PDP
128	DO 70 I=1,5
129	  IF((EGSCOR*20/EGMXSC).GE.ERANK(I)) GO TO 80
13070	CONTINUE
13180	CALL RSPEAK(786+I)
132	RETURN
133
134#ifndef PDP
135#ifdef NOCC
136100	FORMAT('Your score would be',I4,' [total of',I4,' points], in',
137&		I5,' moves.')
138110	FORMAT('Your score is',I4,' [total of',I4,' points], in',
139&		I5,' moves.')
140120	FORMAT('Your score would be',I4,' [total of',I4,' points], in',
141&		I5,' move.')
142130	FORMAT('Your score is',I4,' [total of',I4,' points], in',
143&		I5,' move.')
144140	FORMAT('Your score in the endgame would be',I4,' [total of',
145&		I4,' points], in',I5,' moves.')
146150	FORMAT('Your score in the endgame is',I4,' [total of',
147&		I4,' points], in',I5,' moves.')
148#else NOCC
149100	FORMAT(' Your score would be',$)
150110	FORMAT(' Your score is',$)
151120	FORMAT('+',I4,' [total of',I4,' points], in',I5,' moves.')
152130	FORMAT('+',I4,' [total of',I4,' points], in',I5,' move.')
153140	FORMAT(' Your score in the endgame would be',$)
154150	FORMAT(' Your score in the endgame is',$)
155#endif NOCC
156#endif PDP
157C
158	END
159C SCRUPD- UPDATE WINNER'S SCORE
160C
161C DECLARATIONS
162C
163	SUBROUTINE SCRUPD(N)
164	IMPLICIT INTEGER (A-Z)
165#include "gamestate.h"
166#include "state.h"
167#include "clock.h"
168#include "advers.h"
169#include "flags.h"
170C
171	IF(ENDGMF) GO TO 100
172C						!ENDGAME?
173	ASCORE(WINNER)=ASCORE(WINNER)+N
174C						!UPDATE SCORE
175	RWSCOR=RWSCOR+N
176C						!UPDATE RAW SCORE
177	IF(ASCORE(WINNER).LT.(MXSCOR-(10*DEATHS))) RETURN
178	CFLAG(CEVEGH)=.TRUE.
179C						!TURN ON END GAME
180	CTICK(CEVEGH)=15
181	RETURN
182C
183100	EGSCOR=EGSCOR+N
184C						!UPDATE EG SCORE.
185	RETURN
186	END
187