home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / games / volume2 / dungeon / part07 / dso1.F < prev    next >
Text File  |  1987-09-01  |  3KB  |  134 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. #include "gamestate.h"
  13. #include "rooms.h"
  14. #include "rflag.h"
  15. C
  16. #include "objects.h"
  17. #include "oflags.h"
  18. #include "oindex.h"
  19. #include "advers.h"
  20. #include "flags.h"
  21. C PRINCR, PAGE 2
  22. C
  23.     J=329
  24. C                        !ASSUME SUPERBRIEF FORMAT.
  25.     DO 500 I=1,OLNT
  26. C                        !LOOP ON OBJECTS
  27.       IF(.NOT.QHERE(I,RM).OR.(and(OFLAG1(I),(VISIBT+NDSCBT)).NE.
  28. &        VISIBT).OR.(I.EQ.AVEHIC(WINNER))) GO TO 500
  29.       IF(.NOT.FULL.AND.(SUPERF.OR.(BRIEFF.AND.
  30. &        (and(RFLAG(HERE),RSEEN).NE.0)))) GO TO 200
  31. C
  32. C DO LONG DESCRIPTION OF OBJECT.
  33. C
  34.       K=ODESCO(I)
  35. C                        !GET UNTOUCHED.
  36.       IF((K.EQ.0).OR.(and(OFLAG2(I),TCHBT).NE.0)) K=ODESC1(I)
  37.       CALL RSPEAK(K)
  38. C                        !DESCRIBE.
  39.       GO TO 500
  40. C DO SHORT DESCRIPTION OF OBJECT.
  41. C
  42. 200      CALL RSPSUB(J,ODESC2(I))
  43. C                        !YOU CAN SEE IT.
  44.       J=502
  45. C
  46. 500    CONTINUE
  47. C
  48. C NOW LOOP TO PRINT CONTENTS OF OBJECTS IN ROOM.
  49. C
  50.     DO 1000 I=1,OLNT
  51. C                        !LOOP ON OBJECTS.
  52.       IF(.NOT.QHERE(I,RM).OR.(and(OFLAG1(I),(VISIBT+NDSCBT)).NE.
  53. &        VISIBT)) GO TO 1000
  54.       IF(and(OFLAG2(I),ACTRBT).NE.0) CALL INVENT(OACTOR(I))
  55.       IF(((and(OFLAG1(I),TRANBT).EQ.0)
  56. &        .AND.(and(OFLAG2(I),OPENBT).EQ.0))
  57. &        .OR.QEMPTY(I)) GO TO 1000
  58. C
  59. C OBJECT IS NOT EMPTY AND IS OPEN OR TRANSPARENT.
  60. C
  61.       J=573
  62.       IF(I.NE.TCASE) GO TO 600
  63. C                        !TROPHY CASE?
  64.       J=574
  65.       IF((BRIEFF.OR.SUPERF).AND. .NOT.FULL) GO TO 1000
  66. 600      CALL PRINCO(I,J)
  67. C                        !PRINT CONTENTS.
  68. C
  69. 1000    CONTINUE
  70.     RETURN
  71. C
  72.     END
  73. C INVENT- PRINT CONTENTS OF ADVENTURER
  74. C
  75. C DECLARATIONS
  76. C
  77.     SUBROUTINE INVENT(ADV)
  78.     IMPLICIT INTEGER (A-Z)
  79.     LOGICAL QEMPTY
  80. #include "gamestate.h"
  81. #include "objects.h"
  82. #include "oflags.h"
  83. C
  84. #include "advers.h"
  85. C INVENT, PAGE 2
  86. C
  87.     I=575
  88. C                        !FIRST LINE.
  89.     IF(ADV.NE.PLAYER) I=576
  90. C                        !IF NOT ME.
  91.     DO 10 J=1,OLNT
  92. C                        !LOOP
  93.       IF((OADV(J).NE.ADV).OR.(and(OFLAG1(J),VISIBT).EQ.0))
  94. &        GO TO 10
  95.       CALL RSPSUB(I,ODESC2(AOBJ(ADV)))
  96.       I=0
  97.       CALL RSPSUB(502,ODESC2(J))
  98. 10    CONTINUE
  99. C
  100.     IF(I.EQ.0) GO TO 25
  101. C                        !ANY OBJECTS?
  102.     IF(ADV.EQ.PLAYER) CALL RSPEAK(578)
  103. C                        !NO, TELL HIM.
  104.     RETURN
  105. C
  106. 25    DO 100 J=1,OLNT
  107. C                        !LOOP.
  108.       IF((OADV(J).NE.ADV).OR.(and(OFLAG1(J),VISIBT).EQ.0).OR.
  109. &        ((and(OFLAG1(J),TRANBT).EQ.0).AND.
  110. &        (and(OFLAG2(J),OPENBT).EQ.0))) GO TO 100
  111.       IF(.NOT.QEMPTY(J)) CALL PRINCO(J,573)
  112. C                        !IF NOT EMPTY, LIST.
  113. 100    CONTINUE
  114.     RETURN
  115. C
  116.     END
  117. C PRINCO-    PRINT CONTENTS OF OBJECT
  118. C
  119. C DECLARATIONS
  120. C
  121.     SUBROUTINE PRINCO(OBJ,DESC)
  122.     IMPLICIT INTEGER(A-Z)
  123. #include "objects.h"
  124. C
  125.     CALL RSPSUB(DESC,ODESC2(OBJ))
  126. C                        !PRINT HEADER.
  127.     DO 100 I=1,OLNT
  128. C                        !LOOP THRU.
  129.       IF(OCAN(I).EQ.OBJ) CALL RSPSUB(502,ODESC2(I))
  130. 100    CONTINUE
  131.     RETURN
  132. C
  133.     END
  134.