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

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.