From 906d40a608ffb0d1f5851141fe6ab88f0866833d Mon Sep 17 00:00:00 2001 From: Roy Levien Date: Fri, 20 Nov 2015 17:37:21 -0500 Subject: [PATCH] Force non-capital letters to spaces in display functions --- Crypto/Enigma/Display.hs | 32 +++++++++++++++++++++----------- Crypto/Enigma/Utils.hs | 17 +++++------------ 2 files changed, 26 insertions(+), 23 deletions(-) diff --git a/Crypto/Enigma/Display.hs b/Crypto/Enigma/Display.hs index 4c01479..2ecd0a9 100644 --- a/Crypto/Enigma/Display.hs +++ b/Crypto/Enigma/Display.hs @@ -45,6 +45,7 @@ import Crypto.Enigma -- Helpers =================================================================== + -- Message display ----------------------------------------------------------- -- TBD - Don't remove spaces (at least in showEnigmaOperation and instead put a blank line?) @@ -57,9 +58,9 @@ postproc = unlines . chunksOf 60 . unwords . chunksOf 4 -- TBD Move up (closer to encoding?) -- TBD - Can't use below unless encode handles ch == ' ' --- locate the index of the encoding with enc of ch, in s +-- locate the index of the encoding with m of ch, in s locCar :: Char -> String -> Mapping -> Maybe Int -locCar ch s enc = elemIndex (encode enc ch) s +locCar ch s m = elemIndex (encode m ch) s decorate :: Char -> String decorate ch = ch:"\818\773" @@ -70,6 +71,13 @@ markedMapping (Just loc) e = take loc <> decorate.(!!loc) <> drop (loc + 1) $ e markedMapping Nothing e = e +-- Character restriction ---------------------------------------------------- + +-- If the character isn't in 'letters', treat it as blank (a special case for 'encode' and other functions) +enigmaChar :: Char -> Char +enigmaChar ch = if ch `elem` letters then ch else ' ' + + -- Machine operation display ================================================= @@ -86,7 +94,8 @@ showEnigmaOperation_ df ec str = unlines $ zipWith df (iterate step ec) (' ':(me -- | Display a summary of the Enigma machine configuration as its encoding (see 'Mapping'), -- the letters at the windows (see 'windows'), and the 'Position's of the rotors (see 'positions'). -- --- If a valid 'Message' character is provided, indicate that as input and mark the encoded letter. +-- If a an uppercase letter is provided, indicate that as input and mark the encoded letter. +-- Other characters will be ignored. -- -- For example, #showEnigmaConfigEG# -- @@ -95,11 +104,11 @@ showEnigmaOperation_ df ec str = unlines $ zipWith df (iterate step ec) (' ':(me -- -- shows the process of encoding of the letter __@\'K\'@__ to __@\'G\'@__. showEnigmaConfig :: EnigmaConfig -> Char -> String -showEnigmaConfig ec ch = fmt mch (markedMapping (locCar mch enc enc) enc) +showEnigmaConfig ec ch = fmt ech (markedMapping (locCar ech enc enc) enc) (windows ec) (reverse $ tail.init $ positions ec) where - mch = messageChar ch + ech = enigmaChar ch enc = enigmaMapping ec fmt ch e ws ps = printf "%s %s %s %s" lbl e ws ps' where @@ -114,8 +123,8 @@ showEnigmaConfig ec ch = fmt mch (markedMapping (locCar mch enc enc) enc) -- followed by the encoding for the machine, and preceded by a (trivial, no-op) keyboard \"encoding\" -- for reference. -- --- If a valid 'Message' character is provided, indicate that as input and mark the letter it is encoded to at --- each stage; mark its encoding as output. +-- If a an uppercase letter is provided, indicate that as input and mark the letter it is encoded to at +-- each stage; mark its encoding as output. Other characters will be ignored. -- -- For example, #showEnigmaConfigInternalEG# -- @@ -168,18 +177,18 @@ showEnigmaConfig ec ch = fmt mch (markedMapping (locCar mch enc enc) enc) -- <> showEnigmaConfigInternal :: EnigmaConfig -> Char -> String showEnigmaConfigInternal ec ch = - unlines $ [fmt (if mch == ' ' then "" else mch:" >") (markedMapping (head charLocs) letters) ' ' 0 ""] ++ + unlines $ [fmt (if ech == ' ' then "" else ech:" >") (markedMapping (head charLocs) letters) ' ' 0 ""] ++ (zipWith5 fmt (init <> reverse $ ["P"] ++ (show <$> (tail.init $ stages ec)) ++ ["R"]) (zipWith markedMapping (tail.init $ charLocs) (stageMappingList ec)) (" " ++ (reverse $ windows ec) ++ replicate (length $ positions ec) ' ') ([0] ++ ((tail.init $ positions ec)) ++ replicate (length $ positions ec) 0 ) (components ec ++ (tail $ reverse $ components ec)) ) ++ - [fmt (if mch == ' ' then "" else (encode (enigmaMapping ec) mch):" <") + [fmt (if ech == ' ' then "" else (encode (enigmaMapping ec) ech):" <") (markedMapping (last charLocs) (enigmaMapping ec)) ' ' 0 ""] where - mch = messageChar ch - charLocs = zipWith (locCar mch) + ech = enigmaChar ch + charLocs = zipWith (locCar ech) ([letters] ++ stageMappingList ec ++ [enigmaMapping ec]) ([letters] ++ enigmaMappingList ec ++ [enigmaMapping ec]) fmt l e w p n = printf "%3.3s %s %s %s %s" l e (w:[]) p' n @@ -270,3 +279,4 @@ showEnigmaOperationInternal ec str = showEnigmaOperation_ showEnigmaConfigIntern showEnigmaEncoding :: EnigmaConfig -> Message -> String showEnigmaEncoding ec str = postproc $ enigmaEncoding ec (message str) + diff --git a/Crypto/Enigma/Utils.hs b/Crypto/Enigma/Utils.hs index 5ffde3c..9acad5f 100644 --- a/Crypto/Enigma/Utils.hs +++ b/Crypto/Enigma/Utils.hs @@ -10,8 +10,6 @@ import Data.List (sort) -- Some character utilities -------------------------------------------------- --- REV - Use to enforce type constraints on Mapping and Message (and valid message characters); see issue 12 <<< --- REV - Could make this [MsgChar] letters :: String letters = ['A'..'Z'] @@ -29,16 +27,11 @@ ordering xs = snd <$> sort (zip xs [0..]) -- encode a single character encode :: String -> Char -> Char -encode e ' ' = ' ' -encode e ch = e !! (numA0 ch) +-- encode e ' ' = ' ' +-- encode e ch = e !! (numA0 ch) +encode m ch = if i `elem` [0..(length m)-1] then (m !! i) else ' ' where i = numA0 ch + -- standard simple-substitution cypher encoding encode' :: String -> String -> String -encode' e s = (encode e) <$> s - - --- Character restriction ---------------------------------------------------- - --- If the character isn't in 'letters', treat it as blank (a special case for 'encode' and other functions) -messageChar :: Char -> Char -messageChar ch = if ch `elem` letters then ch else ' ' \ No newline at end of file +encode' m s = (encode m) <$> s