DataMuseum.dk

top - metrics - download

    Length: 4230 (0x1086)
    Types: TextFile
    Names: »dso2.F«

└─⟦b20c6495f⟧ Bits:30007238 EUUGD18: Wien-båndet, efterår 1987
    └─⟦this⟧ »EUUGD18/General/Zork/dso2.F« 

TextFile

C MOVETO- MOVE PLAYER TO NEW ROOM
C
C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C DECLARATIONS
C
	LOGICAL FUNCTION MOVETO(NR,WHO)
	IMPLICIT INTEGER (A-Z)
	LOGICAL NLV,LHR,LNR
#include "gamestate.h"
#include "rooms.h"
#include "rflag.h"
#include "objects.h"
#include "oindex.h"
#include "advers.h"
C MOVETO, PAGE 2
C
	MOVETO=.FALSE.
C						!ASSUME FAILS.
	LHR=and(RFLAG(HERE),RLAND).NE.0
	LNR=and(RFLAG(NR),RLAND).NE.0
	J=AVEHIC(WHO)
C						!HIS VEHICLE
C
	IF(J.NE.0) GO TO 100
C						!IN VEHICLE?
	IF(LNR) GO TO 500
C						!NO, GOING TO LAND?
	CALL RSPEAK(427)
C						!CAN'T GO WITHOUT VEHICLE.
	RETURN
C
100	BITS=0
C						!ASSUME NOWHERE.
	IF(J.EQ.RBOAT) BITS=RWATER
C						!IN BOAT?
	IF(J.EQ.BALLO) BITS=RAIR
C						!IN BALLOON?
	IF(J.EQ.BUCKE) BITS=RBUCK
C						!IN BUCKET?
	NLV=and(RFLAG(NR),BITS).EQ.0
	IF((.NOT.LNR .AND.NLV) .OR.
&		(LNR.AND.LHR.AND.NLV.AND.(BITS.NE.RLAND)))
&		GO TO 800
C
500	MOVETO=.TRUE.
C						!MOVE SHOULD SUCCEED.
	IF(and(RFLAG(NR),RMUNG).EQ.0) GO TO 600
	CALL RSPEAK(RRAND(NR))
C						!YES, TELL HOW.
	RETURN
C
600	IF(WHO.NE.PLAYER) CALL NEWSTA(AOBJ(WHO),0,NR,0,0)
	IF(J.NE.0) CALL NEWSTA(J,0,NR,0,0)
	HERE=NR
	AROOM(WHO)=HERE
	CALL SCRUPD(RVAL(NR))
C						!SCORE ROOM
	RVAL(NR)=0
	RETURN
C
800	CALL RSPSUB(428,ODESC2(J))
C						!WRONG VEHICLE.
	RETURN
	END
C SCORE-- PRINT OUT CURRENT SCORE
C
C DECLARATIONS
C
	SUBROUTINE SCORE(FLG)
	IMPLICIT INTEGER (A-Z)
	LOGICAL FLG
	INTEGER RANK(10),ERANK(5)
#include "gamestate.h"
#include "state.h"
C
	COMMON /CHAN/ INPCH,OUTCH,DBCH
#include "advers.h"
#include "flags.h"
C
C FUNCTIONS AND DATA
C
	DATA RANK/20,19,18,16,12,8,4,2,1,0/
	DATA ERANK/20,15,10,5,0/
C SCORE, PAGE 2
C
	AS=ASCORE(WINNER)
C
	IF(ENDGMF) GO TO 60
C						!ENDGAME?
#ifdef PDP
	call pscore(AS,MXSCOR,MOVES)
#else
#ifdef NOCC
 	IF(FLG.AND.MOVES.NE.1) WRITE(OUTCH,100) AS,MXSCOR,MOVES
 	IF(FLG.AND.MOVES.EQ.1) WRITE(OUTCH,120) AS,MXSCOR,MOVES
 	IF(.NOT.FLG.AND.MOVES.NE.1) WRITE(OUTCH,110) AS,MXSCOR,MOVES
 	IF(.NOT.FLG.AND.MOVES.EQ.1) WRITE(OUTCH,130) AS,MXSCOR,MOVES
#else NOCC
 	IF(FLG) WRITE(OUTCH,100)
 	IF(.NOT.FLG) WRITE(OUTCH,110)
 	IF(MOVES.NE.1) WRITE(OUTCH,120) AS,MXSCOR,MOVES
 	IF(MOVES.EQ.1) WRITE(OUTCH,130) AS,MXSCOR,MOVES
#endif NOCC
#endif PDP
C
	DO 10 I=1,10
	  IF((AS*20/MXSCOR).GE.RANK(I)) GO TO 50
10	CONTINUE
50	CALL RSPEAK(484+I)
	RETURN
C
#ifdef PDP
60	continue
	call pscore(EGSCOR,EGMXSC,MOVES)
#else
#ifdef NOCC
60	IF(FLG) WRITE(OUTCH,140) EGSCOR,EGMXSC,MOVES
 	IF(.NOT.FLG) WRITE(OUTCH,150) EGSCOR,EGMXSC,MOVES
#else NOCC
60	IF(FLG) WRITE(OUTCH,140)
 	IF(.NOT.FLG) WRITE(OUTCH,150)
 	WRITE(OUTCH,120) EGSCOR,EGMXSC,MOVES
#endif NOCC
#endif PDP
	DO 70 I=1,5
	  IF((EGSCOR*20/EGMXSC).GE.ERANK(I)) GO TO 80
70	CONTINUE
80	CALL RSPEAK(786+I)
	RETURN

#ifndef PDP
#ifdef NOCC
100	FORMAT('Your score would be',I4,' [total of',I4,' points], in',
&		I5,' moves.')
110	FORMAT('Your score is',I4,' [total of',I4,' points], in',
&		I5,' moves.')
120	FORMAT('Your score would be',I4,' [total of',I4,' points], in',
&		I5,' move.')
130	FORMAT('Your score is',I4,' [total of',I4,' points], in',
&		I5,' move.')
140	FORMAT('Your score in the endgame would be',I4,' [total of',
&		I4,' points], in',I5,' moves.')
150	FORMAT('Your score in the endgame is',I4,' [total of',
&		I4,' points], in',I5,' moves.')
#else NOCC
100	FORMAT(' Your score would be',$)
110	FORMAT(' Your score is',$)
120	FORMAT('+',I4,' [total of',I4,' points], in',I5,' moves.')
130	FORMAT('+',I4,' [total of',I4,' points], in',I5,' move.')
140	FORMAT(' Your score in the endgame would be',$)
150	FORMAT(' Your score in the endgame is',$)
#endif NOCC
#endif PDP
C
	END
C SCRUPD- UPDATE WINNER'S SCORE
C
C DECLARATIONS
C
	SUBROUTINE SCRUPD(N)
	IMPLICIT INTEGER (A-Z)
#include "gamestate.h"
#include "state.h"
#include "clock.h"
#include "advers.h"
#include "flags.h"
C
	IF(ENDGMF) GO TO 100
C						!ENDGAME?
	ASCORE(WINNER)=ASCORE(WINNER)+N
C						!UPDATE SCORE
	RWSCOR=RWSCOR+N
C						!UPDATE RAW SCORE
	IF(ASCORE(WINNER).LT.(MXSCOR-(10*DEATHS))) RETURN
	CFLAG(CEVEGH)=.TRUE.
C						!TURN ON END GAME
	CTICK(CEVEGH)=15
	RETURN
C
100	EGSCOR=EGSCOR+N
C						!UPDATE EG SCORE.
	RETURN
	END