1: C MOVETO- MOVE PLAYER TO NEW ROOM
   2: C
   3: C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
   4: C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
   5: C WRITTEN BY R. M. SUPNIK
   6: C
   7: C DECLARATIONS
   8: C
   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"
  18: C MOVETO, PAGE 2
  19: C
  20:         MOVETO=.FALSE.
  21: C						!ASSUME FAILS.
  22:         LHR=and(RFLAG(HERE),RLAND).NE.0
  23:         LNR=and(RFLAG(NR),RLAND).NE.0
  24:         J=AVEHIC(WHO)
  25: C						!HIS VEHICLE
  26: C
  27:         IF(J.NE.0) GO TO 100
  28: C						!IN VEHICLE?
  29:         IF(LNR) GO TO 500
  30: C						!NO, GOING TO LAND?
  31:         CALL RSPEAK(427)
  32: C						!CAN'T GO WITHOUT VEHICLE.
  33:         RETURN
  34: C
  35: 100     BITS=0
  36: C						!ASSUME NOWHERE.
  37:         IF(J.EQ.RBOAT) BITS=RWATER
  38: C						!IN BOAT?
  39:         IF(J.EQ.BALLO) BITS=RAIR
  40: C						!IN BALLOON?
  41:         IF(J.EQ.BUCKE) BITS=RBUCK
  42: C						!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
  47: C
  48: 500     MOVETO=.TRUE.
  49: C						!MOVE SHOULD SUCCEED.
  50:         IF(and(RFLAG(NR),RMUNG).EQ.0) GO TO 600
  51:         CALL RSPEAK(RRAND(NR))
  52: C						!YES, TELL HOW.
  53:         RETURN
  54: C
  55: 600     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))
  60: C						!SCORE ROOM
  61:         RVAL(NR)=0
  62:         RETURN
  63: C
  64: 800     CALL RSPSUB(428,ODESC2(J))
  65: C						!WRONG VEHICLE.
  66:         RETURN
  67:         END
  68: C SCORE-- PRINT OUT CURRENT SCORE
  69: C
  70: C DECLARATIONS
  71: C
  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"
  78: C
  79:         COMMON /CHAN/ INPCH,OUTCH,DBCH
  80: #include "advers.h"
  81: #include "flags.h"
  82: C
  83: C FUNCTIONS AND DATA
  84: C
  85:         DATA RANK/20,19,18,16,12,8,4,2,1,0/
  86:         DATA ERANK/20,15,10,5,0/
  87: C SCORE, PAGE 2
  88: C
  89:         AS=ASCORE(WINNER)
  90: C
  91:         IF(ENDGMF) GO TO 60
  92: C						!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
 108: C
 109:         DO 10 I=1,10
 110:           IF((AS*20/MXSCOR).GE.RANK(I)) GO TO 50
 111: 10      CONTINUE
 112: 50      CALL RSPEAK(484+I)
 113:         RETURN
 114: C
 115: #ifdef PDP
 116: 60      continue
 117:         call pscore(EGSCOR,EGMXSC,MOVES)
 118: #else
 119: #ifdef NOCC
 120: 60      IF(FLG) WRITE(OUTCH,140) EGSCOR,EGMXSC,MOVES
 121:         IF(.NOT.FLG) WRITE(OUTCH,150) EGSCOR,EGMXSC,MOVES
 122: #else NOCC
 123: 60      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
 130: 70      CONTINUE
 131: 80      CALL RSPEAK(786+I)
 132:         RETURN
 133: 
 134: #ifndef PDP
 135: #ifdef NOCC
 136: 100     FORMAT('Your score would be',I4,' [total of',I4,' points], in',
 137: &               I5,' moves.')
 138: 110     FORMAT('Your score is',I4,' [total of',I4,' points], in',
 139: &               I5,' moves.')
 140: 120     FORMAT('Your score would be',I4,' [total of',I4,' points], in',
 141: &               I5,' move.')
 142: 130     FORMAT('Your score is',I4,' [total of',I4,' points], in',
 143: &               I5,' move.')
 144: 140     FORMAT('Your score in the endgame would be',I4,' [total of',
 145: &               I4,' points], in',I5,' moves.')
 146: 150     FORMAT('Your score in the endgame is',I4,' [total of',
 147: &               I4,' points], in',I5,' moves.')
 148: #else NOCC
 149: 100     FORMAT(' Your score would be',$)
 150: 110     FORMAT(' Your score is',$)
 151: 120     FORMAT('+',I4,' [total of',I4,' points], in',I5,' moves.')
 152: 130     FORMAT('+',I4,' [total of',I4,' points], in',I5,' move.')
 153: 140     FORMAT(' Your score in the endgame would be',$)
 154: 150     FORMAT(' Your score in the endgame is',$)
 155: #endif NOCC
 156: #endif PDP
 157: C
 158:         END
 159: C SCRUPD- UPDATE WINNER'S SCORE
 160: C
 161: C DECLARATIONS
 162: C
 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"
 170: C
 171:         IF(ENDGMF) GO TO 100
 172: C						!ENDGAME?
 173:         ASCORE(WINNER)=ASCORE(WINNER)+N
 174: C						!UPDATE SCORE
 175:         RWSCOR=RWSCOR+N
 176: C						!UPDATE RAW SCORE
 177:         IF(ASCORE(WINNER).LT.(MXSCOR-(10*DEATHS))) RETURN
 178:         CFLAG(CEVEGH)=.TRUE.
 179: C						!TURN ON END GAME
 180:         CTICK(CEVEGH)=15
 181:         RETURN
 182: C
 183: 100     EGSCOR=EGSCOR+N
 184: C						!UPDATE EG SCORE.
 185:         RETURN
 186:         END
Last modified: 1988-10-21
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1972
Valid CSS Valid XHTML 1.0 Strict