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