Return to dso3.F CVS log

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

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

1.1     ! root        1: C FINDXT- FIND EXIT FROM 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 FINDXT(DIR,RM)
        !            10:        IMPLICIT INTEGER (A-Z)
        !            11: #include "rooms.h"
        !            12: #include "exits.h"
        !            13: #include "curxt.h"
        !            14: #include "xpars.h"
        !            15: C
        !            16:        FINDXT=.TRUE.
        !            17: C                                              !ASSUME WINS.
        !            18:        XI=REXIT(RM)
        !            19: C                                              !FIND FIRST ENTRY.
        !            20:        IF(XI.EQ.0) GO TO 1000
        !            21: C                                              !NO EXITS?
        !            22: C
        !            23: 100    I=TRAVEL(XI)
        !            24: C                                              !GET ENTRY.
        !            25:        XROOM1=and(I,XRMASK)
        !            26: c mask to 16-bits to get rid of sign extension problems with 32-bit ints
        !            27:        XXXFLG = and(not(XLFLAG), 65535)
        !            28:        XTYPE=and((and(I,XXXFLG)/XFSHFT),XFMASK)+1
        !            29:        GO TO (110,120,130,130),XTYPE
        !            30: C                                              !BRANCH ON ENTRY.
        !            31:        CALL BUG(10,XTYPE)
        !            32: C
        !            33: 130    XOBJ=and(TRAVEL(XI+2),XRMASK)
        !            34:        XACTIO=TRAVEL(XI+2)/XASHFT
        !            35: 120    XSTRNG=TRAVEL(XI+1)
        !            36: C                                              !DOOR/CEXIT/NEXIT - STRING.
        !            37: 110    XI=XI+XELNT(XTYPE)
        !            38: C                                              !ADVANCE TO NEXT ENTRY.
        !            39:        IF(and(I,XDMASK).EQ.DIR) RETURN
        !            40:        IF(and(I,XLFLAG).EQ.0) GO TO 100
        !            41: 1000   FINDXT=.FALSE.
        !            42: C                                              !YES, LOSE.
        !            43:        RETURN
        !            44:        END
        !            45: C FWIM- FIND WHAT I MEAN
        !            46: C
        !            47: C DECLARATIONS
        !            48: C
        !            49:        INTEGER FUNCTION FWIM(F1,F2,RM,CON,ADV,NOCARE)
        !            50:        IMPLICIT INTEGER (A-Z)
        !            51:        LOGICAL NOCARE
        !            52: #include "objects.h"
        !            53: #include "oflags.h"
        !            54: C
        !            55:        FWIM=0
        !            56: C                                              !ASSUME NOTHING.
        !            57:        DO 1000 I=1,OLNT
        !            58: C                                              !LOOP
        !            59:          IF(((RM.EQ.0).OR.(OROOM(I).NE.RM)) .AND.
        !            60: &              ((ADV.EQ.0).OR.(OADV(I).NE.ADV)) .AND.
        !            61: &              ((CON.EQ.0).OR.(OCAN(I).NE.CON)))
        !            62: &              GO TO 1000
        !            63: C
        !            64: C OBJECT IS ON LIST... IS IT A MATCH?
        !            65: C
        !            66:          IF(and(OFLAG1(I),VISIBT).EQ.0) GO TO 1000
        !            67:          IF(and(not(NOCARE),(and(OFLAG1(I),TAKEBT).EQ.0)) .OR.
        !            68: &              ((and(OFLAG1(I),F1).EQ.0).AND.
        !            69: &               (and(OFLAG2(I),F2).EQ.0))) GO TO 500
        !            70:          IF(FWIM.EQ.0) GO TO 400
        !            71: C                                              !ALREADY GOT SOMETHING?
        !            72:          FWIM=-FWIM
        !            73: C                                              !YES, AMBIGUOUS.
        !            74:          RETURN
        !            75: C
        !            76: 400      FWIM=I
        !            77: C                                              !NOTE MATCH.
        !            78: C
        !            79: C DOES OBJECT CONTAIN A MATCH?
        !            80: C
        !            81: 500      IF(and(OFLAG2(I),OPENBT).EQ.0) GO TO 1000
        !            82:          DO 700 J=1,OLNT
        !            83: C                                              !NO, SEARCH CONTENTS.
        !            84:            IF((OCAN(J).NE.I).OR.(and(OFLAG1(J),VISIBT).EQ.0) .OR.
        !            85: &              ((and(OFLAG1(J),F1).EQ.0).AND.
        !            86: &               (and(OFLAG2(J),F2).EQ.0))) GO TO 700
        !            87:            IF(FWIM.EQ.0) GO TO 600
        !            88:            FWIM=-FWIM
        !            89:            RETURN
        !            90: C
        !            91: 600        FWIM=J
        !            92: 700      CONTINUE
        !            93: 1000   CONTINUE
        !            94:        RETURN
        !            95:        END
        !            96: C YESNO- OBTAIN YES/NO ANSWER
        !            97: C
        !            98: C CALLED BY-
        !            99: C
        !           100: C      YES-IS-TRUE=YESNO(QUESTION,YES-STRING,NO-STRING)
        !           101: C
        !           102:        LOGICAL FUNCTION YESNO(Q,Y,N)
        !           103:        IMPLICIT INTEGER(A-Z)
        !           104:        COMMON /CHAN/ INPCH,OUTCH,DBCH
        !           105:        CHARACTER ANS
        !           106: C
        !           107: 100    CALL RSPEAK(Q)
        !           108: C                                              !ASK
        !           109: #ifdef PDP
        !           110:        call rdchr(ANS)
        !           111: #else
        !           112:        READ(INPCH,110) ANS
        !           113: #endif PDP
        !           114: C                                              !GET ANSWER
        !           115: 110    FORMAT(A1)
        !           116:        IF((ANS.EQ.'Y').OR.(ANS.EQ.'y')) GO TO 200
        !           117:        IF((ANS.EQ.'N').OR.(ANS.EQ.'n')) GO TO 300
        !           118:        CALL RSPEAK(6)
        !           119: C                                              !SCOLD.
        !           120:        GO TO 100
        !           121: C
        !           122: 200    YESNO=.TRUE.
        !           123: C                                              !YES,
        !           124:        CALL RSPEAK(Y)
        !           125: C                                              !OUT WITH IT.
        !           126:        RETURN
        !           127: C
        !           128: 300    YESNO=.FALSE.
        !           129: C                                              !NO,
        !           130:        CALL RSPEAK(N)
        !           131: C                                              !LIKEWISE.
        !           132:        RETURN
        !           133: C
        !           134:        END

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