pretty alrright keyer morse

1 files changed, 69 insertions, 8 deletions

diff --git a/src/Blinker.hs b/src/Blinker.hs
index 9dc9778..3e53382 100644
--- a/src/Blinker.hs
+++ b/src/Blinker.hs
@@ -49,7 +49,8 @@ topEntity clk rx key0 = txBit
     baud = SNat @115200
     uart' = exposeClockResetEnable (uart baud) clk resetGen enableGen
     (rxWord, txBit, ack) = uart' rx txM
-    txM = (exposeClockResetEnable mealyS clk resetGen enableGen) cpu Listening (CPUIn <$> key0 <*> ack <*> rxWord)
+    txM = (exposeClockResetEnable mealyS clk resetGen enableGen) cpu initS (CPUIn <$> (boolToBit <$> not <$> bitToBool <$> key0) <*> ack <*> rxWord)
+    initS = Depressed 0 (E :> E :> E :> E :> Nil,0 )
 
 
 data CPUIn = CPUIn {
@@ -58,14 +59,74 @@ data CPUIn = CPUIn {
   rx :: Maybe (BitVector 8)
 }
 
-data CPUState = Transmitting (BitVector 8) | Listening deriving (Generic, NFDataX)
+data Morse = Dit | Dah | E deriving (Generic,NFDataX,Show)
+type MorseBuffer = (Vec 4 Morse, Index 4)
+data CPUState = Transmitting (BitVector 8) 
+                | Pressed (Unsigned 32) MorseBuffer
+                | Depressed (Unsigned 26) MorseBuffer
+                deriving (Generic,NFDataX,Show)
 cpu :: CPUIn -> State CPUState (Maybe (BitVector 8))
-cpu CPUIn{rx=Just rx} = do
-  put $ Transmitting $ rx
-  return Nothing
 
-cpu CPUIn{ack=True} = put Listening >> return Nothing
 
-cpu CPUIn{ack=False,rx=Nothing} = get >>= \case 
+morseToChar :: Vec 4 Morse -> Char
+morseToChar (Dit :> Dah :> E :> E :> Nil) = 'A'
+morseToChar (Dah :> Dit :> Dit :> Dit :> Nil) = 'B'
+morseToChar (Dah :> Dit :> Dah :> Dit :> Nil) = 'C'
+morseToChar (Dah :> Dit :> Dit :> E :> Nil) = 'D'
+morseToChar (Dit :> E :> E :> E :> Nil) = 'E'
+morseToChar (Dit :> Dit :> Dah :> Dit :> Nil) = 'F'
+morseToChar (Dah :> Dah :> Dit :> E :> Nil) = 'G'
+morseToChar (Dit :> Dit :> Dit :> Dit :> Nil) = 'H'
+morseToChar (Dit :> Dit :> E :> E :> Nil) = 'I'
+morseToChar (Dit :> Dah :> Dah :> Dah :> Nil) = 'J'
+morseToChar (Dah :> Dit :> Dah :> E :> Nil) = 'K'
+morseToChar (Dit :> Dah :> Dit :> Dit :> Nil) = 'L'
+morseToChar (Dah :> Dah :> E :> E :> Nil) = 'M'
+morseToChar (Dah :> Dit :> E :> E :> Nil) = 'N'
+morseToChar (Dah :> Dah :> Dah :> E :> Nil) = 'O'
+morseToChar (Dah :> Dah :> Dah :> Dit :> Nil) = 'P'
+morseToChar (Dah :> Dah :> Dit :> Dah :> Nil) = 'Q'
+morseToChar (Dah :> Dah :> Dit :> E :> Nil) = 'R'
+morseToChar (Dit :> Dit :> Dit :> E :> Nil) = 'S'
+morseToChar (Dah :> E :> E :> E :> Nil) = 'T'
+morseToChar (Dit :> Dit :> Dah :> E :> Nil) = 'U'
+morseToChar (Dah :> Dit :> Dit :> Dah :> Nil) = 'V'
+morseToChar (Dit :> Dah :> Dah :> E :> Nil) = 'W'
+morseToChar (Dah :> Dit :> Dit :> Dah :> Nil) = 'X'
+morseToChar (Dah :> Dit :> Dah :> Dah :> Nil) = 'Y'
+morseToChar (Dah :> Dah :> Dit :> Dit :> Nil) = 'Z'
+
+succIdx :: (Eq a, Enum a, Bounded a) => a -> a
+succIdx x 
+  | x == maxBound = maxBound
+  | otherwise = succ x
+
+dahThreshold = 33554432
+-- finished transmitting, go back to listening
+cpu CPUIn{ack=True} = put (Depressed 0 (E :> E :> E :> E :> Nil, 0)) >> return Nothing
+cpu CPUIn{ack=False,key0=p} = get >>= \case 
+  -- keep transmit until we get an ack
   Transmitting s -> return $ Just s
-  Listening -> return Nothing
\ No newline at end of file
+  Pressed n m@(b,i) -> case p of
+    -- still being pressed
+    1 -> put (Pressed (succIdx n) m) >> return Nothing
+    -- decide if this is a dit or a dah
+    0 -> if n > dahThreshold then put (Depressed 0 (replace i Dah b, succIdx i)) >> return Nothing
+                             else put (Depressed 0 (replace i Dit b, succIdx i)) >> return Nothing
+  Depressed n m@(b,i) -> do
+    if n == maxBound then
+      if i > 0 then
+        put (Transmitting $ pack $ (fromIntegral $ ord $ morseToChar b :: Unsigned 8))
+      else
+        put (Depressed 0 (E :> E :> E :> E :> Nil, 0))
+    else
+      case p of
+        1 -> put (Pressed 0 m)
+        0 -> put (Depressed (succ n) m)
+    return Nothing
+  -- Depressed n m@(E :> _,0) -> if n == maxBound then put (Depressed 0 (E :> E :> E :> E :> Nil, 0)) >> return Nothing else return Nothing
+  -- Depressed n m@(b,i) -> if n == maxBound then 
+  --                         put (Transmitting $ pack $ (fromIntegral $ ord $ morseToChar b :: Unsigned 8)) >> return Nothing
+  --                        else case p of
+  --                         1 -> put (Pressed 0 m) >> return Nothing
+  --                         0 -> put (Depressed (succ n) m) >> return Nothing
\ No newline at end of file