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