home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / games / volume2 / dungeon / part05 / dso2.F < prev    next >
Text File  |  1987-09-01  |  3KB  |  160 lines
  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.      IF(FLG) WRITE(OUTCH,100)
  97.      IF(.NOT.FLG) WRITE(OUTCH,110)
  98.      IF(MOVES.NE.1) WRITE(OUTCH,120) AS,MXSCOR,MOVES
  99.      IF(MOVES.EQ.1) WRITE(OUTCH,130) AS,MXSCOR,MOVES
  100. #endif PDP
  101. C
  102.     DO 10 I=1,10
  103.       IF((AS*20/MXSCOR).GE.RANK(I)) GO TO 50
  104. 10    CONTINUE
  105. 50    CALL RSPEAK(484+I)
  106.     RETURN
  107. C
  108. #ifdef PDP
  109. 60    continue
  110.     call pscore(EGSCOR,EGMXSC,MOVES)
  111. #else
  112. 60    IF(FLG) WRITE(OUTCH,140)
  113.      IF(.NOT.FLG) WRITE(OUTCH,150)
  114.      WRITE(OUTCH,120) EGSCOR,EGMXSC,MOVES
  115. #endif PDP
  116.     DO 70 I=1,5
  117.       IF((EGSCOR*20/EGMXSC).GE.ERANK(I)) GO TO 80
  118. 70    CONTINUE
  119. 80    CALL RSPEAK(786+I)
  120.     RETURN
  121.  
  122. #ifndef PDP
  123. 100    FORMAT(' Your score would be',$)
  124. 110    FORMAT(' Your score is',$)
  125. 120    FORMAT('+',I4,' [total of',I4,' points], in',I5,' moves.')
  126. 130    FORMAT('+',I4,' [total of',I4,' points], in',I5,' move.')
  127. 140    FORMAT(' Your score in the endgame would be',$)
  128. 150    FORMAT(' Your score in the endgame is',$)
  129. #endif PDP
  130. C
  131.     END
  132. C SCRUPD- UPDATE WINNER'S SCORE
  133. C
  134. C DECLARATIONS
  135. C
  136.     SUBROUTINE SCRUPD(N)
  137.     IMPLICIT INTEGER (A-Z)
  138. #include "gamestate.h"
  139. #include "state.h"
  140. #include "clock.h"
  141. #include "advers.h"
  142. #include "flags.h"
  143. C
  144.     IF(ENDGMF) GO TO 100
  145. C                        !ENDGAME?
  146.     ASCORE(WINNER)=ASCORE(WINNER)+N
  147. C                        !UPDATE SCORE
  148.     RWSCOR=RWSCOR+N
  149. C                        !UPDATE RAW SCORE
  150.     IF(ASCORE(WINNER).LT.(MXSCOR-(10*DEATHS))) RETURN
  151.     CFLAG(CEVEGH)=.TRUE.
  152. C                        !TURN ON END GAME
  153.     CTICK(CEVEGH)=15
  154.     RETURN
  155. C
  156. 100    EGSCOR=EGSCOR+N
  157. C                        !UPDATE EG SCORE.
  158.     RETURN
  159.     END
  160.