2.11BSD#431 - /usr/src/new/PORT/dungeon/dso7.F

   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