' Simple Substitution Enciphering Program Ver. 1, using a K4 type key.
' This program was written in PowerBasic Ver. 3.5 by Archie Bullington
' in October, 2001.  This program is based on the program written by
' Mike Barlow in Basic.

' Main Module
GOSUB Introduction
GOSUB Rules
GOSUB Rules2
GOSUB Rules3
GOSUB Sample
GOSUB Initialize
GOSUB EliDpl1
GOSUB EliDpl2
GOSUB Shifted1
GOSUB Shifted2
GOSUB Plaintext
GOSUB Encipher
GOSUB Crib
GOSUB Caesar
GOSUB Wrapup
END


' Introduction to program and credits for program
Introduction:
CLS  ' Clear screen
PRINT "This K4 Simple Substitution Enciphering Program was written in"
PRINT
PRINT "PowerBasic Ver. 3.5 for DOS by Archie Bullington in October, 2001."
PRINT
PRINT "This program is based on a program written in BASIC by Mike"
PRINT
PRINT "Barlow in March, 1990.  Russell Atkinson, 'The Rat', helped me"
PRINT
PRINT "develop the alphabet shift module and other modules."
PRINT
PRINT "Press any key to continue."
PAK$ = INPUT$(1)    ' Halts program until any key is pressed.
RETURN

' Rules as set forth by the ACA in 'The ACA and You'.
Rules:
CLS  ' Clear screen
PRINT "The following rules apply to Aristocrats, Patristocrats, and"
PRINT
PRINT "Xenocrypts.  These are found in 'The ACA and You'."
PRINT
PRINT "1.  The length for Aristocrats should be 75-100 letters."
PRINT
PRINT "2.  The length for Xenocrypts should be 85-120 letters."
PRINT
PRINT "3.  The length for Patristocrats should be 90-105 letters,and"
PRINT
PRINT "    in no case less than 85 letters or more than 140 letters."
PRINT
PRINT "4.  Word divisions are maintained."
PRINT
PRINT "5.  Each ciphertext letter may stand for only one other"
PRINT
PRINT "    plaintext letter."
PRINT
PRINT "6.  Each plaiantext letter must be replaced by a ciphertext letter"
PRINT
PRINT "    not equal to itself."
PRINT
PRINT "Press any key to continue."
PAK$ = INPUT$(1)  '  Halts program until any key is pressed.
RETURN

' Rules continued
Rules2:
CLS  ' Clear screen
PRINT "7.  An asterisk (*) is indicated to show the use of proper nouns"
PRINT
PRINT "    which may, or may not be part of the English dictionary."
PRINT
PRINT "    These are limited to 3."
PRINT
PRINT "8.  No more than 3 singletons (letters used only once)."
PRINT
PRINT "9.  At least 18 different letters should be used in each cipher."
PRINT
PRINT "10. Repeated consecutive plaintext should be avoided."
PRINT
PRINT "11. Use a single hyphen (-) when a word is split at the end of a"
PRINT
PRINT "    line; this does not indicate proper syllabic hyphenation."
PRINT
PRINT "Press any key to continue."
PAK$ = INPUT$(1)  ' PAK = Press Any Key
RETURN

' Rules continued
Rules3:
CLS
PRINT "12. Use a double hyphen (=) if the word is hyphenated in the"
PRINT
PRINT "    plaintext."
PRINT
PRINT "13. Cipher tips, also called cribs may be in plaintext form or"
PRINT
PRINT "    in an enciphered Caesar shift format."
PRINT
PRINT "Press any key to continue."
PAK$ = INPUT$(1)
RETURN

' Sample K4 key and message with encipherment.
Sample:
CLS  ' Clear screen
PRINT "The following is an example of a simple substitution cipher using"
PRINT
PRINT "a K4 alphabet."
PRINT
PRINT
PRINT "PT Alphabet:  SHOPTALKBCDEFGIJMNQRUVWXYZ"
PRINT "CT Alphabet:  VWXYZJUPITERABCDFGHKLMNOQS"
PRINT
PRINT
PRINT
PRINT
PRINT "Plaintext:    SIMPLE SUBSTITUTION CIPHERS ARE FUN TO SOLVE."
PRINT "Ciphertext:   VCFYUR VLIVZCZLZCXG TCYWRKV JKR ALG ZX VXUMR."
PRINT
PRINT
PRINT "CRIB:            SIMPLE"
PRINT "ENCIPHERED CRIB: MCGJFY"
PRINT
PRINT
PRINT "Press any key to continue."
PAK$ = INPUT$(1)
RETURN

' Enter the two keywords; first the plain alphabet keyword and then the
' cipher alphabet keyword.  Uses UCASE$ function to convert letters
' from lowercase to uppercase.
Initialize:
CLS
DIM PAKW AS STRING  ' Plain Alphabet KeyWord
DIM CAKW AS STRING  ' Cipher Alphabet KeyWord
PRINT "Please enter your plain alphabet keyword at the prompt."
PRINT
PRINT "It can be in either lower or uppercase.  Then press the ENTER key."
PRINT
PRINT "Please enter your cipher alphabet keyword at the prompt."
PRINT
PRINT "It can be in either lower or uppercase.  Then press the ENTER key."
PRINT
PRINT "The two keywords must be different."
PRINT
LINE INPUT "Please enter the plain alphabet keyword.  "; PAKW
PRINT
LINE INPUT "Please enter the cipher alphabet keyword. "; CAKW
PAKW = UCASE$(PAKW)  ' UCASE$ converts lowercase letters to uppercase.
CAKW = UCASE$(CAKW)  ' UCASE$ converts lowercase letters to uppercase.
RETURN

' This module adds the plain straight alphabet to the plain
' alphabet keyword and then eliminates all duplicate letters.
EliDpl1:
DIM Alphabet AS STRING
DIM PlainAlphabet AS STRING
DIM X AS STRING  ' X is a letter position indicator
DIM Y AS STRING  ' Y is a letter position indicator
DIM I AS INTEGER  ' I is used as a counter
DIM J AS INTEGER  ' J is used as a counter
Alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
PlainAlphabet = PAKW + Alphabet
DO UNTIL LEN(PlainAlphabet) = 26
     FOR I = 1 TO (LEN(PlainAlphabet) - 1)
          FOR J = (I + 1) TO LEN(PlainAlphabet)
          X = MID$(PlainAlphabet, I, 1)
          Y = MID$(PlainAlphabet, J, 1)
               IF X = Y THEN
               PlainAlphabet = MID$(PlainAlphabet, 1, J - 1) + MID$(PlainAlphabet, J + 1)
               END IF
          NEXT J
     NEXT I
LOOP
RETURN

' This module adds the plain alphabet to the cipher alphabet keyword.  It
' then eliminates any repeated letters.
EliDpl2:
DIM CipherAlphabet AS STRING
CipherAlphabet = CAKW + Alphabet
DO UNTIL LEN(CipherAlphabet) = 26
     FOR I = 1 TO (LEN(CipherAlphabet) - 1)
          FOR J = (I + 1) TO LEN(CipherAlphabet)
          X = MID$(CipherAlphabet, I, 1)
          Y = MID$(CipherAlphabet, J, 1)
               IF X = Y THEN
               CipherAlphabet = MID$(CipherAlphabet, 1, J - 1) + MID$(CipherAlphabet, J + 1)
               END IF
          NEXT J
     NEXT I
LOOP
RETURN

' This module allows the user to shift the starting point of the plain alphabet
Shifted1:
CLS  ' Clear Screen
DIM SFT AS INTEGER  ' Numerical amount of shift
DIM K AS INTEGER   ' K is used as a counter
DIM L AS INTEGER   ' L is used as a counter
DIM M AS INTEGER   ' M is used as a counter
DIM DBL AS STRING  ' Doubles the length of the plain alphabet
DIM PSH AS STRING  ' Temporary string
DIM PS AS STRING  ' Plain string
DIM TS1 AS STRING  ' Temporary string
DIM TS2 AS STRING  ' Temporary string
DO
DBL = PlainAlphabet + PlainAlphabet
CLS
PRINT "This module enables the user to shift the plain alphabet from 1"
PRINT
PRINT "to 25 spaces.  If you enter a number greater than 25 the process"
PRINT
PRINT "begins again.  It will not let you finish if any plain alphabet"
PRINT
PRINT "letters equals itself as a cipher alphabet letter."
PRINT
PRINT "When you have finished with the plain alphabet shift process, enter"
PRINT
PRINT "0 as the amount of shift in order to continue."
PRINT
PRINT
PRINT "Plain alphabet:   "; PlainAlphabet
PRINT "Cipher alphabet:  "; CipherAlphabet
PRINT
PRINT
INPUT "Enter the amount of shift desired for the plain alphabet"; SFT
     IF SFT > 25 THEN
     GOSUB Shifted1
     END IF
          PSH = ""
          FOR K = 1 TO 26
          PS = MID$(DBL, K + SFT, 1)
          PSH = PSH + PS
          PlainAlphabet = PSH
          NEXT K
DO WHILE LEN(PlainAlphabet) > 26
     FOR L = 1 TO (LEN(Alphabet) - 1)
     TS1 = MID$(PlainAlphabet, L, 1)
          FOR M = L + 1 TO LEN(PlainAlphabet)
          TS2 = MID$(PlainAlphabet, M, 1)
IF TS1 = TS2 THEN
PlainAlphabet = MID$(PlainAlphabet, 1, M - 1) + MID$(PlainAlphabet, M + 1)
END IF
          NEXT M
     NEXT L
LOOP
LOOP UNTIL SFT = 0
PRINT
PRINT
PRINT PlainAlphabet
PRINT CipherAlphabet
GOSUB Check
RETURN

' This module checks the two alphabets for equivilents.
Check:
CLS
DIM N AS INTEGER
     FOR N = 1 TO 26
          IF MID$(PlainAlphabet, N, 1) = MID$(CipherAlphabet, N, 1) THEN
          GOSUB Shifted1
          END IF
     NEXT N
RETURN

' This module allows the user to shift the starting point of the cipher alphabet
Shifted2:
CLS  ' Clear Screen
DIM SHFT AS INTEGER  ' Numerical amount of shift
DIM O AS INTEGER   ' O is used as a counter
DIM P AS INTEGER   ' P is used as a counter
DIM Q AS INTEGER   ' Q is used as a counter
DIM DBL2 AS STRING  ' Doubles the length of the plain alphabet
DIM CSH2 AS STRING  ' Temporary string
DIM CS2 AS STRING  ' Cipher string
DIM TS8 AS STRING  ' Temporary string
DIM TS9 AS STRING  ' Temporary string
DO
DBL2 = CipherAlphabet + CipherAlphabet
CLS
PRINT "This module enables the user to shift the cipher alphabet from 1"
PRINT
PRINT "to 25 spaces.  If you enter a number greater than 25 the process"
PRINT
PRINT "begins again.  It will not let you finish if any plain alphabet"
PRINT
PRINT "letters equals itself as a cipher alphabet letter."
PRINT
PRINT "When you have finished with the cipher alphabet shift process, enter"
PRINT
PRINT "0 as the amount of shift in order to continue."
PRINT
PRINT
PRINT "Plain alphabet:   "; PlainAlphabet
PRINT "Cipher alphabet:  "; CipherAlphabet
PRINT
PRINT
INPUT "Enter the amount of shift desired for the cipher alphabet"; SHFT
     IF SHFT > 25 THEN
     GOSUB Shifted2
     END IF
          CSH2 = ""
          FOR O = 1 TO 26
          CS2 = MID$(DBL2, O + SHFT, 1)
          CSH2 = CSH2 + CS2
          CipherAlphabet = CSH2
          NEXT O
DO WHILE LEN(CipherAlphabet) > 26
     FOR P = 1 TO (LEN(Alphabet) - 1)
     TS8 = MID$(CipherAlphabet, P, 1)
          FOR Q = P + 1 TO LEN(CipherAlphabet)
          TS9 = MID$(CipherAlphabet, Q, 1)
IF TS8 = TS9 THEN
CipherAlphabet = MID$(CipherAlphabet, 1, Q - 1) + MID$(CipherAlphabet, Q + 1)
END IF
          NEXT Q
     NEXT P
LOOP
LOOP UNTIL SHFT = 0
PRINT
PRINT
PRINT PlainAlphabet
PRINT CipherAlphabet
GOSUB Check2
RETURN

' This module checks the two modules for equivilences
Check2:
CLS
DIM R AS INTEGER   ' R is used as counter
     FOR R = 1 TO 26
          IF MID$(PlainAlphabet, R, 1) = MID$(CipherAlphabet, R, 1) THEN
          GOSUB Shifted2
          END IF
     NEXT R
RETURN

' This module accepts the message to be enciphered and converts it
' to uppercase if it is in lowercase
Plaintext:
CLS
DIM PlainMessage AS STRING
PRINT "Please enter your plaintext message to be enciphered."
PRINT
PRINT "Instead of using the quotation mark, please use the"
PRINT
PRINT "apostophe twice.  When you have finished entering the"
PRINT
PRINT "message, please press ENTER."
PRINT
PRINT
LINE INPUT "Please enter your plaintext message. "; PlainMessage
PlainMessage = UCASE$(PlainMessage)
RETURN

' This module enciphers the plaintext message
Encipher:
CLS
DIM S AS INTEGER  ' S is used as counter
DIM T AS INTEGER  ' T is used as a position marker
DIM Punctuation AS STRING  ' Allowable punctuation
DIM PLA AS STRING  ' Plain alphabet plus punctuation
DIM CIA AS STRING  ' Cipher alphabet plus punctuation
DIM CT AS STRING  ' CT = Ciphertext
DIM TS3 AS STRING  ' Temporary string
DIM TS4 AS STRING  ' Temporary string
DIM TS5 AS STRING  ' Temporary string
Punctuation = "`~!*()-_= :;',.?"
PLA = PlainAlphabet + Punctuation
CIA = CipherAlphabet + Punctuation
     FOR S = 1 TO LEN(PlainMessage)
          TS3 = MID$(PlainMessage, S, 1)
          T = INSTR(PLA, TS3)
          TS4 = MID$(CIA, T, 1)
          TS5 = TS4
          CT = CT + TS5
     NEXT S
RETURN

' This module asks the user for a crib or tip
Crib:
CLS
DIM Tip AS STRING
PRINT "If you wish to include a crib for other solvers, please"
PRINT
PRINT "type it in and then press ENTER.  The crib will be shifted"
PRINT
PRINT "backwards 6 places in the alphabet automatically.  If you do"
PRINT
PRINT "not wish to include a crib, please press the space bar once"
PRINT
PRINT "and then press ENTER."
PRINT
LINE INPUT "Please enter your crib or press space bar once. "; Tip
Tip = UCASE$(Tip)
RETURN

' This module enciphers the crib using a ceasar shift of -6
Caesar:
DIM RegAlph AS STRING
DIM CaeAlph AS STRING
DIM TS6 AS STRING
DIM TS7 AS STRING
DIM CTip AS STRING
DIM U AS INTEGER
DIM V AS INTEGER
CLS
RegAlph = "ABCDEFGHIJKLMNOPQRSTUVWXYZ!*()-=:;',.? "
CaeAlph = "UVWXYZABCDEFGHIJKLMNOPQRST!*()-=:;',.? "
     FOR U = 1 TO LEN(Tip)
           TS6 = MID$(Tip, U, 1)
           V = INSTR(RegAlph, TS6)
           TS7 = MID$(CaeAlph, V, 1)
           CTip = CTip + TS7
     NEXT U
RETURN

' This module dispoays the results
Wrapup:
CLS
LOCATE 1, 3
PRINT "YOUR PLAIN ALPHABET KEYWORD IS:   "; PAKW
LOCATE 2, 3
PRINT "YOUR CIPHER ALPHABET KEYWORD IS:  "; CAKW
LOCATE 4, 3
PRINT "P:   "; PlainAlphabet
LOCATE 5, 3
PRINT "C:   "; CipherAlphabet
LOCATE 9, 3
PRINT "PT:  "; PlainMessage
LOCATE 14, 3
PRINT "CT:  "; CT
LOCATE 19, 3
PRINT "CRIB:              "; Tip
LOCATE 20, 3
PRINT "ENCIPHERED CRIB:   "; CTip
PRINT
PRINT "Press any key to continue."
PAK$ = INPUT$(1)
RETURN