C ENCRYP--	ENCRYPT PASSWORD
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 ENCRYP(INW,OUTW)
	IMPLICIT INTEGER(A-Z)
	LOGICAL*1 INW(6),OUTW(6),KEYW(6)
	INTEGER UINW(6),UKEYW(6)
	DATA KEYW/'E','C','O','R','M','S'/
C
	UINWS=0					!UNBIASED INW SUM.
	UKEYWS=0				!UNBIASED KEYW SUM.
	J=1					!POINTER IN KEYWORD.
	DO 100 I=1,6				!UNBIAS, COMPUTE SUMS.
	  UKEYW(I)=KEYW(I)-"100			!STRIP ASCII.
	  IF(INW(J).LE."100) J=1		!RECYCLE ON BAD.
	  UINW(I)=INW(J)-"100
	  UKEYWS=UKEYWS+UKEYW(I)
	  UINWS=UINWS+UINW(I)
	  J=J+1
100	CONTINUE
C
	USUM=MOD(UINWS,8)+(8*MOD(UKEYWS,8))	!COMPUTE MASK.
	DO 200 I=1,6
	  J=(UINW(I).XOR.UKEYW(I).XOR.USUM).AND."37
	  USUM=MOD(USUM+1,32)
	  IF(J.GT.26) J=MOD(J,26)
	  OUTW(I)=MAX0(1,J)+"100
200	CONTINUE
	RETURN
C
	END
C CPGOTO--	MOVE TO NEXT STATE IN PUZZLE ROOM
C
C DECLARATIONS
C
	SUBROUTINE CPGOTO(ST)
	IMPLICIT INTEGER(A-Z)
C
	COMMON /HYPER/ HFACTR
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
	COMMON /RINDEX/ WHOUS,LROOM,CELLA
	COMMON /RINDEX/ MTROL,MAZE1	
	COMMON /RINDEX/ MGRAT,MAZ15	
	COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER
	COMMON /RINDEX/ STREA,EGYPT,ECHOR
	COMMON /RINDEX/ TSHAF	
	COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC
	COMMON /RINDEX/ CAROU	
	COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT
	COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL
	COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR
	COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4
	COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER
	COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR
	COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX
	COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE
	COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR
	COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR
	COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL
	COMMON /RINDEX/ CPANT,CPOUT,CPUZZ
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 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,FROBZF,ENDGMF,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,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
	6	MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
	7	FOLLWF,SPELLF,CPOUTF,CPUSHF
	COMMON /FINDEX/ BTIEF,BINFF
	COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
	COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
	COMMON /FINDEX/ MDIR,MLOC,POLEUF
	COMMON /FINDEX/ QUESNO,NQATT,CORRCT
	COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
C CPGOTO, PAGE 2
C
	RFLAG(CPUZZ)=RFLAG(CPUZZ).AND..NOT.RSEEN
	DO 100 I=1,OLNT				!RELOCATE OBJECTS.
	  IF((OROOM(I).EQ.CPUZZ).AND.
	1	((OFLAG2(I).AND.(ACTRBT+VILLBT)).EQ.0))
	2	CALL NEWSTA(I,0,CPHERE*HFACTR,0,0)
	  IF(OROOM(I).EQ.(ST*HFACTR))
	1	CALL NEWSTA(I,0,CPUZZ,0,0)
100	CONTINUE
	CPHERE=ST
	RETURN
C
	END
C CPINFO--	DESCRIBE PUZZLE ROOM
C
C DECLARATIONS
C
	SUBROUTINE CPINFO(RMK,ST)
	IMPLICIT INTEGER(A-Z)
	INTEGER DGM(8),DGMOFT(8),PICT(5)
C
	COMMON /CHAN/ INPCH,OUTCH,DBCH
C
C PUZZLE ROOM
C
	COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64)
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,FROBZF,ENDGMF,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,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
	6	MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
	7	FOLLWF,SPELLF,CPOUTF,CPUSHF
	COMMON /FINDEX/ BTIEF,BINFF
	COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
	COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
	COMMON /FINDEX/ MDIR,MLOC,POLEUF
	COMMON /FINDEX/ QUESNO,NQATT,CORRCT
	COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
C
C FUNCTIONS AND LOCAL DATA
C
	DATA DGMOFT/-9,-8,-7,-1,1,7,8,9/
	DATA PICT/'SS','SS','SS','  ','MM'/
	DATA QMK/'??'/
C CPINFO, PAGE 2
C
	CALL RSPEAK(RMK)
	DO 100 I=1,8
	  J=DGMOFT(I)
	  DGM(I)=PICT(CPVEC(ST+J)+4)		!GET PICTURE ELEMENT.
	  IF((IABS(J).EQ.1).OR.(IABS(J).EQ.8)) GO TO 100
	  K=8
	  IF(J.LT.0) K=-8			!GET ORTHO DIR.
	  L=J-K
	  IF((CPVEC(ST+K).NE.0).AND.(CPVEC(ST+L).NE.0))
	1	DGM(I)=QMK
100	CONTINUE
	WRITE(OUTCH,10) DGM
C
	IF(ST.EQ.10) CALL RSPEAK(870)		!AT HOLE?
	IF(ST.EQ.37) CALL RSPEAK(871)		!AT NICHE?
	I=872					!DOOR OPEN?
	IF(CPOUTF) I=873
	IF(ST.EQ.52) CALL RSPEAK(I)		!AT DOOR?
	IF(CPVEC(ST+1).EQ.-2) CALL RSPEAK(874)	!EAST LADDER?
	IF(CPVEC(ST-1).EQ.-3) CALL RSPEAK(875)	!WEST LADDER?
	RETURN
C
10	FORMAT('       |',A2,1X,A2,1X,A2,'|'/,
	1' West  |',A2,' .. ',A2,'|  East',/
	2'       |',A2,1X,A2,1X,A2,'|')
C
	END