dso3.for 2.7 KB

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