1C ENCRYP-- ENCRYPT PASSWORD 2C 3C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 4C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED 5C WRITTEN BY R. M. SUPNIK 6C 7C DECLARATIONS 8C 9 SUBROUTINE ENCRYP(INW,OUTW) 10 IMPLICIT INTEGER(A-Z) 11 CHARACTER INW(6),OUTW(6) 12 CHARACTER KEYW(6),UKEYW(6) 13 INTEGER UINW(6) 14 DATA KEYW/'E','C','O','R','M','S'/ 15C 16 UINWS=0 17C !UNBIASED INW SUM. 18 UKEYWS=0 19C !UNBIASED KEYW SUM. 20 J=1 21C !POINTER IN KEYWORD. 22 DO 100 I=1,6 23C !UNBIAS, COMPUTE SUMS. 24 UKEYW(I)=char(ichar(KEYW(I))-64) 25 IF(INW(J).LE.char(64)) J=1 26 UINW(I)=ichar(ichar(INW(J))-64) 27 UKEYWS=UKEYWS+ichar(UKEYW(I)) 28 UINWS=UINWS+UINW(I) 29 J=J+1 30100 CONTINUE 31C 32 USUM=MOD(UINWS,8)+(8*MOD(UKEYWS,8)) 33C !COMPUTE MASK. 34 DO 200 I=1,6 35 J=and(xor(xor(ichar(UINW(I)),ichar(UKEYW(I))),USUM),31) 36 USUM=MOD(USUM+1,32) 37 IF(J.GT.26) J=MOD(J,26) 38 OUTW(I)=char(MAX0(1,J)+64) 39200 CONTINUE 40 RETURN 41C 42 END 43C CPGOTO-- MOVE TO NEXT STATE IN PUZZLE ROOM 44C 45C DECLARATIONS 46C 47 SUBROUTINE CPGOTO(ST) 48 IMPLICIT INTEGER(A-Z) 49C 50 COMMON /HYPER/ HFACTR 51#include "rooms.h" 52#include "rflag.h" 53#include "rindex.h" 54#include "objects.h" 55#include "oflags.h" 56#include "flags.h" 57C CPGOTO, PAGE 2 58C 59 RFLAG(CPUZZ)=and(RFLAG(CPUZZ),not(RSEEN)) 60 DO 100 I=1,OLNT 61C !RELOCATE OBJECTS. 62 IF((OROOM(I).EQ.CPUZZ).AND. 63& (and(OFLAG2(I),(ACTRBT+VILLBT)).EQ.0)) 64& CALL NEWSTA(I,0,CPHERE*HFACTR,0,0) 65 IF(OROOM(I).EQ.(ST*HFACTR)) 66& CALL NEWSTA(I,0,CPUZZ,0,0) 67100 CONTINUE 68 CPHERE=ST 69 RETURN 70C 71 END 72C CPINFO-- DESCRIBE PUZZLE ROOM 73C 74C DECLARATIONS 75C 76 SUBROUTINE CPINFO(RMK,ST) 77 IMPLICIT INTEGER(A-Z) 78 INTEGER DGMOFT(8) 79 CHARACTER DGM(8),PICT(5),QMK 80C 81 COMMON /CHAN/ INPCH,OUTCH,DBCH 82C 83C PUZZLE ROOM 84C 85 COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64) 86#include "flags.h" 87C 88C FUNCTIONS AND LOCAL DATA 89C 90C 91 DATA DGMOFT/-9,-8,-7,-1,1,7,8,9/ 92#ifdef PDP 93C 94C PICT, DGM and QMK have been changed from two to 95C one character in length. Puzout prints two copies. 96C 97 DATA PICT/'S','S','S',' ','M'/ 98 DATA QMK/'?'/ 99#else 100 DATA PICT/'SS','SS','SS',' ','MM'/ 101 DATA QMK/'??'/ 102#endif PDP 103C CPINFO, PAGE 2 104C 105 CALL RSPEAK(RMK) 106 DO 100 I=1,8 107 J=DGMOFT(I) 108 DGM(I)=PICT(CPVEC(ST+J)+4) 109C !GET PICTURE ELEMENT. 110 IF((IABS(J).EQ.1).OR.(IABS(J).EQ.8)) GO TO 100 111 K=8 112 IF(J.LT.0) K=-8 113C !GET ORTHO DIR. 114 L=J-K 115 IF((CPVEC(ST+K).NE.0).AND.(CPVEC(ST+L).NE.0)) 116& DGM(I)=QMK 117100 CONTINUE 118#ifdef PDP 119 call puzout(DGM(1)) 120#else 121 WRITE(OUTCH,10) DGM 122#endif 123C 124 IF(ST.EQ.10) CALL RSPEAK(870) 125C !AT HOLE? 126 IF(ST.EQ.37) CALL RSPEAK(871) 127C !AT NICHE? 128 I=872 129C !DOOR OPEN? 130 IF(CPOUTF) I=873 131 IF(ST.EQ.52) CALL RSPEAK(I) 132C !AT DOOR? 133 IF(CPVEC(ST+1).EQ.-2) CALL RSPEAK(874) 134C !EAST LADDER? 135 IF(CPVEC(ST-1).EQ.-3) CALL RSPEAK(875) 136C !WEST LADDER? 137 RETURN 138C 139#ifndef PDP 14010 FORMAT(' |',A2,1X,A2,1X,A2,'|'/, 141& ' West |',A2,' .. ',A2,'| East',/ 142& ' |',A2,1X,A2,1X,A2,'|') 143#endif PDP 144C 145 END 146