{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -option #-}
module Blinker where

import Clash.Prelude
import Clash.Annotations.SynthesisAttributes
import Clash.Cores.UART
import Data.Char (ord)
import Control.Monad.Trans.State.Strict

-- 50 MHz
createDomain vSystem{vName="Input", vPeriod=20_000}

{-# ANN topEntity
  (Synthesize
    { t_name   = "Blinker"
    , t_inputs = [
      PortName "CLK0",
      PortName "UART_RX"
       ]
    , t_output = PortName "UART_TX"
    }) #-}
topEntity ::
  "CLK" ::: Clock Input
    `Annotate` 'StringAttr "chip_pin" "R20"
    `Annotate` 'StringAttr
                "altera_attribute" "-name IO_STANDARD \"3.3-V LVTTL\""
  -> "RX" ::: Signal Input Bit
    `Annotate` 'StringAttr
                "chip_pin" "M9"
    `Annotate` 'StringAttr
                "altera_attribute" "-name IO_STANDARD \"2.5V\""
  -> "KEY0" ::: Signal Input Bit
    `Annotate` 'StringAttr
                "chip_pin" "P11"
    `Annotate` 'StringAttr
                "altera_attribute" "-name IO_STANDARD \"1.2V\""
  -> Signal Input Bit
    `Annotate` 'StringAttr
                "chip_pin" "L9"
    `Annotate` 'StringAttr
                "altera_attribute" "-name IO_STANDARD \"2.5V\""
topEntity clk rx key0 = txBit
  where
    baud = SNat @115200
    uart' = exposeClockResetEnable (uart baud) clk resetGen enableGen
    (rxWord, txBit, ack) = uart' rx txM
    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 {
  key0 :: Bit,
  ack :: Bool,
  rx :: Maybe (BitVector 8)
}

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


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