Return to dso7.F CVS log

Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon

Annotation of 43BSDReno/games/dungeon/dso7.F, revision 1.1

1.1     ! root        1: C ENCRYP--     ENCRYPT PASSWORD
        !             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:        SUBROUTINE ENCRYP(INW,OUTW)
        !            10:        IMPLICIT INTEGER(A-Z)
        !            11:        CHARACTER INW(6),OUTW(6)
        !            12:        CHARACTER  KEYW(6),UKEYW(6)
        !            13:        INTEGER UINW(6)
        !            14:        DATA KEYW/'E','C','O','R','M','S'/
        !            15: C
        !            16:        UINWS=0
        !            17: C                                              !UNBIASED INW SUM.
        !            18:        UKEYWS=0
        !            19: C                                              !UNBIASED KEYW SUM.
        !            20:        J=1
        !            21: C                                              !POINTER IN KEYWORD.
        !            22:        DO 100 I=1,6
        !            23: C                                              !UNBIAS, COMPUTE SUMS.
        !            24:          UKEYW(I)=char(ichar(KEYW(I))-64)
        !            25:          IF(INW(J).LE.char(64)) J=1
        !            26:          UINW(I)=ichar(ichar(INW(J))-64)
        !            27:          UKEYWS=UKEYWS+ichar(UKEYW(I))
        !            28:          UINWS=UINWS+UINW(I)
        !            29:          J=J+1
        !            30: 100    CONTINUE
        !            31: C
        !            32:        USUM=MOD(UINWS,8)+(8*MOD(UKEYWS,8))
        !            33: C                                              !COMPUTE MASK.
        !            34:        DO 200 I=1,6
        !            35:          J=and(xor(xor(ichar(UINW(I)),ichar(UKEYW(I))),USUM),31)
        !            36:          USUM=MOD(USUM+1,32)
        !            37:          IF(J.GT.26) J=MOD(J,26)
        !            38:          OUTW(I)=char(MAX0(1,J)+64)
        !            39: 200    CONTINUE
        !            40:        RETURN
        !            41: C
        !            42:        END
        !            43: C CPGOTO--     MOVE TO NEXT STATE IN PUZZLE ROOM
        !            44: C
        !            45: C DECLARATIONS
        !            46: C
        !            47:        SUBROUTINE CPGOTO(ST)
        !            48:        IMPLICIT INTEGER(A-Z)
        !            49: C
        !            50:        COMMON /HYPER/ HFACTR
        !            51: #include "rooms.h"
        !            52: #include "rflag.h"
        !            53: #include "rindex.h"
        !            54: #include "objects.h"
        !            55: #include "oflags.h"
        !            56: #include "flags.h"
        !            57: C CPGOTO, PAGE 2
        !            58: C
        !            59:        RFLAG(CPUZZ)=and(RFLAG(CPUZZ),not(RSEEN))
        !            60:        DO 100 I=1,OLNT
        !            61: C                                              !RELOCATE OBJECTS.
        !            62:          IF((OROOM(I).EQ.CPUZZ).AND.
        !            63: &              (and(OFLAG2(I),(ACTRBT+VILLBT)).EQ.0))
        !            64: &              CALL NEWSTA(I,0,CPHERE*HFACTR,0,0)
        !            65:          IF(OROOM(I).EQ.(ST*HFACTR))
        !            66: &              CALL NEWSTA(I,0,CPUZZ,0,0)
        !            67: 100    CONTINUE
        !            68:        CPHERE=ST
        !            69:        RETURN
        !            70: C
        !            71:        END
        !            72: C CPINFO--     DESCRIBE PUZZLE ROOM
        !            73: C
        !            74: C DECLARATIONS
        !            75: C
        !            76:        SUBROUTINE CPINFO(RMK,ST)
        !            77:        IMPLICIT INTEGER(A-Z)
        !            78:        INTEGER DGMOFT(8)
        !            79:        CHARACTER  DGM(8),PICT(5),QMK
        !            80: C
        !            81:        COMMON /CHAN/ INPCH,OUTCH,DBCH
        !            82: C
        !            83: C PUZZLE ROOM
        !            84: C
        !            85:        COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64)
        !            86: #include "flags.h"
        !            87: C
        !            88: C FUNCTIONS AND LOCAL DATA
        !            89: C
        !            90: C
        !            91:        DATA DGMOFT/-9,-8,-7,-1,1,7,8,9/
        !            92: #ifdef PDP
        !            93: C
        !            94: C      PICT, DGM and QMK have been changed from two to
        !            95: C      one character in length. Puzout prints two copies.
        !            96: C
        !            97:        DATA PICT/'S','S','S',' ','M'/
        !            98:        DATA QMK/'?'/
        !            99: #else
        !           100:        DATA PICT/'SS','SS','SS','  ','MM'/
        !           101:        DATA QMK/'??'/
        !           102: #endif PDP
        !           103: C CPINFO, PAGE 2
        !           104: C
        !           105:        CALL RSPEAK(RMK)
        !           106:        DO 100 I=1,8
        !           107:          J=DGMOFT(I)
        !           108:          DGM(I)=PICT(CPVEC(ST+J)+4)
        !           109: C                                              !GET PICTURE ELEMENT.
        !           110:          IF((IABS(J).EQ.1).OR.(IABS(J).EQ.8)) GO TO 100
        !           111:          K=8
        !           112:          IF(J.LT.0) K=-8
        !           113: C                                              !GET ORTHO DIR.
        !           114:          L=J-K
        !           115:          IF((CPVEC(ST+K).NE.0).AND.(CPVEC(ST+L).NE.0))
        !           116: &              DGM(I)=QMK
        !           117: 100    CONTINUE
        !           118: #ifdef PDP
        !           119:        call puzout(DGM(1))
        !           120: #else
        !           121:        WRITE(OUTCH,10) DGM
        !           122: #endif
        !           123: C
        !           124:        IF(ST.EQ.10) CALL RSPEAK(870)
        !           125: C                                              !AT HOLE?
        !           126:        IF(ST.EQ.37) CALL RSPEAK(871)
        !           127: C                                              !AT NICHE?
        !           128:        I=872
        !           129: C                                              !DOOR OPEN?
        !           130:        IF(CPOUTF) I=873
        !           131:        IF(ST.EQ.52) CALL RSPEAK(I)
        !           132: C                                              !AT DOOR?
        !           133:        IF(CPVEC(ST+1).EQ.-2) CALL RSPEAK(874)
        !           134: C                                              !EAST LADDER?
        !           135:        IF(CPVEC(ST-1).EQ.-3) CALL RSPEAK(875)
        !           136: C                                              !WEST LADDER?
        !           137:        RETURN
        !           138: C
        !           139: #ifndef PDP
        !           140: 10     FORMAT('       |',A2,1X,A2,1X,A2,'|'/,
        !           141: &      ' West  |',A2,' .. ',A2,'|  East',/
        !           142: &      '       |',A2,1X,A2,1X,A2,'|')
        !           143: #endif PDP
        !           144: C
        !           145:        END

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