date and time created 93/06/01 16:44:41 by bostic

[unix-history] / usr / src / contrib / dungeon / dso7.F

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)
	CHARACTER INW(6),OUTW(6)
	CHARACTER  KEYW(6),UKEYW(6)
	INTEGER UINW(6)
	DATA KEYW/'E','C','O','R','M','S'/
C
	UINWS=0
C						!UNBIASED INW SUM.
	UKEYWS=0
C						!UNBIASED KEYW SUM.
	J=1
C						!POINTER IN KEYWORD.
	DO 100 I=1,6
C						!UNBIAS, COMPUTE SUMS.
	  UKEYW(I)=char(ichar(KEYW(I))-64)
	  IF(INW(J).LE.char(64)) J=1
	  UINW(I)=ichar(ichar(INW(J))-64)
	  UKEYWS=UKEYWS+ichar(UKEYW(I))
	  UINWS=UINWS+UINW(I)
	  J=J+1
100	CONTINUE
C
	USUM=MOD(UINWS,8)+(8*MOD(UKEYWS,8))
C						!COMPUTE MASK.
	DO 200 I=1,6
	  J=and(xor(xor(ichar(UINW(I)),ichar(UKEYW(I))),USUM),31)
	  USUM=MOD(USUM+1,32)
	  IF(J.GT.26) J=MOD(J,26)
	  OUTW(I)=char(MAX0(1,J)+64)
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
#include "rooms.h"
#include "rflag.h"
#include "rindex.h"
#include "objects.h"
#include "oflags.h"
#include "flags.h"
C CPGOTO, PAGE 2
C
	RFLAG(CPUZZ)=and(RFLAG(CPUZZ),not(RSEEN))
	DO 100 I=1,OLNT
C						!RELOCATE OBJECTS.
	  IF((OROOM(I).EQ.CPUZZ).AND.
&		(and(OFLAG2(I),(ACTRBT+VILLBT)).EQ.0))
&		CALL NEWSTA(I,0,CPHERE*HFACTR,0,0)
	  IF(OROOM(I).EQ.(ST*HFACTR))
&		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 DGMOFT(8)
	CHARACTER  DGM(8),PICT(5),QMK
C
	COMMON /CHAN/ INPCH,OUTCH,DBCH
C
C PUZZLE ROOM
C
	COMMON /PUZZLE/ CPDR(16),CPWL(8),CPVEC(64)
#include "flags.h"
C
C FUNCTIONS AND LOCAL DATA
C
C
	DATA DGMOFT/-9,-8,-7,-1,1,7,8,9/
#ifdef PDP
C
C	PICT, DGM and QMK have been changed from two to
C	one character in length. Puzout prints two copies.
C
	DATA PICT/'S','S','S',' ','M'/
	DATA QMK/'?'/
#else
	DATA PICT/'SS','SS','SS','  ','MM'/
	DATA QMK/'??'/
#endif PDP
C CPINFO, PAGE 2
C
	CALL RSPEAK(RMK)
	DO 100 I=1,8
	  J=DGMOFT(I)
	  DGM(I)=PICT(CPVEC(ST+J)+4)
C						!GET PICTURE ELEMENT.
	  IF((IABS(J).EQ.1).OR.(IABS(J).EQ.8)) GO TO 100
	  K=8
	  IF(J.LT.0) K=-8
C						!GET ORTHO DIR.
	  L=J-K
	  IF((CPVEC(ST+K).NE.0).AND.(CPVEC(ST+L).NE.0))
&		DGM(I)=QMK
100	CONTINUE
#ifdef PDP
	call puzout(DGM(1))
#else
 	WRITE(OUTCH,10) DGM
#endif
C
	IF(ST.EQ.10) CALL RSPEAK(870)
C						!AT HOLE?
	IF(ST.EQ.37) CALL RSPEAK(871)
C						!AT NICHE?
	I=872
C						!DOOR OPEN?
	IF(CPOUTF) I=873
	IF(ST.EQ.52) CALL RSPEAK(I)
C						!AT DOOR?
	IF(CPVEC(ST+1).EQ.-2) CALL RSPEAK(874)
C						!EAST LADDER?
	IF(CPVEC(ST-1).EQ.-3) CALL RSPEAK(875)
C						!WEST LADDER?
	RETURN
C
#ifndef PDP
10	FORMAT('       |',A2,1X,A2,1X,A2,'|'/,
&	' West  |',A2,' .. ',A2,'|  East',/
&	'       |',A2,1X,A2,1X,A2,'|')
#endif PDP
C
	END