home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol047 / dso1.for < prev    next >
Encoding:
Text File  |  1984-04-29  |  5.4 KB  |  199 lines
  1. C PRINCR- PRINT CONTENTS OF 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.     SUBROUTINE PRINCR(FULL,RM)
  10.     IMPLICIT INTEGER (A-Z)
  11.     LOGICAL QEMPTY,QHERE,FULL
  12. C
  13. C GAME STATE
  14. C
  15.     LOGICAL TELFLG
  16.     COMMON /PLAY/ WINNER,HERE,TELFLG
  17. C
  18. C ROOMS
  19. C
  20.     COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
  21.     1    RACTIO(200),RVAL(200),RFLAG(200)
  22.     INTEGER RRAND(200)
  23.     EQUIVALENCE (RVAL,RRAND)
  24. C
  25.     COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
  26.     1    RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND
  27. C
  28. C
  29. C OBJECTS
  30. C
  31.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  32.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  33.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  34.     3    OADV(220),OCAN(220),OREAD(220)
  35. C
  36.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  37.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  38.     2    TOOLBT,TURNBT,ONBT
  39.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  40.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  41.     2    TCHBT,VEHBT,SCHBT
  42. C
  43.     COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL
  44. C
  45. C ADVENTURERS
  46. C
  47.     COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
  48.     1    AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
  49. C
  50.     COMMON /AINDEX/ PLAYER,AROBOT,AMASTR
  51. C
  52. C FLAGS
  53. C
  54.     LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
  55.     LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
  56.     LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
  57.     LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
  58.     LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
  59.     LOGICAL*1 GLACMF,ENDGMF,FROBZF,BADLKF,THFENF,SINGSF
  60.     LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
  61.     LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF
  62.     COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF,
  63.     1    DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
  64.     2    MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
  65.     3    EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
  66.     4    GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
  67.     5    GLACMF,ENDGMF,FROBZF,BADLKF,THFENF,SINGSF,
  68.     6    MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
  69.     7    FOLLWF,SPELLF,CPOUTF,CPUSHF
  70.     COMMON /FINDEX/ BTIEF,BINFF
  71.     COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVGUA,RVSND
  72.     COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
  73.     COMMON /FINDEX/ MDIR,MLOC,POLEUF
  74.     COMMON /FINDEX/ QUESNO,NQATT,CORRCT
  75.     COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
  76. C PRINCR, PAGE 2
  77. C
  78.     J=329                !ASSUME SUPERBRIEF FORMAT.
  79.     DO 500 I=1,OLNT            !LOOP ON OBJECTS
  80.       IF(.NOT.QHERE(I,RM).OR.((OFLAG1(I).AND.(VISIBT+NDSCBT)).NE.
  81.     1    VISIBT).OR.(I.EQ.AVEHIC(WINNER))) GO TO 500
  82.       IF(.NOT.FULL.AND.(SUPERF.OR.(BRIEFF.AND.
  83.     1    ((RFLAG(HERE).AND.RSEEN).NE.0)))) GO TO 200
  84. C
  85. C DO LONG DESCRIPTION OF OBJECT.
  86. C
  87.       K=ODESCO(I)                !GET UNTOUCHED.
  88.       IF((K.EQ.0).OR.((OFLAG2(I).AND.TCHBT).NE.0)) K=ODESC1(I)
  89.       CALL RSPEAK(K)            !DESCRIBE.
  90.       GO TO 500
  91. C DO SHORT DESCRIPTION OF OBJECT.
  92. C
  93. 200      CALL RSPSUB(J,ODESC2(I))    !YOU CAN SEE IT.
  94.       J=502
  95. C
  96. 500    CONTINUE
  97. C
  98. C NOW LOOP TO PRINT CONTENTS OF OBJECTS IN ROOM.
  99. C
  100.     DO 1000 I=1,OLNT            !LOOP ON OBJECTS.
  101.       IF(.NOT.QHERE(I,RM).OR.((OFLAG1(I).AND.(VISIBT+NDSCBT)).NE.
  102.     1    VISIBT)) GO TO 1000
  103.       IF((OFLAG2(I).AND.ACTRBT).NE.0) CALL INVENT(OACTOR(I))
  104.       IF((((OFLAG1(I).AND.TRANBT).EQ.0).AND.((OFLAG2(I).AND.OPENBT)
  105.     1    .EQ.0)).OR.QEMPTY(I)) GO TO 1000
  106. C
  107. C OBJECT IS NOT EMPTY AND IS OPEN OR TRANSPARENT.
  108. C
  109.       J=573
  110.       IF(I.NE.TCASE) GO TO 600        !TROPHY CASE?
  111.       J=574
  112.       IF((BRIEFF.OR.SUPERF).AND. .NOT.FULL) GO TO 1000
  113. 600      CALL PRINCO(I,J)            !PRINT CONTENTS.
  114. C
  115. 1000    CONTINUE
  116.     RETURN
  117. C
  118.     END
  119. C INVENT- PRINT CONTENTS OF ADVENTURER
  120. C
  121. C DECLARATIONS
  122. C
  123.     SUBROUTINE INVENT(ADV)
  124.     IMPLICIT INTEGER (A-Z)
  125.     LOGICAL QEMPTY
  126. C
  127. C GAME STATE
  128. C
  129.     LOGICAL TELFLG
  130.     COMMON /PLAY/ WINNER,HERE,TELFLG
  131. C
  132. C OBJECTS
  133. C
  134.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  135.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  136.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  137.     3    OADV(220),OCAN(220),OREAD(220)
  138. C
  139.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  140.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  141.     2    TOOLBT,TURNBT,ONBT
  142.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  143.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  144.     2    TCHBT,VEHBT,SCHBT
  145. C
  146. C
  147. C ADVENTURERS
  148. C
  149.     COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
  150.     1    AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
  151. C
  152.     COMMON /AINDEX/ PLAYER,AROBOT,AMASTR
  153. C INVENT, PAGE 2
  154. C
  155.     I=575                    !FIRST LINE.
  156.     IF(ADV.NE.PLAYER) I=576            !IF NOT ME.
  157.     DO 10 J=1,OLNT                !LOOP
  158.       IF((OADV(J).NE.ADV).OR.((OFLAG1(J).AND.VISIBT).EQ.0))
  159.     1    GO TO 10
  160.       CALL RSPSUB(I,ODESC2(AOBJ(ADV)))
  161.       I=0
  162.       CALL RSPSUB(502,ODESC2(J))
  163. 10    CONTINUE
  164. C
  165.     IF(I.EQ.0) GO TO 25            !ANY OBJECTS?
  166.     IF(ADV.EQ.PLAYER) CALL RSPEAK(578)    !NO, TELL HIM.
  167.     RETURN
  168. C
  169. 25    DO 100 J=1,OLNT                !LOOP.
  170.       IF((OADV(J).NE.ADV).OR.((OFLAG1(J).AND.VISIBT).EQ.0).OR.
  171.     1    (((OFLAG1(J).AND.TRANBT).EQ.0).AND.
  172.     2    ((OFLAG2(J).AND.OPENBT).EQ.0))) GO TO 100
  173.       IF(.NOT.QEMPTY(J)) CALL PRINCO(J,573)    !IF NOT EMPTY, LIST.
  174. 100    CONTINUE
  175.     RETURN
  176. C
  177.     END
  178. C PRINCO-    PRINT CONTENTS OF OBJECT
  179. C
  180. C DECLARATIONS
  181. C
  182.     SUBROUTINE PRINCO(OBJ,DESC)
  183.     IMPLICIT INTEGER(A-Z)
  184. C
  185. C OBJECTS
  186. C
  187.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  188.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  189.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  190.     3    OADV(220),OCAN(220),OREAD(220)
  191. C
  192.     CALL RSPSUB(DESC,ODESC2(OBJ))        !PRINT HEADER.
  193.     DO 100 I=1,OLNT                !LOOP THRU.
  194.       IF(OCAN(I).EQ.OBJ) CALL RSPSUB(502,ODESC2(I))
  195. 100    CONTINUE
  196.     RETURN
  197. C
  198.     END
  199.