# Haskell Quiz/The Solitaire Cipher/Solution JFoutz

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)

import Data.Char import Data.List import System

-- discard any non a to z characers, uppercase the rest -- split into groups of 5, padded with 'X'

prep ls = loop \$ map toUpper \$ filter (\x -> and [isAscii x, isLetter x]) ls

```   where loop [] = []
loop ls
| length ls < 5 = [take 5 (ls ++ "XXXX")]
| otherwise = (take 5 ls) : loop (drop 5 ls)
```

drawMsg msg = concat \$ intersperse " " (loop msg)

```   where loop msg
| length msg > 5 = (take 5 msg) : loop (drop 5 msg)
| otherwise = [msg]
```

churn f msg = drawMsg \$ toChr \$ zipWith f (toNum \$ concat \$ prep msg) (keyStream [1..54]) crypt msg = churn solAdd msg decrypt msg = churn solSub msg

main = do { x <- getArgs

```         ; case (head x) of
"c" -> putStrLn \$ crypt \$ concat \$ tail x
"d" -> putStrLn \$ decrypt \$ concat \$ tail x
_ -> putStrLn "Try solitare c my message, or d my message"}
```

-- letters to numbers and back toNum = map (\x -> ord x - 65) toChr = map (\x -> chr (x + 65))

-- add and subtract base solitare style solAdd x y = mod (x + y) 26 solSub x y = mod (x + 26 - y) 26

--keyStream down1 x ls = move \$ break (==x) ls

```   where move (x:xs, t:[]) = x:t:xs
move (xs, c:n:cx) = xs ++ n : c : cx
```

down2 x ls = down1 x \$ down1 x ls

notEither a b = (\x y -> x /= a && y /= a && x /= b && y /= b) tripleCut a b ls = swap a b \$ concat \$ reverse \$ groupBy (notEither a b) ls

swap a b [] = [] swap a b (x:xs)

```    | a == x = b : swap a b xs
| b == x = a : swap a b xs
| otherwise = x : swap a b xs

```

cardVal c = if c == 54 then 53 else c countCut ls = glue \$ splitAt (cardVal \$ last ls) (init ls)

```   where glue (f,b) = b ++ f ++ [last ls]
```

jokerA = 53 jokerB = 54

keyStep deck = countCut \$ tripleCut jokerA jokerB \$ down2 jokerB \$ down1 jokerA deck

getCard deck = deck !! (cardVal \$ head deck)

keyStream deck = let d2 = keyStep deck

```                    out = getCard d2
in if out == jokerA || out == jokerB
then keyStream d2
else out : keyStream d2
```