home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol047 / dso5.for < prev    next >
Encoding:
Text File  |  1984-04-29  |  4.6 KB  |  177 lines
  1. C GTTIME-- GET TOTAL TIME PLAYED
  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 GTTIME(T)
  10.     IMPLICIT INTEGER(A-Z)
  11. C
  12.     COMMON /TIME/ PLTIME,SHOUR,SMIN,SSEC
  13. C
  14.     CALL ITIME(H,M,S)
  15.     T=((H*60)+M)-((SHOUR*60)+SMIN)
  16.     IF(T.LT.0) T=T+1440
  17.     T=T+PLTIME
  18.     RETURN
  19.     END
  20. C OPNCLS-- PROCESS OPEN/CLOSE FOR DOORS
  21. C
  22. C DECLARATIONS
  23. C
  24.     LOGICAL FUNCTION OPNCLS(OBJ,SO,SC)
  25.     IMPLICIT INTEGER (A-Z)
  26.     LOGICAL QOPEN
  27. C
  28. C PARSER OUTPUT
  29. C
  30.     LOGICAL PRSWON
  31.     COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
  32. C
  33. C OBJECTS
  34. C
  35.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  36.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  37.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  38.     3    OADV(220),OCAN(220),OREAD(220)
  39. C
  40.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  41.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  42.     2    TOOLBT,TURNBT,ONBT
  43.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  44.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  45.     2    TCHBT,VEHBT,SCHBT
  46. C
  47. C VERBS
  48. C
  49.     COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW
  50.     COMMON /VINDEX/ WALKIW,FIGHTW,FOOW
  51.     COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW
  52.     COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW
  53.     COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW
  54.     COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW
  55.     COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW
  56.     COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW
  57.     COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
  58.     COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
  59.     COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW
  60.     COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW
  61.     COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW
  62. C
  63. C FUNCTIONS AND DATA
  64. C
  65.     QOPEN(O)=(OFLAG2(O).AND.OPENBT).NE.0
  66. C
  67.     OPNCLS=.TRUE.            !ASSUME WINS.
  68.     IF(PRSA.EQ.CLOSEW) GO TO 100    !CLOSE?
  69.     IF(PRSA.EQ.OPENW) GO TO 50    !OPEN?
  70.     OPNCLS=.FALSE.            !LOSE
  71.     RETURN
  72. C
  73. 50    IF(QOPEN(OBJ)) GO TO 200    !OPEN... IS IT?
  74.     CALL RSPEAK(SO)
  75.     OFLAG2(OBJ)=OFLAG2(OBJ).OR.OPENBT
  76.     RETURN
  77. C
  78. 100    IF(.NOT.QOPEN(OBJ)) GO TO 200    !CLOSE... IS IT?
  79.     CALL RSPEAK(SC)
  80.     OFLAG2(OBJ)=OFLAG2(OBJ).AND..NOT.OPENBT
  81.     RETURN
  82. C
  83. 200    CALL RSPEAK(125+RND(3))        !DUMMY.
  84.     RETURN
  85.     END
  86. C LIT-- IS ROOM LIT?
  87. C
  88. C DECLARATIONS
  89. C
  90.     LOGICAL FUNCTION LIT(RM)
  91.     IMPLICIT INTEGER (A-Z)
  92.     LOGICAL QHERE
  93. C
  94. C ROOMS
  95. C
  96.     COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
  97.     1    RACTIO(200),RVAL(200),RFLAG(200)
  98.     INTEGER RRAND(200)
  99.     EQUIVALENCE (RVAL,RRAND)
  100. C
  101.     COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
  102.     1    RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND
  103. C
  104. C OBJECTS
  105. C
  106.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  107.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  108.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  109.     3    OADV(220),OCAN(220),OREAD(220)
  110. C
  111.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  112.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  113.     2    TOOLBT,TURNBT,ONBT
  114.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  115.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  116.     2    TCHBT,VEHBT,SCHBT
  117. C
  118. C ADVENTURERS
  119. C
  120.     COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
  121.     1    AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
  122. C
  123.     LIT=.TRUE.                !ASSUME WINS
  124.     IF((RFLAG(RM).AND.RLIGHT).NE.0) RETURN    !ROOM LIT?
  125. C
  126.     DO 1000 I=1,OLNT            !LOOK FOR LIT OBJ
  127.       IF(QHERE(I,RM)) GO TO 100        !IN ROOM?
  128.       OA=OADV(I)                !NO
  129.       IF(OA.LE.0) GO TO 1000        !ON ADV?
  130.       IF(AROOM(OA).NE.RM) GO TO 1000    !ADV IN ROOM?
  131. C
  132. C OBJ IN ROOM OR ON ADV IN ROOM
  133. C
  134. 100      IF((OFLAG1(I).AND.ONBT).NE.0) RETURN    !LIT?
  135.       IF(((OFLAG1(I).AND.VISIBT).EQ.0).OR.
  136.     1    (((OFLAG1(I).AND.TRANBT).EQ.0).AND.
  137.     2    ((OFLAG2(I).AND.OPENBT).EQ.0))) GO TO 1000
  138. C
  139. C OBJ IS VISIBLE AND OPEN OR TRANSPARENT
  140. C
  141.       DO 500 J=1,OLNT
  142.         IF((OCAN(J).EQ.I).AND.((OFLAG1(J).AND.ONBT).NE.0))
  143.     1    RETURN
  144. 500      CONTINUE
  145. 1000    CONTINUE
  146.     LIT=.FALSE.
  147.     RETURN
  148.     END
  149. C WEIGHT- RETURNS SUM OF WEIGHT OF QUALIFYING OBJECTS
  150. C
  151. C DECLARATIONS
  152. C
  153.     INTEGER FUNCTION WEIGHT(RM,CN,AD)
  154.     IMPLICIT INTEGER (A-Z)
  155.     LOGICAL QHERE
  156. C
  157. C OBJECTS
  158. C
  159.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  160.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  161.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  162.     3    OADV(220),OCAN(220),OREAD(220)
  163. C
  164.     WEIGHT=0
  165.     DO 100 I=1,OLNT                !OMIT BIG FIXED ITEMS.
  166.       IF(OSIZE(I).GE.10000) GO TO 100    !IF FIXED, FORGET IT.
  167.       IF((QHERE(I,RM).AND.(RM.NE.0)).OR.
  168.     1    ((OADV(I).EQ.AD).AND.(AD.NE.0))) GO TO 50
  169.       J=I                    !SEE IF CONTAINED.
  170. 25      J=OCAN(J)                !GET NEXT LEVEL UP.
  171.       IF(J.EQ.0) GO TO 100            !END OF LIST?
  172.       IF(J.NE.CN) GO TO 25
  173. 50      WEIGHT=WEIGHT+OSIZE(I)
  174. 100    CONTINUE
  175.     RETURN
  176.     END
  177.