home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol047 / dso7.for < prev    next >
Encoding:
Text File  |  1984-04-29  |  6.0 KB  |  202 lines
  1. C ENCRYP--    ENCRYPT PASSWORD
  2. C
  3. C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  4. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5. C WRITTEN BY R. M. SUPNIK
  6. C
  7. C DECLARATIONS
  8. C
  9.     SUBROUTINE ENCRYP(INW,OUTW)
  10.     IMPLICIT INTEGER(A-Z)
  11.     LOGICAL*1 INW(6),OUTW(6),KEYW(6)
  12.     INTEGER UINW(6),UKEYW(6)
  13.     DATA KEYW/'E','C','O','R','M','S'/
  14. C
  15.     UINWS=0                    !UNBIASED INW SUM.
  16.     UKEYWS=0                !UNBIASED KEYW SUM.
  17.     J=1                    !POINTER IN KEYWORD.
  18.     DO 100 I=1,6                !UNBIAS, COMPUTE SUMS.
  19.       UKEYW(I)=KEYW(I)-"100            !STRIP ASCII.
  20.       IF(INW(J).LE."100) J=1        !RECYCLE ON BAD.
  21.       UINW(I)=INW(J)-"100
  22.       UKEYWS=UKEYWS+UKEYW(I)
  23.       UINWS=UINWS+UINW(I)
  24.       J=J+1
  25. 100    CONTINUE
  26. C
  27.     USUM=MOD(UINWS,8)+(8*MOD(UKEYWS,8))    !COMPUTE MASK.
  28.     DO 200 I=1,6
  29.       J=(UINW(I).XOR.UKEYW(I).XOR.USUM).AND."37
  30.       USUM=MOD(USUM+1,32)
  31.       IF(J.GT.26) J=MOD(J,26)
  32.       OUTW(I)=MAX0(1,J)+"100
  33. 200    CONTINUE
  34.     RETURN
  35. C
  36.     END
  37. C CPGOTO--    MOVE TO NEXT STATE IN PUZZLE ROOM
  38. C
  39. C DECLARATIONS
  40. C
  41.     SUBROUTINE CPGOTO(ST)
  42.     IMPLICIT INTEGER(A-Z)
  43. C
  44.     COMMON /HYPER/ HFACTR
  45. C
  46. C ROOMS
  47. C
  48.     COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
  49.     1    RACTIO(200),RVAL(200),RFLAG(200)
  50.     INTEGER RRAND(200)
  51.     EQUIVALENCE (RVAL,RRAND)
  52. C
  53.     COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
  54.     1    RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND
  55. C
  56.     COMMON /RINDEX/ WHOUS,LROOM,CELLA
  57.     COMMON /RINDEX/ MTROL,MAZE1    
  58.     COMMON /RINDEX/ MGRAT,MAZ15    
  59.     COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER
  60.     COMMON /RINDEX/ STREA,EGYPT,ECHOR
  61.     COMMON /RINDEX/ TSHAF    
  62.     COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC
  63.     COMMON /RINDEX/ CAROU    
  64.     COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT
  65.     COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL
  66.     COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR
  67.     COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4
  68.     COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER
  69.     COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR
  70.     COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX
  71.     COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE
  72.     COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR
  73.     COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR
  74.     COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL
  75.     COMMON /RINDEX/ CPANT,CPOUT,CPUZZ
  76. C
  77. C OBJECTS
  78. C
  79.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  80.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  81.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  82.     3    OADV(220),OCAN(220),OREAD(220)
  83. C
  84.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  85.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  86.     2    TOOLBT,TURNBT,ONBT
  87.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  88.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  89.     2    TCHBT,VEHBT,SCHBT
  90. C
  91. C FLAGS
  92. C
  93.     LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
  94.     LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
  95.     LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
  96.     LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
  97.     LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
  98.     LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
  99.     LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
  100.     LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF
  101.     COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF,
  102.     1    DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
  103.     2    MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
  104.     3    EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
  105.     4    GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
  106.     5    GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
  107.     6    MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
  108.     7    FOLLWF,SPELLF,CPOUTF,CPUSHF
  109.     COMMON /FINDEX/ BTIEF,BINFF
  110.     COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
  111.     COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
  112.     COMMON /FINDEX/ MDIR,MLOC,POLEUF
  113.     COMMON /FINDEX/ QUESNO,NQATT,CORRCT
  114.     COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
  115. C CPGOTO, PAGE 2
  116. C
  117.     RFLAG(CPUZZ)=RFLAG(CPUZZ).AND..NOT.RSEEN
  118.     DO 100 I=1,OLNT                !RELOCATE OBJECTS.
  119.       IF((OROOM(I).EQ.CPUZZ).AND.
  120.     1    ((OFLAG2(I).AND.(ACTRBT+VILLBT)).EQ.0))
  121.     2    CALL NEWSTA(I,0,CPHERE*HFACTR,0,0)
  122.       IF(OROOM(I).EQ.(ST*HFACTR))
  123.     1    CALL NEWSTA(I,0,CPUZZ,0,0)
  124. 100    CONTINUE
  125.     CPHERE=ST
  126.     RETURN
  127. C
  128.     END
  129. C CPINFO--    DESCRIBE PUZZLE ROOM
  130. C
  131. C DECLARATIONS
  132. C
  133.     SUBROUTINE CPINFO(RMK,ST)
  134.     IMPLICIT INTEGER(A-Z)
  135.     INTEGER DGM(8),DGMOFT(8),PICT(5)
  136. C
  137.     COMMON /CHAN/ INPCH,OUTCH,DBCH
  138. C
  139. C PUZZLE ROOM
  140. C
  141.     COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64)
  142. C
  143. C FLAGS
  144. C
  145.     LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
  146.     LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
  147.     LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
  148.     LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
  149.     LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
  150.     LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
  151.     LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
  152.     LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF
  153.     COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF,
  154.     1    DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
  155.     2    MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
  156.     3    EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
  157.     4    GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
  158.     5    GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
  159.     6    MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
  160.     7    FOLLWF,SPELLF,CPOUTF,CPUSHF
  161.     COMMON /FINDEX/ BTIEF,BINFF
  162.     COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
  163.     COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
  164.     COMMON /FINDEX/ MDIR,MLOC,POLEUF
  165.     COMMON /FINDEX/ QUESNO,NQATT,CORRCT
  166.     COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
  167. C
  168. C FUNCTIONS AND LOCAL DATA
  169. C
  170.     DATA DGMOFT/-9,-8,-7,-1,1,7,8,9/
  171.     DATA PICT/'SS','SS','SS','  ','MM'/
  172.     DATA QMK/'??'/
  173. C CPINFO, PAGE 2
  174. C
  175.     CALL RSPEAK(RMK)
  176.     DO 100 I=1,8
  177.       J=DGMOFT(I)
  178.       DGM(I)=PICT(CPVEC(ST+J)+4)        !GET PICTURE ELEMENT.
  179.       IF((IABS(J).EQ.1).OR.(IABS(J).EQ.8)) GO TO 100
  180.       K=8
  181.       IF(J.LT.0) K=-8            !GET ORTHO DIR.
  182.       L=J-K
  183.       IF((CPVEC(ST+K).NE.0).AND.(CPVEC(ST+L).NE.0))
  184.     1    DGM(I)=QMK
  185. 100    CONTINUE
  186.     WRITE(OUTCH,10) DGM
  187. C
  188.     IF(ST.EQ.10) CALL RSPEAK(870)        !AT HOLE?
  189.     IF(ST.EQ.37) CALL RSPEAK(871)        !AT NICHE?
  190.     I=872                    !DOOR OPEN?
  191.     IF(CPOUTF) I=873
  192.     IF(ST.EQ.52) CALL RSPEAK(I)        !AT DOOR?
  193.     IF(CPVEC(ST+1).EQ.-2) CALL RSPEAK(874)    !EAST LADDER?
  194.     IF(CPVEC(ST-1).EQ.-3) CALL RSPEAK(875)    !WEST LADDER?
  195.     RETURN
  196. C
  197. 10    FORMAT('       |',A2,1X,A2,1X,A2,'|'/,
  198.     1' West  |',A2,' .. ',A2,'|  East',/
  199.     2'       |',A2,1X,A2,1X,A2,'|')
  200. C
  201.     END
  202.