1C PRINCR- PRINT CONTENTS OF ROOM 2C 3C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 4C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED 5C WRITTEN BY R. M. SUPNIK 6C 7C DECLARATIONS 8C 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" 15C 16#include "objects.h" 17#include "oflags.h" 18#include "oindex.h" 19#include "advers.h" 20#include "flags.h" 21C PRINCR, PAGE 2 22C 23 J=329 24C !ASSUME SUPERBRIEF FORMAT. 25 DO 500 I=1,OLNT 26C !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 31C 32C DO LONG DESCRIPTION OF OBJECT. 33C 34 K=ODESCO(I) 35C !GET UNTOUCHED. 36 IF((K.EQ.0).OR.(and(OFLAG2(I),TCHBT).NE.0)) K=ODESC1(I) 37 CALL RSPEAK(K) 38C !DESCRIBE. 39 GO TO 500 40C DO SHORT DESCRIPTION OF OBJECT. 41C 42200 CALL RSPSUB(J,ODESC2(I)) 43C !YOU CAN SEE IT. 44 J=502 45C 46500 CONTINUE 47C 48C NOW LOOP TO PRINT CONTENTS OF OBJECTS IN ROOM. 49C 50 DO 1000 I=1,OLNT 51C !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 58C 59C OBJECT IS NOT EMPTY AND IS OPEN OR TRANSPARENT. 60C 61 J=573 62 IF(I.NE.TCASE) GO TO 600 63C !TROPHY CASE? 64 J=574 65 IF((BRIEFF.OR.SUPERF).AND. .NOT.FULL) GO TO 1000 66600 CALL PRINCO(I,J) 67C !PRINT CONTENTS. 68C 691000 CONTINUE 70 RETURN 71C 72 END 73C INVENT- PRINT CONTENTS OF ADVENTURER 74C 75C DECLARATIONS 76C 77 SUBROUTINE INVENT(ADV) 78 IMPLICIT INTEGER (A-Z) 79 LOGICAL QEMPTY 80#include "gamestate.h" 81#include "objects.h" 82#include "oflags.h" 83C 84#include "advers.h" 85C INVENT, PAGE 2 86C 87 I=575 88C !FIRST LINE. 89 IF(ADV.NE.PLAYER) I=576 90C !IF NOT ME. 91 DO 10 J=1,OLNT 92C !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)) 9810 CONTINUE 99C 100 IF(I.EQ.0) GO TO 25 101C !ANY OBJECTS? 102 IF(ADV.EQ.PLAYER) CALL RSPEAK(578) 103C !NO, TELL HIM. 104 RETURN 105C 10625 DO 100 J=1,OLNT 107C !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) 112C !IF NOT EMPTY, LIST. 113100 CONTINUE 114 RETURN 115C 116 END 117C PRINCO- PRINT CONTENTS OF OBJECT 118C 119C DECLARATIONS 120C 121 SUBROUTINE PRINCO(OBJ,DESC) 122 IMPLICIT INTEGER(A-Z) 123#include "objects.h" 124C 125 CALL RSPSUB(DESC,ODESC2(OBJ)) 126C !PRINT HEADER. 127 DO 100 I=1,OLNT 128C !LOOP THRU. 129 IF(OCAN(I).EQ.OBJ) CALL RSPSUB(502,ODESC2(I)) 130100 CONTINUE 131 RETURN 132C 133 END 134