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 C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C ROOMS C COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200), 1 RACTIO(200),RVAL(200),RFLAG(200) INTEGER RRAND(200) EQUIVALENCE (RVAL,RRAND) C COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR, 1 RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND C C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C C FLAGS C LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF LOGICAL*1 GLACMF,ENDGMF,FROBZF,BADLKF,THFENF,SINGSF LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF, 1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF, 2 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF, 3 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF, 4 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF, 5 GLACMF,ENDGMF,FROBZF,BADLKF,THFENF,SINGSF, 6 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF, 7 FOLLWF,SPELLF,CPOUTF,CPUSHF COMMON /FINDEX/ BTIEF,BINFF COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVGUA,RVSND COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP COMMON /FINDEX/ MDIR,MLOC,POLEUF COMMON /FINDEX/ QUESNO,NQATT,CORRCT COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE C PRINCR, PAGE 2 C J=329 !ASSUME SUPERBRIEF FORMAT. DO 500 I=1,OLNT !LOOP ON OBJECTS IF(.NOT.QHERE(I,RM).OR.((OFLAG1(I).AND.(VISIBT+NDSCBT)).NE. 1 VISIBT).OR.(I.EQ.AVEHIC(WINNER))) GO TO 500 IF(.NOT.FULL.AND.(SUPERF.OR.(BRIEFF.AND. 1 ((RFLAG(HERE).AND.RSEEN).NE.0)))) GO TO 200 C C DO LONG DESCRIPTION OF OBJECT. C K=ODESCO(I) !GET UNTOUCHED. IF((K.EQ.0).OR.((OFLAG2(I).AND.TCHBT).NE.0)) K=ODESC1(I) CALL RSPEAK(K) !DESCRIBE. GO TO 500 C DO SHORT DESCRIPTION OF OBJECT. C 200 CALL RSPSUB(J,ODESC2(I)) !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 !LOOP ON OBJECTS. IF(.NOT.QHERE(I,RM).OR.((OFLAG1(I).AND.(VISIBT+NDSCBT)).NE. 1 VISIBT)) GO TO 1000 IF((OFLAG2(I).AND.ACTRBT).NE.0) CALL INVENT(OACTOR(I)) IF((((OFLAG1(I).AND.TRANBT).EQ.0).AND.((OFLAG2(I).AND.OPENBT) 1 .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 !TROPHY CASE? J=574 IF((BRIEFF.OR.SUPERF).AND. .NOT.FULL) GO TO 1000 600 CALL PRINCO(I,J) !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 C C GAME STATE C LOGICAL TELFLG COMMON /PLAY/ WINNER,HERE,TELFLG C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT, 1 NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT, 2 TOOLBT,TURNBT,ONBT COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT, 1 WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT, 2 TCHBT,VEHBT,SCHBT C C C ADVENTURERS C COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4), 1 AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4) C COMMON /AINDEX/ PLAYER,AROBOT,AMASTR C INVENT, PAGE 2 C I=575 !FIRST LINE. IF(ADV.NE.PLAYER) I=576 !IF NOT ME. DO 10 J=1,OLNT !LOOP IF((OADV(J).NE.ADV).OR.((OFLAG1(J).AND.VISIBT).EQ.0)) 1 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 !ANY OBJECTS? IF(ADV.EQ.PLAYER) CALL RSPEAK(578) !NO, TELL HIM. RETURN C 25 DO 100 J=1,OLNT !LOOP. IF((OADV(J).NE.ADV).OR.((OFLAG1(J).AND.VISIBT).EQ.0).OR. 1 (((OFLAG1(J).AND.TRANBT).EQ.0).AND. 2 ((OFLAG2(J).AND.OPENBT).EQ.0))) GO TO 100 IF(.NOT.QEMPTY(J)) CALL PRINCO(J,573) !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) C C OBJECTS C COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220), 1 OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220), 2 OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220), 3 OADV(220),OCAN(220),OREAD(220) C CALL RSPSUB(DESC,ODESC2(OBJ)) !PRINT HEADER. DO 100 I=1,OLNT !LOOP THRU. IF(OCAN(I).EQ.OBJ) CALL RSPSUB(502,ODESC2(I)) 100 CONTINUE RETURN C END