home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / games / volume2 / dungeon / part07 / dso5.F < prev    next >
Text File  |  1987-09-01  |  3KB  |  137 lines
  1. C
  2. C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  3. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  4. C WRITTEN BY R. M. SUPNIK
  5. C
  6. #ifndef PDP    /* replaced by C function for pdp */
  7. C GTTIME-- GET TOTAL TIME PLAYED
  8. C
  9. C DECLARATIONS
  10. C
  11.      SUBROUTINE GTTIME(T)
  12.      IMPLICIT INTEGER(A-Z)
  13. C
  14.      COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
  15. C
  16.      CALL ITIME(H,M,S)
  17.      T=((H*60)+M)-((SHOUR*60)+SMIN)
  18.      IF(T.LT.0) T=T+1440
  19.      T=T+PLTIME
  20.      RETURN
  21.      END
  22. #endif PDP
  23. C OPNCLS-- PROCESS OPEN/CLOSE FOR DOORS
  24. C
  25. C DECLARATIONS
  26. C
  27.     LOGICAL FUNCTION OPNCLS(OBJ,SO,SC)
  28.     IMPLICIT INTEGER (A-Z)
  29.     LOGICAL QOPEN
  30. #include "parser.h"
  31. #include "objects.h"
  32. #include "oflags.h"
  33. #include "verbs.h"
  34. C
  35. C FUNCTIONS AND DATA
  36. C
  37.     QOPEN(O)=and(OFLAG2(O),OPENBT).NE.0
  38. C
  39.     OPNCLS=.TRUE.
  40. C                        !ASSUME WINS.
  41.     IF(PRSA.EQ.CLOSEW) GO TO 100
  42. C                        !CLOSE?
  43.     IF(PRSA.EQ.OPENW) GO TO 50
  44. C                        !OPEN?
  45.     OPNCLS=.FALSE.
  46. C                        !LOSE
  47.     RETURN
  48. C
  49. 50    IF(QOPEN(OBJ)) GO TO 200
  50. C                        !OPEN... IS IT?
  51.     CALL RSPEAK(SO)
  52.     OFLAG2(OBJ)=or(OFLAG2(OBJ),OPENBT)
  53.     RETURN
  54. C
  55. 100    IF(.NOT.QOPEN(OBJ)) GO TO 200
  56. C                        !CLOSE... IS IT?
  57.     CALL RSPEAK(SC)
  58.     OFLAG2(OBJ)=and(OFLAG2(OBJ),not(OPENBT))
  59.     RETURN
  60. C
  61. 200    CALL RSPEAK(125+RND(3))
  62. C                        !DUMMY.
  63.     RETURN
  64.     END
  65. C LIT-- IS ROOM LIT?
  66. C
  67. C DECLARATIONS
  68. C
  69.     LOGICAL FUNCTION LIT(RM)
  70.     IMPLICIT INTEGER (A-Z)
  71.     LOGICAL QHERE
  72. #include "rooms.h"
  73. #include "rflag.h"
  74. #include "objects.h"
  75. #include "oflags.h"
  76. #include "advers.h"
  77. C
  78.     LIT=.TRUE.
  79. C                        !ASSUME WINS
  80.     IF(and(RFLAG(RM),RLIGHT).NE.0) RETURN
  81. C
  82.     DO 1000 I=1,OLNT
  83. C                        !LOOK FOR LIT OBJ
  84.       IF(QHERE(I,RM)) GO TO 100
  85. C                        !IN ROOM?
  86.       OA=OADV(I)
  87. C                        !NO
  88.       IF(OA.LE.0) GO TO 1000
  89. C                        !ON ADV?
  90.       IF(AROOM(OA).NE.RM) GO TO 1000
  91. C                        !ADV IN ROOM?
  92. C
  93. C OBJ IN ROOM OR ON ADV IN ROOM
  94. C
  95. 100      IF(and(OFLAG1(I),ONBT).NE.0) RETURN
  96.       IF((and(OFLAG1(I),VISIBT).EQ.0).OR.
  97. &        ((and(OFLAG1(I),TRANBT).EQ.0).AND.
  98. &        (and(OFLAG2(I),OPENBT).EQ.0))) GO TO 1000
  99. C
  100. C OBJ IS VISIBLE AND OPEN OR TRANSPARENT
  101. C
  102.       DO 500 J=1,OLNT
  103.         IF((OCAN(J).EQ.I).AND.(and(OFLAG1(J),ONBT).NE.0))
  104. &        RETURN
  105. 500      CONTINUE
  106. 1000    CONTINUE
  107.     LIT=.FALSE.
  108.     RETURN
  109.     END
  110. C WEIGHT- RETURNS SUM OF WEIGHT OF QUALIFYING OBJECTS
  111. C
  112. C DECLARATIONS
  113. C
  114.     INTEGER FUNCTION WEIGHT(RM,CN,AD)
  115.     IMPLICIT INTEGER (A-Z)
  116.     LOGICAL QHERE
  117. #include "objects.h"
  118. C
  119.     WEIGHT=0
  120.     DO 100 I=1,OLNT
  121. C                        !OMIT BIG FIXED ITEMS.
  122.       IF(OSIZE(I).GE.10000) GO TO 100
  123. C                        !IF FIXED, FORGET IT.
  124.       IF((QHERE(I,RM).AND.(RM.NE.0)).OR.
  125. &        ((OADV(I).EQ.AD).AND.(AD.NE.0))) GO TO 50
  126.       J=I
  127. C                        !SEE IF CONTAINED.
  128. 25      J=OCAN(J)
  129. C                        !GET NEXT LEVEL UP.
  130.       IF(J.EQ.0) GO TO 100
  131. C                        !END OF LIST?
  132.       IF(J.NE.CN) GO TO 25
  133. 50      WEIGHT=WEIGHT+OSIZE(I)
  134. 100    CONTINUE
  135.     RETURN
  136.     END
  137.