Annotation of 43BSDReno/games/dungeon/dso2.F, revision 1.1.1.1

1.1       root        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

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.