This module is part of the original MMBasic library. It is reproduced here with kind permission of Hugh Buckle and Geoff Graham. Be aware it may reference functionality which has changed or is deprecated in the latest versions of MMBasic.
'ENIGMA for Maximite
'written by Ray Alger April 2015
'Output file added by Hugh Buckle May 2015
OFileName$="EnigOut.txt"
Dim RD$(10):Dim D$(4):Dim R(4):Dim V(5):Dim RS(4):Dim RP(4)
Dim PB(26):Dim PBD(26):Dim PBS(26):Dim REF(26):Dim KO(8,2)
Dim ROT$(10):Dim REF$(2):Dim FOR0(26):Dim REV0(26):Dim FOR1(26)
Dim REV1(26):Dim FOR2(26):Dim REV2(26):Dim FOR3(26):Dim REV3(26)
'Rotor display data
RD$(1)=" I ":RD$(2)=" II ":RD$(3)=" III":RD$(4)=" IV ":RD$(5)=" V "
RD$(6)=" VI ":RD$(7)=" VII":RD$(8)="VIII":RD$(9)="beta":RD$(10)="gamm"
'rotor knock on data
KO(1,1)=16:KO(2,1)=4:KO(3,1)=21:KO(4,1)=9:KO(5,1)=25
KO(1,2)=16:KO(2,2)=4:KO(3,2)=21:KO(4,2)=9:KO(5,2)=25
KO(6,1)=25:KO(7,1)=25:KO(8,1)=25
KO(6,2)=12:KO(7,2)=12:KO(8,2)=12
'Rotor data
ROT$(1)="EKMFLGDQVZNTOWYHXUSPAIBRCJ" 'I
ROT$(2)="AJDKSIRUXBLHWTMCQGZNPYFVOE" 'II
ROT$(3)="BDFHJLCPRTXVZNYEIWGAKMUSQO" 'III
ROT$(4)="ESOVPZJAYQUIRHXLNFTGKDCMWB" 'IV
ROT$(5)="VZBRGITYUPSDNHLXAWMJQOFECK" 'V
ROT$(6)="JPGVOUMFYQBENHZRDKASXLICTW" 'VI
ROT$(7)="NZJHGRCXMYSWBOUFAIVLPEKQDT" 'VII
ROT$(8)="FKQHTLXOCBJSPDZRAMEWNIUYGV" 'VIII
ROT$(9)="LEYJVCNIXWPBQMDRTAKZGFUHOS" 'beta
ROT$(10)="FSOKANUERHMBTIYCWLQPZXVGJD" 'gamma
'Reflector data
REF$(1)="ENKQAUYWJICOPBLMDXZVFTHRGS" 'Thin B
REF$(2)="RDOBJNTKVEHMLFCWZAXGYIPSUQ" 'Thin C
'Plug board data
PB$ ="QWERTZUIOASDFGHJKPYXCVBNML"
For J=0 To 25:PBD(J)=Asc(Mid$(PB$,J+1,1))-65:Next J
DAY$="C VI I VII XEL ML YE JH WQ"
TRI$="JEX GFE"
CIPHER$="YKDMD SZZPA BFCMJ EZIGN MSROU GPDSO HHSIU JJLSC NBBTY UOTX"
Function MOD26(X)
X=Cint(X) 'fix error
X=26*(X/26-Int(X/26))
If X<0 Then X=X+26
MOD26=X
End Function
'Screen setup
START: Cls:Print" ********** Maximite M4 ENIGMA **********"
Print@(0,15)"REFLECTOR ->"
Print@(0,30)"ROTORS USED -->"
DP=30
GoSub DRAW
Print@(0,60)"RING SETTINGS ->"
DP=60
GoSub DRAW
Print@(20,120)"ROTORS -->"
DP=120
GoSub DRAW
Line(125,95)-(130,155),,B:Line(175,95)-(180,155),,B
Line(225,95)-(230,155),,B:Line(275,95)-(280,155),,B
For J=1 To 6
L=J*10
Line(126,90+L)-(129,90+L):Line(176,90+L)-(179,90+L)
Line(226,90+L)-(229,90+L):Line(276,90+L)-(279,90+L)
Next J
Line(1,325)-(330,390),,B
Print@(36,385)"PLUG BOARD"
For J=0 To 25:PB(J)=J:Next J 'Init Plug array
For J=0 To 25:PBS(J)=0:Next J 'Init Plug status
GoSub SHOW
Line(1,175)-(331,240),,B
Print@(36,235)"LAMP BOARD"
CODE=26 'no lamp
GoSub LAMP
GoSub REFSET
GoSub ROTSET
GoSub RINGSET
GoSub PLUGSET
GoSub SETROT
'HFBmod 20150509 start - add output file
gosub OpenOutFile
'HFBmod 20150509 end
'rotor offset arrays
For J=0 To 25
T=Asc(Mid$(ROT$(R(0)),J+1,1))-65
U=Asc(Mid$(ROT$(R(1)),J+1,1))-65
V=Asc(Mid$(ROT$(R(2)),J+1,1))-65
W=Asc(Mid$(ROT$(R(3)),J+1,1))-65
FOR0(J)=T-J
REV0(T)=J-T
FOR1(J)=U-J
REV1(U)=J-U
FOR2(J)=V-J
REV2(V)=J-V
FOR3(J)=W-J
REV3(W)=J-W
Next J
'knock on data
KO3A=KO(R(3),1):KO3B=KO(R(3),2)
KO2A=KO(R(2),1):KO2B=KO(R(2),2)
'refelector data
For J=0 To 25:REF(J)=Asc(Mid$(REF$(RF),J+1,1))-65:Next J
Print@(0,250)"Text IN-"
Print@(0,280)"Text OUT-"
CLRPAD: PL$="":CI$="":CCNT=0:TB=0
Print@(0,265)" "
Print@(0,295)" "
Print@(0,410,2)"Enter text, Press[Esc] to change settings "
ENCRYPT:
TB=TB+1:If TB>60 Then GoTo PADFUL
GoSub LETTER
If K=27 Then GoTo ESCAPE
If K>25 Then GoTo ENCRYPT
'rotor steps
If RP(3)=KO3A Or RP(3)=KO3B Then GoTo ADV2
If RP(2)=KO2A Or RP(2)=KO2B Then GoTo ADV1 ' R2 double step
GoTo ADV3
ADV1: RP(1)=RP(1)+1
If RP(1)>25 Then RP(1)=RP(1)-26
ADV2: RP(2)=RP(2)+1
If RP(2)>25 Then RP(2)=RP(2)-26
ADV3: RP(3)= RP(3)+1
If RP(3)>25 Then RP(3)=RP(3)-26
'rotor display
DP=120:D$(1)=" "+Chr$(RP(1)+65)+" "
D$(2)=" "+Chr$(RP(2)+65)+" ":D$(3)=" "+Chr$(RP(3)+65)+" "
GoSub VIEW
'scramble
PL$=PL$+Chr$(K+65)
CODE=PB(K)
X=MOD26(CODE+RP(3)-RS(3))
X=MOD26(CODE+FOR3(X))
CODE=X
X=MOD26(X+RP(2)-RS(2))
X=MOD26(CODE+FOR2(X))
CODE=X
X=MOD26(X+RP(1)-RS(1))
X=MOD26(CODE+FOR1(X))
CODE=X
X=MOD26(X+RP(0)-RS(0))
X=MOD26(CODE+FOR0(X))
CODE=REF(X) 'Reflect
X=MOD26(CODE+RP(0)-RS(0))
X=MOD26(CODE+REV0(X))
CODE=X
X=MOD26(CODE+RP(1)-RS(1))
X=MOD26(CODE+REV1(X))
CODE=X
X=MOD26(X+RP(2)-RS(2))
X=MOD26(CODE+REV2(X))
CODE=X
X=MOD26(X+RP(3)-RS(3))
X=MOD26(CODE+REV3(X))
CODE=PB(X)
CI$=CI$+Chr$(CODE+65)
'HFBmod 20150509 start - add output file
'Write encrypted code to output file in groups of 5 characters
'New line after 12 character groups
Print #1,Chr$(CODE+65);
IO=IO+1
if IO>4 then ' Space after 5 characters
IO=0
IG=IG+1
If IG>12 then
IG=0
Print #1, Chr$(13) ' new line
else
Print #1, " ";
endif
endif
'HFBmod 20150509 end
GoSub LAMP
CODE=26 'no lamp
Pause 500
GoSub LAMP
Print@(0,265) PL$
Print@(0,295) CI$
CCNT=CCNT+1:If CCNT<5 Then GoTo ENCRYPT
CCNT=0
PL$=PL$+" "
CI$=CI$+" "
GoTo ENCRYPT
ESCAPE:
Print@(0,410,2)"Press [A] to adjust rotors, [S] to change setup, [Esc] to exit"
GoSub LETTER
'HFBmod 20150509 start - add output file
If K=18 Then 'Chr$(18+65)= "S"
Close #1
GoTo START
endif
If K=27 Then ' Esc key
Close #1
end
endif
'HFBmod 20150509 end
If K<>0 Then GoTo ESCAPE
Print@(0,410)" "
GoSub ADJROT
'HFBmod 20150509 start - add output file
'Clear the output file after the rotors are adjusted
Close #1
gosub OpenOutFile
'HFBmod 20150509 end
GoTo CLRPAD
'HFBmod 20150509 start - add output file
OpenOutFile:
Open OFileName$ for output as #1
IO=0:IG=0 ' reset output character and group counts
Return
'HFBmod 20150509 end
PADFUL:
Print@(0,410,2)"Pad Full, copy message, [Enter] to Continue "
GoSub LETTER
If K<> 28 Then GoTo PADFUL
'HFBmod 20150509 start - add output file
print #1, Chr$(13) ' new line in output file
IO=0:IG=0
'HFBmod 20150509 end
GoTo CLRPAD
REFSET:
Print@(80,15,2)"Select the Reflector (B or C)"
GoSub LETTER
If K<1 Or K>2 Then GoTo REFSET
RF=K
Print@(80,15)Chr$(K+65);" "
Return
ROTSET:
For J=0 To 3
D$(J)=" ":R(J)=0:V(J)=0
Next J
J=9:V(0)=2:DP=30
Print@(0,45,2)"Press [Space] to change Rotor, [Enter] for next Rotor"
ROTOR0:
GoSub VIEW
GoSub LETTER
If K<>26 Then GoTo CRR0
D$(0)=RD$(J)
J=J+1:If J>10 Then J=9
GoTo ROTOR0
CRR0: If K<>28 Then GoTo ROTOR0
If D$(0)=" " Then GoTo ROTOR0
J=J-1:If J=8 Then J=10
R(0)=J:V(0)=0:V(1)=2:J=1:I=1
ROTOR:
GoSub VIEW
GoSub LETTER
If K<>26 Then GoTo CRR1
If J=R(1) Or J=R(2) Then GoTo NXT1
GoTo SKIP
NXT1: J=J+1:If J>8 Then J=1
If J=R(1) Or J=R(2) Then GoTo NXT1
SKIP: D$(I)=RD$(J)
J=J+1:If J>8 Then J=1
GoTo ROTOR
CRR1: If K<>28 Then GoTo ROTOR
If D$(I)=" " Then GoTo ROTOR
J=J-1:If J=0 Then J=8
R(I)=J:V(I)=0:V(I+1)=2:J=1
I=I+1:If I<4 Then GoTo ROTOR
Print@(0,45)" "
GoSub VIEW
Return
RINGSET:
Print@(0,75,2)"Rotor Ring Setting (A to Z), [Enter] for next Rotor"
For J=0 To 3
D$(J)=" A ":RS(J)=0:V(J)=0
Next J
J=0:V(0)=2:DP=60
RING:
GoSub VIEW
GoSub LETTER
If K=28 Then GoTo CRS
If K>25 Then GoTo RING
D$(J)=" "+Chr$(K+65)+" "
RS(J)=K 'offset 0-25
GoTo RING
CRS: V(J)=0:V(J+1)=2
J=J+1:If J<4 Then GoTo RING
Print@(0,75)" "
GoSub VIEW
Return
PLUGSET:
Print@(0,310,2)"PLUG ? To PLUG ? ([Enter] when all done)"
PL1: GoSub LETTER
If K=28 Then GoTo PRET
If K>25 Then GoTo PL1
Print@(30,310)Chr$(K+65)
H=K
PL2: GoSub LETTER
If K=28 Then GoTo PRET
If K>25 Then GoTo PL2
Print@(90,310)Chr$(K+65)
Pause 50
If K<>H Then GoTo SWAP
PB(PB(H))=PB(H):PB(H)=H 'plugboard letter restore
SWAP: If PB(H)<>H Or PB(K)<>K Then GoTo FORBID
PB(H)=K:PB(K)=H 'plugboard letter swap
GoSub SHOW
GoTo PLUGSET
FORBID:
Print@(0,310)"NOT ALLOWED PLUG ALREADY USED! "
Pause 3000
GoTo PLUGSET
PRET: Print@(0,310)" "
Return
SETROT:
For J=0 To 3
D$(J)=" A ":RP(J)=0:V(J)=0
Next J
ADJROT:
Print@(0,160,2)"Set Rotor Start Position (A-Z), [Enter] for next Rotor"
J=0:V(0)=2:DP=120
ROTPOS:
GoSub VIEW
GoSub LETTER
If K=28 Then GoTo CRP
If K>25 Then GoTo ROTPOS
RP(J)=K
D$(J)=" "+Chr$(RP(J)+65)+" "
GoTo ROTPOS
CRP: V(J)=0:V(J+1)=2
J=J+1:If J<4 Then GoTo ROTPOS
Print@(0,160)" "
GoSub VIEW
Return
VIEW:
Print@(100,DP,V(0))D$(0):Print@(150,DP,V(1))D$(1)
Print@(200,DP,V(2))D$(2):Print@(250,DP,V(3))D$(3)
DRAW:
Line(99,DP-1)-(124,DP+11),,B:Line(149,DP-1)-(174,DP+11),,B
Line(199,DP-1)-(224,DP+11),,B:Line(249,DP-1)-(274,DP+11),,B
Return
SHOW:
For J = 0 To 8
If PB(PBD(J))<>PBD(J) Then V=2 Else V=0
Print@((J)*36+7,330,V) "[";Chr$(PBD(J)+65);Chr$(PB(PBD(J))+65);"]"
Next J
For J = 0 To 7
If PB(PBD(J+9))<>PBD(J+9) Then V=2 Else V=0
Print@((J)*36+17,350,V) "[";Chr$(PBD(J+9)+65);Chr$(PB(PBD(J+9))+65);"]"
Next J
For J = 0 To 8
If PB(PBD(J+17))<>PBD(J+17) Then V=2 Else V=0
Print@((J)*36+2,370,V) "[";Chr$(PBD(J+17)+65);Chr$(PB(PBD(J+17))+65);"]"
Next J
Return
LETTER: 'Wait for key press
K$=Inkey$
If K$="" Then GoTo LETTER
K=Asc(K$)
If K=13 Then K=28 'CR
If K=32 Then K=26 'SP
If K>25 And K<29 Then GoTo LRET
If K>64 And K<91 Then GoTo UPC 'ucase
If K>96 And K<123 Then GoTo LOC 'lcase
GoTo LETTER
LOC: K=K-32 'conv to ucase
UPC: K=K-65 'bound 0 to 25
LRET: Return
LAMP:
For J = 0 To 8
If PBD(J)=CODE Then V=2 Else V=0
Print@((J)*36+10,180,V) "(";Chr$(PBD(J)+65);")"
Next J
For J = 0 To 7
If PBD(J+9)=CODE Then V=2 Else V=0
Print@((J)*36+20,200,V) "(";Chr$(PBD(J+9)+65);")"
Next J
For J = 0 To 8
If PBD(J+17)=CODE Then V=2 Else V=0
Print@((J)*36+5,220,V) "(";Chr$(PBD(J+17)+65);")"
Next J
Return
'ENIGMA for MMDOS
'written by Ray Alger May 2015
'Output file added by Hugh Buckle May 2015
OFileName$="EnigOut.txt"
Dim RD$(10):Dim D$(4):Dim R(4):Dim V(5):Dim RS(4):Dim RP(4)
Dim PB(26):Dim PBD(26):Dim REF(26):Dim KO(8,2)
Dim ROT$(10):Dim REF$(2):Dim FOR0(26):Dim REV0(26):Dim FOR1(26)
Dim REV1(26):Dim FOR2(26):Dim REV2(26):Dim FOR3(26):Dim REV3(26)
Dim S$(36):Dim T$(30):Dim BT$(4):Dim BB$(4):Dim BS$(4)
'Rotor display data
RD$(0)=" I ":RD$(1)=" II ":RD$(2)=" III":RD$(3)=" IV ":RD$(4)=" V "
RD$(5)=" VI ":RD$(6)=" VII":RD$(7)="VIII":RD$(8)="beta":RD$(9)="gamm"
'rotor knock on data
KO(0,1)=16:KO(1,1)=4:KO(2,1)=21:KO(3,1)=9:KO(4,1)=25
KO(0,2)=16:KO(1,2)=4:KO(2,2)=21:KO(3,2)=9:KO(4,2)=25
KO(5,1)=25:KO(6,1)=25:KO(7,1)=25
KO(5,2)=12:KO(6,2)=12:KO(7,2)=12
'Rotor data
ROT$(0)="EKMFLGDQVZNTOWYHXUSPAIBRCJ" 'I
ROT$(1)="AJDKSIRUXBLHWTMCQGZNPYFVOE" 'II
ROT$(2)="BDFHJLCPRTXVZNYEIWGAKMUSQO" 'III
ROT$(3)="ESOVPZJAYQUIRHXLNFTGKDCMWB" 'IV
ROT$(4)="VZBRGITYUPSDNHLXAWMJQOFECK" 'V
ROT$(5)="JPGVOUMFYQBENHZRDKASXLICTW" 'VI
ROT$(6)="NZJHGRCXMYSWBOUFAIVLPEKQDT" 'VII
ROT$(7)="FKQHTLXOCBJSPDZRAMEWNIUYGV" 'VIII
ROT$(8)="LEYJVCNIXWPBQMDRTAKZGFUHOS" 'beta
ROT$(9)="FSOKANUERHMBTIYCWLQPZXVGJD" 'gamma
'Reflector data
REF$(1)="ENKQAUYWJICOPBLMDXZVFTHRGS" 'Thin B
REF$(2)="RDOBJNTKVEHMLFCWZAXGYIPSUQ" 'Thin C
'Plug board data
PB$ ="QWERTZUIOASDFGHJKPYXCVBNML"
For J=0 To 25:PBD(J)=Asc(Mid$(PB$,J+1,1))-65:Next J
DAY$="C VI I VII XEL ML YE JH WQ"
TRI$="JEX GFE"
CIPHER$="YWXUN KKCJC TLZHN SQKMD QDRKC YOIJN FJINQ KPIOU NRNG"
Function MOD26(X)
X=Cint(X) 'fix error
X=X MOD 26
If X<0 Then X=X+26
MOD26=X
End Function
Function MOD8(X)
X=X MOD 8
If X<0 Then X=X+8
MOD8=X
End Function
'DOS Screen setup
SYSTEM "mode 80,45" 'DOS box width (chars), depth (lines)
SYSTEM "title MMDOS ENIGMA" 'DOS box title
'box string data
D1$=Chr$(218):D2$=Chr$(179):D3$=Chr$(192):D4$=Chr$(196):D5$=Chr$(191):D6$=Chr$(217)
D7$=Chr$(201):D8$=Chr$(186):D9$=Chr$(200):D10$=Chr$(205):D11$=Chr$(187):D12$=Chr$(188)
BT$(0)=D1$+D4$+D4$+D4$+D4$+D5$:BT$(1)=D7$+D10$+D10$+D10$+D10$+D11$
BT$(2)=D1$+D4$+D4$+D5$:BT$(3)=" "
BB$(0)=D3$+D4$+D4$+D4$+D4$+D6$:BB$(1)=D9$+D10$+D10$+D10$+D10$+D12$
BB$(2)=D3$+D4$+D4$+D6$:BB$(3)=" "
BS$(0)=D2$:BS$(1)=D8$:BS$(2)=D2$:BS$(3)=" "
For J=1 To 47:BH$=BH$+D4$:Next J
START:
For J=1 To 36
S$(J)=""
Next J
S$(15)=D1$+BH$+D5$
S$(25)=D3$+Left$(BH$,8)+"PLUG BOARD"+Left$(BH$,29)+D6$
S$(1)=" ************* MMDOS M4 ENIGMA *************"
T$(2)="REFLECTOR ->"
T$(4)="ROTORS USED -->"
T$(8)="RING SETTINGS ->"
T$(12)=" ROTORS -->"
For J=0 To 25:PB(J)=J:Next J 'Init Plug array
GoSub SHOW
GoSub REFSET
GoSub ROTSET
GoSub RINGSET
GoSub PLUGSET
GoSub SETROT
'HFBmod 20150509 start - add output file
gosub OpenOutFile
'HFBmod 20150509 end
'rotor offset arrays
For J=0 To 25
T=Asc(Mid$(ROT$(R(0)),J+1,1))-65
U=Asc(Mid$(ROT$(R(1)),J+1,1))-65
V=Asc(Mid$(ROT$(R(2)),J+1,1))-65
W=Asc(Mid$(ROT$(R(3)),J+1,1))-65
FOR0(J)=T-J
REV0(T)=J-T
FOR1(J)=U-J
REV1(U)=J-U
FOR2(J)=V-J
REV2(V)=J-V
FOR3(J)=W-J
REV3(W)=J-W
Next J
'knock on data
KO3A=KO(R(3),1):KO3B=KO(R(3),2)
KO2A=KO(R(2),1):KO2B=KO(R(2),2)
'refelector data
For J=0 To 25:REF(J)=Asc(Mid$(REF$(RF),J+1,1))-65:Next J
CLRPAD:SPL$="":SCI$=""
S$(29)="Text IN-"
S$(33)="Text OUT-"
CLPAD:S$(30)=SPL$:S$(34)=SCI$:PL$="":CI$="":CCNT=0:TB=0
S$(27)="Enter text, Press[Esc] to change settings"
GoSub SCRN
ENCRYPT:
GoSub LETTER
If K=27 Then GoTo ESCAPE
If K>25 Then GoTo ENCRYPT
TB=TB+1:If TB>200 Then GoTo PADFUL
'rotor steps
If RP(3)=KO3A Or RP(3)=KO3B Then GoTo ADV2
If RP(2)=KO2A Or RP(2)=KO2B Then GoTo ADV1 ' R2 double step
GoTo ADV3
ADV1: RP(1)=MOD26(RP(1)+1)
ADV2: RP(2)=MOD26(RP(2)+1)
ADV3: RP(3)=MOD26(RP(3)+1)
'rotor display
DP=12:D$(0)=" "+Chr$(RP(0)+65)+" ":D$(1)=" "+Chr$(RP(1)+65)+" "
D$(2)=" "+Chr$(RP(2)+65)+" ":D$(3)=" "+Chr$(RP(3)+65)+" "
'scramble
PL$=PL$+Chr$(K+65)
CODE=PB(K)
X=MOD26(CODE+RP(3)-RS(3))
X=MOD26(CODE+FOR3(X))
CODE=X
X=MOD26(X+RP(2)-RS(2))
X=MOD26(CODE+FOR2(X))
CODE=X
X=MOD26(X+RP(1)-RS(1))
X=MOD26(CODE+FOR1(X))
CODE=X
X=MOD26(X+RP(0)-RS(0))
X=MOD26(CODE+FOR0(X))
CODE=REF(X) 'Reflect
X=MOD26(CODE+RP(0)-RS(0))
X=MOD26(CODE+REV0(X))
CODE=X
X=MOD26(CODE+RP(1)-RS(1))
X=MOD26(CODE+REV1(X))
CODE=X
X=MOD26(X+RP(2)-RS(2))
X=MOD26(CODE+REV2(X))
CODE=X
X=MOD26(X+RP(3)-RS(3))
X=MOD26(CODE+REV3(X))
CODE=PB(X)
CI$=CI$+Chr$(CODE+65)
'HFBmod 20150509 start - add output file
'Write encrypted code to output file in groups of 5 characters
'New line after 12 character groups
Print #1,Chr$(CODE+65);
IO=IO+1
if IO>4 then ' Space after 5 characters
IO=0
IG=IG+1
If IG>12 then
IG=0
Print #1, Chr$(13) ' new line
else
Print #1, " ";
endif
endif
'HFBmod 20150509 end
S$(30)=PL$
S$(34)=CI$
GoSub VIEW
CCNT=CCNT+1:If CCNT<5 Then GoTo ENCRYPT
CCNT=0
PL$=PL$+" "
CI$=CI$+" "
GoTo ENCRYPT
ESCAPE:
S$(27)="Press[A] to set Rotors, [S] for setup, [Esc] to exit"
GoSub SCRN
GoSub LETTER
'HFBmod 20150509 start - add output file
If K=18 Then 'Chr$(18+65)= "S"
Close #1
GoTo START
endif
If K=27 Then ' Esc key
Close #1
end
endif
'HFBmod 20150509 end
If K<>0 Then GoTo ESCAPE
S$(27)=""
GoSub ADJROT
'HFBmod 20150509 start - add output file
'Clear the output file after the rotors are adjusted
Close #1
gosub OpenOutFile
'HFBmod 20150509 end
GoTo CLRPAD
'HFBmod 20150509 start - add output file
OpenOutFile:
Open OFileName$ for output as #1
IO=0:IG=0 ' reset output character and group counts
Return
'HFBmod 20150509 end
PADFUL:
S$(27)="Pad Full, copy message, [Enter] to Continue"
GoSub SCRN
GoSub LETTER
If K<> 28 Then GoTo PADFUL
'HFBmod 20150509 start - add output file
print #1, Chr$(13) ' new line in output file
IO=0:IG=0
'HFBmod 20150509 end
SPL$=Right$(PL$,6)
SCI$=Right$(CI$,6)
GoTo CLPAD
REFSET:
S$(2)="REFLECTOR -> Select the Reflector [B] or [C]"
GoSub SCRN
GoSub LETTER
If K<1 Or K>2 Then GoTo REFSET
RF=K
S$(2)="REFLECTOR -> "+Chr$(K+65)
'GoSub SCRN
Return
ROTSET:
For J=0 To 3
D$(J)=" ":R(J)=10:V(J)=0
Next J
J=8:V(0)=1:DP=4
S$(6)="[Space] to change Rotor, [Enter] for next Rotor"
ROTOR0:
GoSub VIEW
GoSub LETTER
If K<>26 Then GoTo CRR0
D$(0)=RD$(J)
J=J+1:If J>9 Then J=8
GoTo ROTOR0
CRR0: If K<>28 Then GoTo ROTOR0
If D$(0)=" " Then GoTo ROTOR0
J=J-1:If J=7 Then J=9
R(0)=J:V(0)=0:V(1)=1:J=0:I=1
ROTOR:
GoSub VIEW
GoSub LETTER
If K<>26 Then GoTo CRR1
If J=R(1) Or J=R(2) Then GoTo NXT1
GoTo SKIP
NXT1: J=MOD8(J+1)
If J=R(1) Or J=R(2) Then GoTo NXT1
SKIP: D$(I)=RD$(J)
J=MOD8(J+1)
GoTo ROTOR
CRR1: If K<>28 Then GoTo ROTOR
If D$(I)=" " Then GoTo ROTOR
J=MOD8(J-1)
R(I)=J:V(I)=0:V(I+1)=1:J=0
I=I+1:If I<4 Then GoTo ROTOR
S$(6)=""
GoSub VIEW
Return
RINGSET:
S$(10)="Ring Setting [A] to [Z], [Enter] for next Rotor"
For J=0 To 3
D$(J)=" A ":RS(J)=0:V(J)=0
Next J
J=0:V(0)=1:DP=8
RING:
GoSub VIEW
GoSub LETTER
If K=28 Then GoTo CRS
If K>25 Then GoTo RING
D$(J)=" "+Chr$(K+65)+" "
RS(J)=K 'offset 0-25
GoTo RING
CRS: V(J)=0:V(J+1)=1
J=J+1:If J<4 Then GoTo RING
S$(10)=""
GoSub VIEW
Return
PLUGSET:
S$(14)="PLUG ? To PLUG ? [Enter] when all done"
GoSub SCRN
PL1: GoSub LETTER
If K=28 Then GoTo PRET
If K>25 Then GoTo PL1
S$(14)="PLUG "+Chr$(K+65)+" To PLUG ? [Enter] when all done"
GoSub SCRN
H=K
PL2: GoSub LETTER
If K=28 Then GoTo PRET
If K>25 Then GoTo PL2
'S$(21)=Chr$(K+65)
'Pause 50
If K<>H Then GoTo SWAP
PB(PB(H))=PB(H):PB(H)=H 'plugboard letter restore
SWAP: If PB(H)<>H Or PB(K)<>K Then GoTo FORBID
PB(H)=K:PB(K)=H 'plugboard letter swap
GoSub SHOW
GoTo PLUGSET
FORBID:
S$(14)="NOT ALLOWED PLUG ALREADY USED!"
GoSub SCRN
Pause 2000
GoTo PLUGSET
PRET: S$(14)=""
'GoSub SCRN
Return
SETROT:
For J=0 To 3
D$(J)=" A ":RP(J)=0:V(J)=0
Next J
ADJROT:
S$(14)="Rotor Start Pos. [A] to [Z], [Enter] for next Rotor"
J=0:V(0)=1:DP=12
ROTPOS:
GoSub VIEW
GoSub LETTER
If K=28 Then GoTo CRP
If K>25 Then GoTo ROTPOS
RP(J)=K
D$(J)=" "+Chr$(RP(J)+65)+" "
GoTo ROTPOS
CRP: V(J)=0:V(J+1)=1
J=J+1:If J<4 Then GoTo ROTPOS
S$(14)=""
GoSub VIEW
Return
VIEW:
DV0$=BS$(V(0))+D$(0)+BS$(V(0)):DV1$=BS$(V(1))+D$(1)+BS$(V(1))
DV2$=BS$(V(2))+D$(2)+BS$(V(2)):DV3$=BS$(V(3))+D$(3)+BS$(V(3))
S$(DP-1)=" "+BT$(V(0))+" "+BT$(V(1))+" "+BT$(V(2))+" "+BT$(V(3))
S$(DP)=T$(DP)+" "+DV0$+" "+DV1$+" "+DV2$+" "+DV3$
S$(DP+1)=" "+BB$(V(0))+" "+BB$(V(1))+" "+BB$(V(2))+" "+BB$(V(3))
GoTo SCRN
Return
SHOW:
S$(16)=D2$+" ":S$(17)=D2$+" ":S$(18)=D2$+" "
For J = 0 To 8
If PB(PBD(J))<>PBD(J) Then V=2 Else V=3
S$(16)=S$(16)+BT$(V)+" "
S$(17)=S$(17)+BS$(V)+Chr$(PBD(J)+65)+Chr$(PB(PBD(J))+65)+BS$(V)+" "
S$(18)=S$(18)+BB$(V)+" "
Next J
S$(16)=S$(16)+D2$:S$(17)=S$(17)+D2$:S$(18)=S$(18)+D2$
S$(19)=D2$+" ":S$(20)=D2$+" ":S$(21)=D2$+" "
For J = 9 To 16
If PB(PBD(J))<>PBD(J) Then V=2 Else V=3
S$(19)=S$(19)+BT$(V)+" "
S$(20)=S$(20)+BS$(V)+Chr$(PBD(J)+65)+Chr$(PB(PBD(J))+65)+BS$(V)+" "
S$(21)=S$(21)+BB$(V)+" "
Next J
S$(19)=S$(19)+" "+D2$:S$(20)=S$(20)+" "+D2$:S$(21)=S$(21)+" "+D2$
S$(22)=D2$+" ":S$(23)=D2$+" ":s$(24)=D2$+" "
For J = 17 To 25
If PB(PBD(J))<>PBD(J) Then V=2 Else V=3
S$(22)=S$(22)+BT$(V)+" "
S$(23)=S$(23)+BS$(V)+Chr$(PBD(J)+65)+Chr$(PB(PBD(J))+65)+BS$(V)+" "
S$(24)=S$(24)+BB$(V)+" "
Next J
S$(22)=S$(22)+" "+D2$:S$(23)=S$(23)+" "+D2$:S$(24)=S$(24)+" "+D2$
'GoSub SCRN
Return
LETTER: 'Wait for key press
K$=Inkey$
If K$="" Then GoTo LETTER
K=Asc(K$)
If K=13 Then K=28 'CR
If K=32 Then K=26 'SP
If K>25 And K<29 Then GoTo LRET
If K>64 And K<91 Then GoTo UPC 'ucase
If K>96 And K<123 Then GoTo LOC 'lcase
GoTo LETTER
LOC: K=K-32 'conv to ucase
UPC: K=K-65 'bound 0 to 25
LRET: Return
SCRN: Cls
For L=1 To 36
Print S$(L)
Next L
Return
'Enigma Pseudo-random Setup Generator
'Created by Hugh Buckle May 2015
'For use with Ray Alger's ENIGMA.bas and ENIGMAD.bas
dim RD$(8),RD(8),A(26)
RD$(1)=" I ":RD$(2)=" II ":RD$(3)=" III ":RD$(4)=" IV "
RD$(5)=" V ":RD$(6)=" VI ":RD$(7)=" VII ":RD$(8)=" VIII"
Letters$="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Initialize
?
'Set the reflector to B or C
? "Reflector = " chr$(int(rnd()*2 + 66))
SetRo RO$
? "Rotor order = " RO$
SetRings Ring$
? "Ring setup = " Ring$
SetPlugBoard PB$
? "Plug board = " PB$
SetRotors RS$
? "Rotor setting = " RS$
SetMsgKey MK$
? "Message Key = " MK$
Sub Initialize
'Get seed and randomise
local i,b,a$
input "seed"; a$
For i=1 to len(a$)
b=b + Asc(mid$(a$,i,1))
next
randomize b
end sub 'Initialize
Sub SetRo(RO$)
' Set the wheel order
local i,j
i=int(rnd()*2+1)
if i=1 then RO$="beta " else RO$="gamm "
for i=1 to 3
'Sets a unique rotor number (3 out of 8)
do
j=int(rnd()*8+1)
loop until rd(j)=0
rd(j)=1
RO$=RO$+rd$(j)
next
end Sub 'WO
Sub SetRings(Ring$)
'Set each of the rings
local i,j
for i= 1 to 4
j=int(rnd()*26+1)
a$=mid$(Letters$,j,1)
Ring$=Ring$+" "+A$+" "
next
End Sub 'SetRings
sub SetPlugBoard(Plugs$)
'Select plugboard pairs
local L$,NumPlugs,LettersAvail,i,j
NumPlugs=int(rnd()*10+1)
L$=Letters$
LettersAvail=26
for i=1 to NumPlugs
GetLetter(a$,L$,LettersAvail)
Plugs$=Plugs$+A$
GetLetter(a$,L$,LettersAvail)
Plugs$=Plugs$+A$+" "
Next
End Sub 'Set PlugBoard
Sub SetRotors(RS$)
'Create rotor initial settings
local i,j
for i= 1 to 4
j=int(rnd()*26+1)
a$=mid$(Letters$,j,1)
RS$=RS$+" "+A$+" "
next
End Sub 'SetRings
Sub SetMsgKey(MK$)
'Set a message key
For i=1 to 4
j=int(rnd()*26+1)
a$=mid$(Letters$,j,1)
MK$=MK$+A$
next
MK$=MK$+" "
For i=1 to 4
j=int(rnd()*26+1)
a$=mid$(Letters$,j,1)
MK$=MK$+A$
next
end Sub 'SetMsgKey
Sub GetLetter(a$,L$,LettersAvail)
'Selects a unique letter from the alphabet
local j
j=int(rnd()*LettersAvail+1)
A$=Mid$(L$,j,1)
if j>1 and j<Len(L$) then
L$=Left$(L$,j-1)+Mid$(L$,j+1)
else
if j=1 then
L$=Mid$(L$,2)
else
L$=Left$(L$,Len(L$)-1)
Endif
endif
LettersAvail=LettersAvail-1
End Sub 'Get letter