added tap code

app/Main.hs

@@ -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()

based.cabal

@@ -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
 

src/Encoding/:w

@@ -0,0 +1,76 @@
+-- This module's code leans heavily on Andy Stewarts' Morse Code implementation in Text.Morse
+module Encoding.Tap
+  ( enctap
+  , dectap
+  ) where
+
+import Data.Char (toLower, isSpace)
+import Data.Map (Map)
+import Data.List.Split (split, dropDelims, dropFinalBlank, oneOf)
+import Data.ByteString (ByteString)
+import qualified Data.Map as M
+import qualified Data.ByteString.Char8 as BC
+
+-- | Morse Code convert map.
+tapCode :: Map Char String
+tapCode =
+  M.fromList
+  [('a', ". .")
+  ,('b', ". ..")
+  ,('c', ". ...")
+  ,('d', ". ....")
+  ,('e', ". .....")
+  ,('f', ".. .")
+  ,('g', ".. ..")
+  ,('h', ".. ...")
+  ,('i', ".. ....")
+  ,('j', ".. .....")
+  ,('k', ". ...")
+  ,('l', "... .")
+  ,('m', "... ..")
+  ,('n', "... ...")
+  ,('o', "... ....")
+  ,('p', "... .....")
+  ,('q', ".... .")
+  ,('r', ".... ..")
+  ,('s', ".... ...")
+  ,('t', ".... ....")
+  ,('u', ".... .....")
+  ,('v', "..... .")
+  ,('w', "..... ..")
+  ,('x', "..... ...")
+  ,('y', "..... ....")
+  ,('z', "..... .....")]
+
+enctap :: ByteString -> ByteString
+enctap = BC.pack . concatMap encodeChar . BC.unpack
+  where
+    encodeChar c
+      | isAlpha c = case M.lookup (toLower c) tapCode of
+                      Just code  -> code
+                      Nothing -> [c]
+      | isSpace c = "/"
+      | otherwise = [c]
+    -- encodeChar x = 
+      -- case findMinMatch tapCode (\k _ -> k == toLower x) of
+      --   Just (_, tap) -> tap
+      --   Nothing -> if isSpace x then "/" else ""
+
+dectap :: ByteString -> ByteString
+dectap input = BC.pack $ concatMap decodeSegment $ split (oneOf "/" ) $ BC.unpack input
+  where 
+    decodeSegment x
+      | x == "/" = " "
+      | otherwise =  concatMap decodeTap (split (dropDelims $ dropFinalBlank $ oneOf " ") x)
+
+    decodeTap lv =
+      case findMinMatch tapCode(\ _ v -> v == lv) of
+        Just (c, _) -> [c]
+        Nothing -> []
+
+findMinMatch :: Ord k => Map k a -> (k -> a -> Bool) -> Maybe (k, a)
+findMinMatch map fun = match
+  where filterMap = M.filterWithKey fun map
+        match = if M.null filterMap
+                   then Nothing
+                   else Just $ M.findMin filterMap

src/Encoding/Tap.hs

@@ -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
+