Annotation of 43BSDReno/games/dungeon/dso3.F, revision 1.1.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

unix.superglobalmegacorp.com

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