![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dso7.F CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon|
Return to dso7.F CVS log | Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon |
1.1 root 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: CHARACTER INW(6),OUTW(6)
12: CHARACTER KEYW(6),UKEYW(6)
13: INTEGER UINW(6)
14: DATA KEYW/'E','C','O','R','M','S'/
15: C
16: UINWS=0
17: C !UNBIASED INW SUM.
18: UKEYWS=0
19: C !UNBIASED KEYW SUM.
20: J=1
21: C !POINTER IN KEYWORD.
22: DO 100 I=1,6
23: C !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
30: 100 CONTINUE
31: C
32: USUM=MOD(UINWS,8)+(8*MOD(UKEYWS,8))
33: C !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)
39: 200 CONTINUE
40: RETURN
41: C
42: END
43: C CPGOTO-- MOVE TO NEXT STATE IN PUZZLE ROOM
44: C
45: C DECLARATIONS
46: C
47: SUBROUTINE CPGOTO(ST)
48: IMPLICIT INTEGER(A-Z)
49: C
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"
57: C CPGOTO, PAGE 2
58: C
59: RFLAG(CPUZZ)=and(RFLAG(CPUZZ),not(RSEEN))
60: DO 100 I=1,OLNT
61: C !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)
67: 100 CONTINUE
68: CPHERE=ST
69: RETURN
70: C
71: END
72: C CPINFO-- DESCRIBE PUZZLE ROOM
73: C
74: C DECLARATIONS
75: C
76: SUBROUTINE CPINFO(RMK,ST)
77: IMPLICIT INTEGER(A-Z)
78: INTEGER DGMOFT(8)
79: CHARACTER DGM(8),PICT(5),QMK
80: C
81: COMMON /CHAN/ INPCH,OUTCH,DBCH
82: C
83: C PUZZLE ROOM
84: C
85: COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64)
86: #include "flags.h"
87: C
88: C FUNCTIONS AND LOCAL DATA
89: C
90: C
91: DATA DGMOFT/-9,-8,-7,-1,1,7,8,9/
92: #ifdef PDP
93: C
94: C PICT, DGM and QMK have been changed from two to
95: C one character in length. Puzout prints two copies.
96: C
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
103: C CPINFO, PAGE 2
104: C
105: CALL RSPEAK(RMK)
106: DO 100 I=1,8
107: J=DGMOFT(I)
108: DGM(I)=PICT(CPVEC(ST+J)+4)
109: C !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
113: C !GET ORTHO DIR.
114: L=J-K
115: IF((CPVEC(ST+K).NE.0).AND.(CPVEC(ST+L).NE.0))
116: & DGM(I)=QMK
117: 100 CONTINUE
118: #ifdef PDP
119: call puzout(DGM(1))
120: #else
121: WRITE(OUTCH,10) DGM
122: #endif
123: C
124: IF(ST.EQ.10) CALL RSPEAK(870)
125: C !AT HOLE?
126: IF(ST.EQ.37) CALL RSPEAK(871)
127: C !AT NICHE?
128: I=872
129: C !DOOR OPEN?
130: IF(CPOUTF) I=873
131: IF(ST.EQ.52) CALL RSPEAK(I)
132: C !AT DOOR?
133: IF(CPVEC(ST+1).EQ.-2) CALL RSPEAK(874)
134: C !EAST LADDER?
135: IF(CPVEC(ST-1).EQ.-3) CALL RSPEAK(875)
136: C !WEST LADDER?
137: RETURN
138: C
139: #ifndef PDP
140: 10 FORMAT(' |',A2,1X,A2,1X,A2,'|'/,
141: & ' West |',A2,' .. ',A2,'| East',/
142: & ' |',A2,1X,A2,1X,A2,'|')
143: #endif PDP
144: C
145: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.