1*35973SbosticC PRINCR- PRINT CONTENTS OF ROOM 2*35973SbosticC 3*35973SbosticC COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 4*35973SbosticC ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED 5*35973SbosticC WRITTEN BY R. M. SUPNIK 6*35973SbosticC 7*35973SbosticC DECLARATIONS 8*35973SbosticC 9*35973Sbostic SUBROUTINE PRINCR(FULL,RM) 10*35973Sbostic IMPLICIT INTEGER (A-Z) 11*35973Sbostic LOGICAL QEMPTY,QHERE,FULL 12*35973Sbostic#include "gamestate.h" 13*35973Sbostic#include "rooms.h" 14*35973Sbostic#include "rflag.h" 15*35973SbosticC 16*35973Sbostic#include "objects.h" 17*35973Sbostic#include "oflags.h" 18*35973Sbostic#include "oindex.h" 19*35973Sbostic#include "advers.h" 20*35973Sbostic#include "flags.h" 21*35973SbosticC PRINCR, PAGE 2 22*35973SbosticC 23*35973Sbostic J=329 24*35973SbosticC !ASSUME SUPERBRIEF FORMAT. 25*35973Sbostic DO 500 I=1,OLNT 26*35973SbosticC !LOOP ON OBJECTS 27*35973Sbostic IF(.NOT.QHERE(I,RM).OR.(and(OFLAG1(I),(VISIBT+NDSCBT)).NE. 28*35973Sbostic& VISIBT).OR.(I.EQ.AVEHIC(WINNER))) GO TO 500 29*35973Sbostic IF(.NOT.FULL.AND.(SUPERF.OR.(BRIEFF.AND. 30*35973Sbostic& (and(RFLAG(HERE),RSEEN).NE.0)))) GO TO 200 31*35973SbosticC 32*35973SbosticC DO LONG DESCRIPTION OF OBJECT. 33*35973SbosticC 34*35973Sbostic K=ODESCO(I) 35*35973SbosticC !GET UNTOUCHED. 36*35973Sbostic IF((K.EQ.0).OR.(and(OFLAG2(I),TCHBT).NE.0)) K=ODESC1(I) 37*35973Sbostic CALL RSPEAK(K) 38*35973SbosticC !DESCRIBE. 39*35973Sbostic GO TO 500 40*35973SbosticC DO SHORT DESCRIPTION OF OBJECT. 41*35973SbosticC 42*35973Sbostic200 CALL RSPSUB(J,ODESC2(I)) 43*35973SbosticC !YOU CAN SEE IT. 44*35973Sbostic J=502 45*35973SbosticC 46*35973Sbostic500 CONTINUE 47*35973SbosticC 48*35973SbosticC NOW LOOP TO PRINT CONTENTS OF OBJECTS IN ROOM. 49*35973SbosticC 50*35973Sbostic DO 1000 I=1,OLNT 51*35973SbosticC !LOOP ON OBJECTS. 52*35973Sbostic IF(.NOT.QHERE(I,RM).OR.(and(OFLAG1(I),(VISIBT+NDSCBT)).NE. 53*35973Sbostic& VISIBT)) GO TO 1000 54*35973Sbostic IF(and(OFLAG2(I),ACTRBT).NE.0) CALL INVENT(OACTOR(I)) 55*35973Sbostic IF(((and(OFLAG1(I),TRANBT).EQ.0) 56*35973Sbostic& .AND.(and(OFLAG2(I),OPENBT).EQ.0)) 57*35973Sbostic& .OR.QEMPTY(I)) GO TO 1000 58*35973SbosticC 59*35973SbosticC OBJECT IS NOT EMPTY AND IS OPEN OR TRANSPARENT. 60*35973SbosticC 61*35973Sbostic J=573 62*35973Sbostic IF(I.NE.TCASE) GO TO 600 63*35973SbosticC !TROPHY CASE? 64*35973Sbostic J=574 65*35973Sbostic IF((BRIEFF.OR.SUPERF).AND. .NOT.FULL) GO TO 1000 66*35973Sbostic600 CALL PRINCO(I,J) 67*35973SbosticC !PRINT CONTENTS. 68*35973SbosticC 69*35973Sbostic1000 CONTINUE 70*35973Sbostic RETURN 71*35973SbosticC 72*35973Sbostic END 73*35973SbosticC INVENT- PRINT CONTENTS OF ADVENTURER 74*35973SbosticC 75*35973SbosticC DECLARATIONS 76*35973SbosticC 77*35973Sbostic SUBROUTINE INVENT(ADV) 78*35973Sbostic IMPLICIT INTEGER (A-Z) 79*35973Sbostic LOGICAL QEMPTY 80*35973Sbostic#include "gamestate.h" 81*35973Sbostic#include "objects.h" 82*35973Sbostic#include "oflags.h" 83*35973SbosticC 84*35973Sbostic#include "advers.h" 85*35973SbosticC INVENT, PAGE 2 86*35973SbosticC 87*35973Sbostic I=575 88*35973SbosticC !FIRST LINE. 89*35973Sbostic IF(ADV.NE.PLAYER) I=576 90*35973SbosticC !IF NOT ME. 91*35973Sbostic DO 10 J=1,OLNT 92*35973SbosticC !LOOP 93*35973Sbostic IF((OADV(J).NE.ADV).OR.(and(OFLAG1(J),VISIBT).EQ.0)) 94*35973Sbostic& GO TO 10 95*35973Sbostic CALL RSPSUB(I,ODESC2(AOBJ(ADV))) 96*35973Sbostic I=0 97*35973Sbostic CALL RSPSUB(502,ODESC2(J)) 98*35973Sbostic10 CONTINUE 99*35973SbosticC 100*35973Sbostic IF(I.EQ.0) GO TO 25 101*35973SbosticC !ANY OBJECTS? 102*35973Sbostic IF(ADV.EQ.PLAYER) CALL RSPEAK(578) 103*35973SbosticC !NO, TELL HIM. 104*35973Sbostic RETURN 105*35973SbosticC 106*35973Sbostic25 DO 100 J=1,OLNT 107*35973SbosticC !LOOP. 108*35973Sbostic IF((OADV(J).NE.ADV).OR.(and(OFLAG1(J),VISIBT).EQ.0).OR. 109*35973Sbostic& ((and(OFLAG1(J),TRANBT).EQ.0).AND. 110*35973Sbostic& (and(OFLAG2(J),OPENBT).EQ.0))) GO TO 100 111*35973Sbostic IF(.NOT.QEMPTY(J)) CALL PRINCO(J,573) 112*35973SbosticC !IF NOT EMPTY, LIST. 113*35973Sbostic100 CONTINUE 114*35973Sbostic RETURN 115*35973SbosticC 116*35973Sbostic END 117*35973SbosticC PRINCO- PRINT CONTENTS OF OBJECT 118*35973SbosticC 119*35973SbosticC DECLARATIONS 120*35973SbosticC 121*35973Sbostic SUBROUTINE PRINCO(OBJ,DESC) 122*35973Sbostic IMPLICIT INTEGER(A-Z) 123*35973Sbostic#include "objects.h" 124*35973SbosticC 125*35973Sbostic CALL RSPSUB(DESC,ODESC2(OBJ)) 126*35973SbosticC !PRINT HEADER. 127*35973Sbostic DO 100 I=1,OLNT 128*35973SbosticC !LOOP THRU. 129*35973Sbostic IF(OCAN(I).EQ.OBJ) CALL RSPSUB(502,ODESC2(I)) 130*35973Sbostic100 CONTINUE 131*35973Sbostic RETURN 132*35973SbosticC 133*35973Sbostic END 134