zork-fortran/dso1.for

C PRINCR- PRINT CONTENTS OF ROOM
C
C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C DECLARATIONS
C
	SUBROUTINE PRINCR(FULL,RM)
	IMPLICIT INTEGER (A-Z)
	LOGICAL QEMPTY,QHERE,FULL
	include 'gamestat.h'
	include 'rooms.h'
	include 'rflag.h'
C
	include 'objects.h'
	include 'oflags.h'
	include 'oindex.h'
	include 'advers.h'
	include 'flags.h'
C PRINCR, PAGE 2
C
	J=329
C						!ASSUME SUPERBRIEF FORMAT.
	DO 500 I=1,OLNT
C						!LOOP ON OBJECTS
	  IF(.NOT.QHERE(I,RM).OR.(IAND(OFLAG1(I),(VISIBT+NDSCBT)).NE.
     &	VISIBT).OR.(I.EQ.AVEHIC(WINNER))) GO TO 500
	  IF(.NOT.FULL.AND.(SUPERF.OR.(BRIEFF.AND.
     &	(IAND(RFLAG(HERE),RSEEN).NE.0)))) GO TO 200
C
C DO LONG DESCRIPTION OF OBJECT.
C
	  K=ODESCO(I)
C						!GET UNTOUCHED.
	  IF((K.EQ.0).OR.(IAND(OFLAG2(I),TCHBT).NE.0)) K=ODESC1(I)
	  CALL RSPEAK(K)
C						!DESCRIBE.
	  GO TO 500
C DO SHORT DESCRIPTION OF OBJECT.
C
200	  CALL RSPSUB(J,ODESC2(I))
C						!YOU CAN SEE IT.
	  J=502
C
500	CONTINUE
C
C NOW LOOP TO PRINT CONTENTS OF OBJECTS IN ROOM.
C
	DO 1000 I=1,OLNT
C						!LOOP ON OBJECTS.
	  IF(.NOT.QHERE(I,RM).OR.(IAND(OFLAG1(I),(VISIBT+NDSCBT)).NE.
     &	VISIBT)) GO TO 1000
	  IF(IAND(OFLAG2(I),ACTRBT).NE.0) CALL INVENT(OACTOR(I))
	  IF(((IAND(OFLAG1(I),TRANBT).EQ.0)
     &	.AND.(IAND(OFLAG2(I),OPENBT).EQ.0))
     &	.OR.QEMPTY(I)) GO TO 1000
C
C OBJECT IS NOT EMPTY AND IS OPEN OR TRANSPARENT.
C
	  J=573
	  IF(I.NE.TCASE) GO TO 600
C						!TROPHY CASE?
	  J=574
	  IF((BRIEFF.OR.SUPERF).AND. .NOT.FULL) GO TO 1000
600	  CALL PRINCO(I,J)
C						!PRINT CONTENTS.
C
1000	CONTINUE
	RETURN
C
	END
C INVENT- PRINT CONTENTS OF ADVENTURER
C
C DECLARATIONS
C
	SUBROUTINE INVENT(ADV)
	IMPLICIT INTEGER (A-Z)
	LOGICAL QEMPTY
	include 'gamestat.h'
	include 'objects.h'
	include 'oflags.h'
C
	include 'advers.h'
C INVENT, PAGE 2
C
	I=575
C						!FIRST LINE.
	IF(ADV.NE.PLAYER) I=576
C						!IF NOT ME.
	DO 10 J=1,OLNT
C						!LOOP
	  IF((OADV(J).NE.ADV).OR.(IAND(OFLAG1(J),VISIBT).EQ.0))
     &	GO TO 10
	  CALL RSPSUB(I,ODESC2(AOBJ(ADV)))
	  I=0
	  CALL RSPSUB(502,ODESC2(J))
10	CONTINUE
C
	IF(I.EQ.0) GO TO 25
C						!ANY OBJECTS?
	IF(ADV.EQ.PLAYER) CALL RSPEAK(578)
C						!NO, TELL HIM.
	RETURN
C
25	DO 100 J=1,OLNT
C						!LOOP.
	  IF((OADV(J).NE.ADV).OR.(IAND(OFLAG1(J),VISIBT).EQ.0).OR.
     &	((IAND(OFLAG1(J),TRANBT).EQ.0).AND.
     &	(IAND(OFLAG2(J),OPENBT).EQ.0))) GO TO 100
	  IF(.NOT.QEMPTY(J)) CALL PRINCO(J,573)
C						!IF NOT EMPTY, LIST.
100	CONTINUE
	RETURN
C
	END
C PRINCO-	PRINT CONTENTS OF OBJECT
C
C DECLARATIONS
C
	SUBROUTINE PRINCO(OBJ,DESC)
	IMPLICIT INTEGER(A-Z)
	include 'objects.h'
C
	CALL RSPSUB(DESC,ODESC2(OBJ))
C						!PRINT HEADER.
	DO 100 I=1,OLNT
C						!LOOP THRU.
	  IF(OCAN(I).EQ.OBJ) CALL RSPSUB(502,ODESC2(I))
100	CONTINUE
	RETURN
C
	END