# 2.11BSD#431 - /usr/src/new/PORT/dungeon/dso1.F

       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

Last modified: 1988-10-21 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 622 |