Compare commits
2 Commits
b60acf2008
...
6213a4a221
Author | SHA1 | Date |
---|---|---|
Stefan Friese | 6213a4a221 | |
Stefan Friese | f06925d9b8 |
|
@ -24,6 +24,7 @@ import Encoding.Yenc (ency, decy)
|
|||
import Encoding.LetterToNumber (encltn, decltn)
|
||||
import Encoding.Rotate (rotate)
|
||||
import Encoding.Morse (encmorse, decmorse)
|
||||
import Encoding.Tap (enctap, dectap)
|
||||
import Encoding.Solve (solveEnc)
|
||||
|
||||
|
||||
|
@ -48,6 +49,7 @@ data Based = Decode {
|
|||
a1z26 :: Bool,
|
||||
rot :: Maybe Int,
|
||||
morse :: Bool,
|
||||
tap :: Bool,
|
||||
solve :: Bool
|
||||
}
|
||||
| Encode {
|
||||
|
@ -70,6 +72,7 @@ data Based = Decode {
|
|||
yenc :: Bool,
|
||||
a1z26 :: Bool,
|
||||
morse :: Bool,
|
||||
tap :: Bool,
|
||||
rot :: Maybe Int
|
||||
}
|
||||
deriving(Show, Data, Typeable)
|
||||
|
@ -116,6 +119,8 @@ optionHandler Decode{rot=Just n} = rotate n
|
|||
optionHandler Encode{rot=Just n} = rotate n
|
||||
optionHandler Decode{morse=True} = decmorse
|
||||
optionHandler Encode{morse=True} = encmorse
|
||||
optionHandler Decode{tap=True} = dectap
|
||||
optionHandler Encode{tap=True} = enctap
|
||||
optionHandler Decode{solve=True} = solveEnc
|
||||
|
||||
decodeMode :: Based
|
||||
|
@ -140,6 +145,7 @@ decodeMode = Decode {
|
|||
a1z26 = def &= help "decode letter to number",
|
||||
rot = def &= help "rotate characters by n positions",
|
||||
morse = def &= help "decode morse",
|
||||
tap = def &= help "decode tap code using a Polybius square (5x5 grid Latin alphabet)",
|
||||
solve = def &= help "solve encoding"
|
||||
} &= help "Decode chosen base" &=auto
|
||||
|
||||
|
@ -164,7 +170,8 @@ encodeMode = Encode {
|
|||
yenc = def &= help "encode yEncode",
|
||||
a1z26 = def &= help "encode letter to number",
|
||||
rot = def &= help "rotate characters by n positions",
|
||||
morse = def &= help "encode morse"
|
||||
morse = def &= help "encode morse",
|
||||
tap = def &= help "encode tap code using a Polybius square (5x5 grid Latin alphabet)"
|
||||
} &= help "Encode chosen base"
|
||||
|
||||
main :: IO()
|
||||
|
|
|
@ -27,6 +27,7 @@ library
|
|||
Encoding.Rotate
|
||||
Encoding.LetterToNumber
|
||||
Encoding.Morse
|
||||
Encoding.Tap
|
||||
Encoding.Solve
|
||||
other-modules:
|
||||
-- Data.Bytes.Text.Ascii
|
||||
|
@ -47,6 +48,8 @@ library
|
|||
primitive,
|
||||
regex-tdfa,
|
||||
base64-bytestring,
|
||||
containers,
|
||||
split,
|
||||
MorseCode
|
||||
default-language: Haskell2010
|
||||
|
||||
|
|
|
@ -0,0 +1,47 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Encoding.Tap
|
||||
( enctap
|
||||
, dectap
|
||||
) where
|
||||
|
||||
import Data.Char (isAsciiUpper, isAsciiLower, toLower, chr, ord, toUpper)
|
||||
import Data.List (find)
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
|
||||
enctap :: ByteString -> ByteString
|
||||
enctap = BC.concatMap encodeChar
|
||||
where
|
||||
encodeChar ' ' = BC.singleton ' '
|
||||
encodeChar 'K' = BC.pack "22" -- Special case: 'K' is encoded as "22"
|
||||
encodeChar c
|
||||
| isAsciiUpper c || isAsciiLower c =
|
||||
let (row, col) = positionInGrid c
|
||||
in BC.pack [chr (ord '0' + row), chr (ord '0' + col)]
|
||||
| otherwise = BC.empty -- Handle non-alphabet characters or errors
|
||||
|
||||
positionInGrid c =
|
||||
let idx = ord (toUpper c) - ord 'A'
|
||||
row = idx `div` 5 + 1
|
||||
col = idx `mod` 5 + 1
|
||||
in (row, col)
|
||||
|
||||
dectap :: ByteString -> ByteString
|
||||
dectap = BC.concat . map decodePair . chunkPairs . BC.filter (/= ' ')
|
||||
where
|
||||
chunkPairs :: ByteString -> [ByteString]
|
||||
chunkPairs bs
|
||||
| BC.null bs = []
|
||||
| otherwise = let (pair, rest) = BC.splitAt 2 bs in pair : chunkPairs rest
|
||||
|
||||
decodePair pair
|
||||
| pair == "22" = BC.singleton 'K' -- Special case: "22" is decoded as 'K'
|
||||
| BC.length pair == 2 =
|
||||
let [row, col] = BC.unpack pair
|
||||
rowIdx = ord row - ord '0'
|
||||
colIdx = ord col - ord '0'
|
||||
idx = (rowIdx - 1) * 5 + (colIdx - 1)
|
||||
in BC.singleton $ chr (ord 'A' + idx)
|
||||
| otherwise = error $ "Invalid Tap Code sequence: " ++ show pair
|
||||
|
Loading…
Reference in New Issue