# 2.11BSD#431 - /usr/src/new/PORT/dungeon/dso2.F

       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: 645 |