1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
{-# 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
|
