'===========================================================================
' Subject: ENIGMA CODER                       Date: 08-13-97 (08:25)       
'  Author: Davey W. Taylor                    Code: QB, QBasic, PDS        
'  Origin: audio.squad@mailbox.swipnet.se   Packet: ALGOR.ABC
'===========================================================================
'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ--ÄÄÄ--Ä -ù  ù
'³                   ** ENIGMA CODER **
'³                Created by Davey W Taylor
'³
'³ The ENIGMA machine was used by the germans during the
'³ war to encrypt important messages so that the brittish
'³ could not read them if they were intercepted. It uses
'³ a very simple design and is simple to use and still
'³ it is very hard to decrypt the messages after they
'³ have been encrypted.. why? The ENIGMA machine uses a
'³ very clever way of encrypting the message. Three
'³ different rotors and reflector which all can be
'³ changed. You would also have to know the start
'³ positions of each rotor in order to decrypt the
'³ message. On top of that there was a plugboard on the
'³ front of the machine allowing the user to manually
'³ switch any of the 26 characters. Anyway, what makes
'³ it real hard to decrypt is that the rotors actually
'³ change position. After every keypress the first
'³ rotor changes position, when that one has passed through
'³ one cycle(A to Z) the second one changes and the same
'³ goes for the third one. This program uses the same way
'³ of encrypting/decrypting messages and as far as I know
'³ it should actually decrypt REAL ENIGMA messages if you
'³ know how the needed rotors were constructed. This would
'³ require some modification to the enigma: section though.
'³ More information about the ENIGMA machine can be found
'³ on the internet!
'³
'³ The above text might be a bit hard to understand since
'³ my english spelling is not very good... sorry! :)
'³ Anyway, I hopy you enjoy the program...
'ÀÄÄÄÄÄ--ÄÄù-  ù   ù
' ** If you have any comments / suggestions / questions, my email is: **
' ** audio.squad@mailbox.swipnet.se                                   **

DECLARE SUB add (rot$, alpha$)
DECLARE SUB waitkey ()
DECLARE SUB XYWrite (x%, y%, char$)

DIM rotora$(1 TO 24)                              'set variables
DIM names$(1 TO 24)
alpha$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ "
plugs$ = alpha$
rotor$ = "AAAA010101"

RESTORE enigma                                    'read rotors
FOR n% = 1 TO 24
 READ rotora$(n%)
NEXT n%

RESTORE greek                                     'read rotor names
FOR n% = 1 TO 24
 READ names$(n%)
NEXT n%

ver$ = "1.9"
SCREEN 12
COLOR 7

menu:                                             'main menu
CLS
PRINT "ENIGMA CODER " + ver$
PRINT
PRINT " L - Load File"
PRINT " S - Save File"
PRINT " P - Edit Plugboard"
PRINT " C - Change Rotors"
PRINT " I - Change Start Positions"
PRINT " F - Change Reflector"
PRINT " E - Encode"
PRINT " Q - Quit"
PRINT
PRINT " Plugbord Edited?         (     )"
PRINT " Current Rotors:          (         :         :         )"
PRINT " Current Start Positions: (    :    :    )"
PRINT " Current Reflector:       (         )"

LOCATE 12, 29
IF plugs$ <> alpha$ THEN COLOR 12: PRINT "Yes": COLOR 7 ELSE PRINT "No"
LOCATE 13, 29
PRINT names$(INSTR(alpha$, MID$(rotor$, 1, 1)))
LOCATE 13, 39
PRINT names$(INSTR(alpha$, MID$(rotor$, 2, 1)))
LOCATE 13, 49
PRINT names$(INSTR(alpha$, MID$(rotor$, 3, 1)))
LOCATE 14, 29
PRINT LTRIM$(STR$(VAL(MID$(rotor$, 5, 2))))
LOCATE 14, 34
PRINT LTRIM$(STR$(VAL(MID$(rotor$, 7, 2))))
LOCATE 14, 39
PRINT LTRIM$(STR$(VAL(MID$(rotor$, 9, 2))))
LOCATE 15, 29
PRINT names$(INSTR(alpha$, MID$(rotor$, 4, 1)))

DO
 SELECT CASE UCASE$(INKEY$)
  CASE "L"
   DO
    CLS
    PRINT "ENIGMA CODER " + ver$ + " LOAD FILE"
    PRINT
    LINE INPUT " Filename: ", file$
    IF file$ = "" THEN GOTO menu
    ok% = 1
    ON ERROR GOTO noload
    OPEN file$ FOR INPUT AS #1                    'open and check filesize,
    IF ok% = 1 THEN                               'letters etc...
     IF LOF(1) > 32000 THEN PRINT " File must not exceed 32 kbytes!": CLOSE #1
     file$ = INPUT$(LOF(1), #1)
     CLOSE #1
    END IF
    out$ = ""
    FOR n% = 1 TO LEN(file$)
     ch$ = UCASE$(MID$(file$, n%, 1))
     IF ch$ = CHR$(13) THEN ch$ = " "
     IF ch$ = CHR$(10) THEN ch$ = ""
     IF INSTR(alpha$ + extra$, ch$) = 0 THEN PRINT " File must only contain characters between A and Z!": waitkey: ERROR 0
     IF ok% = 0 THEN EXIT FOR
     out$ = out$ + ch$
    NEXT n%
    ON ERROR GOTO 0
   LOOP UNTIL ok%
   IF LEN(out$) = 0 THEN PRINT " File is empty!": waitkey: GOTO menu
   memory$ = out$
   GOTO menu
 
  CASE "S"
   DO
    CLS
    PRINT "ENIGMA CODER " + ver$ + " SAVE FILE"
    PRINT
    LINE INPUT " Filename: ", file$
    IF file$ = "" THEN GOTO menu
    ok% = 1
    ON ERROR GOTO nosave
    OPEN file$ FOR OUTPUT AS #1                   'save file
    IF ok% = 1 THEN
     PRINT #1, memory$;
     CLOSE #1
    END IF
    ON ERROR GOTO 0
   LOOP UNTIL ok%
   GOTO menu
 
  CASE "P"
   done% = 0
   DO
    CLS
    PRINT "ENIGMA CODER " + ver$ + " EDIT PLUGBOARD"
    PRINT
    PRINT " Use Letters To Swap. Ex: Pressing GA Would Swap G With A"
    PRINT " While In Swap, Press ESC To Abort"
    PRINT " Press ESC When Done Or Space To Reset"
   
    FOR n% = 1 TO 26                              'display plugboard
     p! = n% / 4.15
     CIRCLE (319 + COS(p!) * 100, 239 + SIN(p!) * 100), 5
     XYWrite 315 + COS(p!) * 120, 235 + SIN(p!) * 120, MID$(alpha$, n%, 1)
    NEXT n%
    FOR n% = 1 TO 26
     p! = n% / 4.15
     sx% = 319 + COS(p!) * 100
     sy% = 239 + SIN(p!) * 100
     p! = INSTR(alpha$, MID$(plugs$, n%, 1)) / 4.15
     ex% = 319 + COS(p!) * 100
     ey% = 239 + SIN(p!) * 100
     LINE (sx%, sy%)-(ex%, ey%), 12
    NEXT n%
   
    DO
     ok% = 1
     in$ = UCASE$(INKEY$)
     SELECT CASE in$
      CASE "A" TO "Z"
       sw$ = in$
       p! = INSTR(alpha$, sw$) / 4.15
       CIRCLE (319 + COS(p!) * 100, 239 + SIN(p!) * 100), 5, 12
       ok% = 0
       DO
        in$ = UCASE$(INKEY$)
        SELECT CASE in$
         CASE "A" TO "Z"
          swt$ = in$
          ok% = 1
         CASE CHR$(27): ok% = 2
        END SELECT
       LOOP UNTIL ok% > 0
      
       IF ok% = 1 THEN
        sp% = INSTR(alpha$, sw$)                  'calculate and swap letters
        ep% = INSTR(alpha$, swt$)
        nol% = 0
        IF MID$(plugs$, sp%, 1) <> MID$(alpha$, sp%, 1) THEN nol% = 1
        IF MID$(plugs$, ep%, 1) <> MID$(alpha$, ep%, 1) THEN nol% = 1
        IF MID$(plugs$, sp%, 1) = MID$(alpha$, ep%, 1) THEN nol% = 0
        IF nol% = 0 THEN
         s$ = MID$(plugs$, sp%, 1)
         MID$(plugs$, sp%, 1) = MID$(plugs$, ep%, 1)
         MID$(plugs$, ep%, 1) = s$
        ELSE
         BEEP                                     'beep if error
        END IF
       ELSE
        ok% = 1
       END IF
      CASE " ": plugs$ = alpha$
      CASE CHR$(27): done% = 1
      CASE ELSE: ok% = 0
     END SELECT
    LOOP UNTIL ok%
   LOOP UNTIL done%
   GOTO menu
 
  CASE "C"
   DO
    CLS
    PRINT "ENIGMA CODER " + ver$ + " CHANGE ROTORS"
    PRINT
    PRINT " Availavle Rotors:"
    PRINT "  ";
    FOR n% = 1 TO 24
     IF n% = 12 THEN PRINT CHR$(13); "  ";
     PRINT names$(n%);
     IF n% <> 24 THEN PRINT ", ";
    NEXT n%
    PRINT
    PRINT
    PRINT " Format: rotor: rotor: rotor"
    PRINT " Ex    : alfa: epsilon: pi"
    ok% = 1
    LINE INPUT " Rotors: ", rotr$
   
    IF rotr$ = "" THEN GOTO menu
    IF INSTR(rotr$, ":") = 0 THEN
     ok% = 0
    ELSE
     rot1$ = LTRIM$(RTRIM$(UCASE$(LEFT$(rotr$, INSTR(rotr$, ":") - 1))))
     rotr$ = MID$(rotr$, INSTR(rotr$, ":") + 1)
     IF INSTR(rotr$, ":") = 0 THEN
      ok% = 0
     ELSE
      rot2$ = LTRIM$(RTRIM$(UCASE$(LEFT$(rotr$, INSTR(rotr$, ":") - 1))))
      rotr$ = MID$(rotr$, INSTR(rotr$, ":") + 1)
      rot3$ = LTRIM$(RTRIM$(UCASE$(MID$(rotr$, INSTR(rotr$, ":") + 1))))
     END IF
    END IF
   LOOP UNTIL ok%
  
   o$ = ""                                        'find rotor names
   FOR n% = 1 TO 24
    IF UCASE$(names$(n%)) = rot1$ THEN o$ = o$ + MID$(alpha$, n%, 1): EXIT FOR
   NEXT n%
   IF n% = 25 THEN ok% = 0
   FOR n% = 1 TO 24
    IF UCASE$(names$(n%)) = rot2$ THEN o$ = o$ + MID$(alpha$, n%, 1): EXIT FOR
   NEXT n%
   IF n% = 25 THEN ok% = 0
   FOR n% = 1 TO 24
    IF UCASE$(names$(n%)) = rot3$ THEN o$ = o$ + MID$(alpha$, n%, 1): EXIT FOR
   NEXT n%
   IF n% = 25 THEN ok% = 0
   IF ok% = 0 THEN PRINT " Invalid rotor name!": waitkey: GOTO menu
   MID$(rotor$, 1, 3) = o$                        'change rotors
   GOTO menu
 
  CASE "I"
   DO
    CLS
    PRINT "ENIGMA CODER " + ver$ + " CHANGE START POSITIONS"
    PRINT
    PRINT " Format         : pos: pos: pos (1 to 26)"
    PRINT " Ex             : 1: 7: 5"
    ok% = 1
    LINE INPUT " Start Positions: ", rotr$
    IF rotr$ = "" THEN GOTO menu
    IF INSTR(rotr$, ":") = 0 THEN
     ok% = 0
    ELSE
     rot1% = VAL(LTRIM$(RTRIM$(UCASE$(LEFT$(rotr$, INSTR(rotr$, ":") - 1)))))
     rotr$ = MID$(rotr$, INSTR(rotr$, ":") + 1)
     IF INSTR(rotr$, ":") = 0 THEN
      ok% = 0
     ELSE
      rot2% = VAL(LTRIM$(RTRIM$(UCASE$(LEFT$(rotr$, INSTR(rotr$, ":") - 1)))))
      rotr$ = MID$(rotr$, INSTR(rotr$, ":") + 1)
      rot3% = VAL(LTRIM$(RTRIM$(UCASE$(MID$(rotr$, INSTR(rotr$, ":") + 1)))))
     END IF
    END IF
   LOOP UNTIL ok%
  
   IF rot1% < 1 OR rot1% > 26 THEN ok% = 0        'check positions
   IF rot2% < 1 OR rot2% > 26 THEN ok% = 0
   IF rot3% < 1 OR rot3% > 26 THEN ok% = 0
   IF ok% = 1 THEN
    IF rot1% < 10 THEN rot1$ = "0" ELSE rot1$ = ""
    IF rot2% < 10 THEN rot2$ = "0" ELSE rot2$ = ""
    IF rot3% < 10 THEN rot3$ = "0" ELSE rot3$ = ""
    rot1$ = rot1$ + LTRIM$(STR$(rot1%))
    rot2$ = rot2$ + LTRIM$(STR$(rot2%))
    rot3$ = rot3$ + LTRIM$(STR$(rot3%))
    o$ = rot1$ + rot2$ + rot3$
    MID$(rotor$, 5, 6) = o$                       'change positions
   ELSE
    PRINT " Invalid start positions!"
    waitkey
   END IF
   GOTO menu
 
  CASE "F"
   DO
    CLS
    PRINT "ENIGMA CODER " + ver$ + " CHANGE REFLECTOR"
    PRINT
    PRINT " Availavle Reflectors:"
    PRINT "  ";
    FOR n% = 1 TO 24
     IF n% = 12 THEN PRINT CHR$(13); "  ";
     PRINT names$(n%);
     IF n% <> 24 THEN PRINT ", ";
    NEXT n%
    PRINT
    PRINT
    ok% = 1
    LINE INPUT " Reflector: ", rotr$
    IF rotr$ = "" THEN GOTO menu
    refc$ = LTRIM$(RTRIM$(UCASE$(rotr$)))
    FOR n% = 1 TO 24                              'find reflector name
     IF UCASE$(names$(n%)) = refc$ THEN o$ = MID$(alpha$, n%, 1): EXIT FOR
    NEXT n%
    IF n% = 25 THEN ok% = 0
    IF ok% = 0 THEN PRINT " Invalid reflector name!": waitkey
   LOOP UNTIL ok%
  
   MID$(rotor$, 4, 1) = o$                        'change reflector
   GOTO menu
 
  CASE "E"
   CLS
   PRINT "ENIGMA CODER " + ver$ + " ENCODE"
   PRINT
   rot1% = VAL(MID$(rotor$, 5, 2))                'get the three rotors
   rot1$ = rotora$(INSTR(alpha$, MID$(rotor$, 1, 1))) 'and their positions
   rot2% = VAL(MID$(rotor$, 7, 2))
   rot2$ = rotora$(INSTR(alpha$, MID$(rotor$, 2, 1)))
   rot3% = VAL(MID$(rotor$, 9, 2))
   rot3$ = rotora$(INSTR(alpha$, MID$(rotor$, 3, 1)))
   refc$ = rotora$(INSTR(alpha$, MID$(rotor$, 4, 1)))
  
   FOR n% = 1 TO rot1% - 1                        'rotate all rotors to their
    n$ = LEFT$(rot1$, 1)                          'start positions
    rot1$ = MID$(rot1$, 2) + n$
    add rot1$, alpha$
   NEXT n%
   FOR n% = 1 TO rot2% - 1
    n$ = LEFT$(rot2$, 1)
    rot2$ = MID$(rot2$, 2) + n$
    add rot2$, alpha$
   NEXT n%
   FOR n% = 1 TO rot3% - 1
    n$ = LEFT$(rot3$, 1)
    rot3$ = MID$(rot3$, 2) + n$
    add rot3$, alpha$
   NEXT n%
  
   LOCATE 14, 2: PRINT STRING$(79, "-")
   ty% = 3: tx% = 2
   by% = 15: bx% = 2
  
   FOR n% = 1 TO LEN(memory$)
    VIEW PRINT 3 TO 12
    i$ = MID$(memory$, n%, 1)
    LOCATE ty%, tx%
    PRINT i$;
    ty% = CSRLIN: tx% = POS(0)
    IF tx% = 1 THEN tx% = 2
    VIEW PRINT 15 TO 24
    o$ = i$
   
    IF o$ <> " " THEN
     o$ = MID$(plugs$, INSTR(alpha$, o$), 1)      'this part is the actual
     o$ = MID$(rot1$, INSTR(alpha$, o$), 1)       'encoding. This is the
     o$ = MID$(rot2$, INSTR(alpha$, o$), 1)       'way the electricity would
     o$ = MID$(rot3$, INSTR(alpha$, o$), 1)       'flow through a real enigma
     o$ = MID$(refc$, INSTR(alpha$, o$), 1)       'machine: first through the
     o$ = MID$(rot3$, INSTR(alpha$, o$), 1)       'plugbord then through the
     o$ = MID$(rot2$, INSTR(alpha$, o$), 1)       'rotors, through the
     o$ = MID$(rot1$, INSTR(alpha$, o$), 1)       'reflector and back again!
     o$ = MID$(plugs$, INSTR(alpha$, o$), 1)
     MID$(memory$, n%, 1) = o$
    END IF
   
    FOR z% = 1 TO INSTR(alpha$, o$)
     LOCATE by%, bx%: PRINT MID$(alpha$, z%, 1);
    NEXT z%

    by% = CSRLIN: bx% = POS(0)
    IF bx% = 1 THEN bx% = 2
    IF o$ <> " " THEN
     n$ = LEFT$(rot1$, 1)                         'rotate rotor 1
     rot1$ = MID$(rot1$, 2) + n$
     add rot1$, alpha$
     rot1% = rot1% + 1
     IF rot1% = 27 THEN
      rot1% = 1
      n$ = LEFT$(rot2$, 1)                        'rotate rotor 2
      rot2$ = MID$(rot2$, 2) + n$
      add rot2$, alpha$
      rot2% = rot2% + 1
      IF rot2% = 27 THEN
       rot2% = 1
       n$ = LEFT$(rot3$, 1)                       'rotate rotor 3
       rot3$ = MID$(rot3$, 2) + n$
       add rot3$, alpha$
       rot3% = rot3% + 1
       IF rot3% = 27 THEN rot3% = 1
      END IF
     END IF
    END IF
  
   NEXT n%
   VIEW PRINT
   LOCATE 25, 60
   PRINT "Press Any Key!"
   waitkey
   GOTO menu
 
  CASE "Q"
   WIDTH 80, 25
   PRINT "Thank you for using the ENIGMA CODER!"
   END
 END SELECT
LOOP

noload:                                           'file load error handling
ok% = 0
PRINT " Can't load file!"
waitkey
RESUME NEXT

nosave:                                           'file save error handling
ok% = 0
PRINT " Can't save file!"
waitkey
RESUME NEXT

greek:                                            'the greek alphabet
                                                  '(used as rotor names)
DATA Alpha, Beta, Gamma, Delta, Epsilon, Zeta, Eta, Teta, Jota, Kappa, Lambda
DATA My, Ny, Ksi, Omikron, Pi, Ro, Sigma, Tau, Ypsilon, Fi, Chi, Psi, Omega

enigma:                                           'information on the wiring
                                                  'of each rotor
DATA QXKSGVERLWCINMZYAHDUTFJBPO
DATA IXLOHQUEAMWCJTDSFYPNGZKBRV
DATA IMPGHVDEAUZQBTRCLOYNJFXWSK
DATA JXYRKUNVLAEIZGSWTDOQFHPBCM
DATA KGLHZQBDSTACNMURFPIJOYXWVE
DATA QMVIGLEJDHWFBSZXAUNYRCKPTO
DATA DQMAVTLKYRHGCONSBJPFWEUZIX
DATA GJUVZTARPBMQKSWILHNFCDOYXE
DATA ODTBKMIXGZEWFSAYRQNCVULHPJ
DATA IMRTKJNLAFEHBGSUWCODPZQYXV
DATA IRMNXYWVAZQOCDLSKBPUTHGEFJ
DATA DQOAVXSYULMJKTCZBWGNIERFHP
DATA MXNJQZVWYDRUACPOEKTSLGHBIF
DATA PDIBKRJQCGESZONAHFLXWYUTVM
DATA QHXLYTUBOMVDJZISAWPFGKRCEN
DATA CXATHNUEQWZYPFVMISRDGOJBLK
DATA EPNYAXITGRUSQCZBMJLHKWVFDO
DATA MYWSJVNIHELKAGZTXUDPRFCQBO
DATA XCBRYLITGMNFJKWQPDZHVUOAES
DATA FLSQOAZXKYIBPUEMDVCWNRTHJG
DATA OLRGJYDSNEVBWIATXCHPZKMQFU
DATA LSOEDKPYRQFAWZCGJIBXVUMTHN
DATA COALZWJMPGTDHUBIVSRKNQFYXE
DATA PZYUWTRVOSMXKQIANGJFDHELCB

SUB add (rot$, alpha$)
 FOR n% = 1 TO LEN(rot$)
  i% = INSTR(alpha$, MID$(rot$, n%, 1)) - 1
  IF i% = 0 THEN i% = 26
  MID$(rot$, n%, 1) = MID$(alpha$, i%, 1)
 NEXT n%
END SUB

SUB waitkey
 DO: LOOP WHILE INKEY$ = ""
END SUB

SUB XYWrite (x%, y%, char$)
 DEF SEG = &HF000
 FOR py% = 0 TO 7
  r% = PEEK(&HFA63 + 11 + (ASC(char$) * 8) + py%)
  FOR px% = 0 TO 7
   IF r% AND (2 ^ px%) THEN PSET ((7 - px%) + x%, py% + y%)
  NEXT px%
 NEXT py%
 DEF SEG
END SUB