{-# LANGUAGE ScopedTypeVariables, TypeFamilies, NoMonomorphismRestriction, DeriveDataTypeable, RankNTypes, ImpredicativeTypes #-}
module Main where
import qualified Language.KansasLava as KL
import Language.KansasLava hiding (Fabric)
import Hardware.KansasLava.RS232
import Hardware.KansasLava.FIFO
import Hardware.KansasLava.LCD.ST7066U
import Hardware.KansasLava.Text
import Hardware.KansasLava.Rate
--import qualified Hardware.KansasLava.VGA as VGA
--import Hardware.KansasLava.VGA (Attr(..), fg, bg)
import Control.Applicative
import Data.Bits
import Data.Sized.Ix
import Data.Sized.Unsigned
import Data.Sized.Arith
import Data.Sized.Matrix as M
import qualified Data.Default as Default
import System.CPUTime
import Data.Char as C
import Control.Concurrent
import System.Console.CmdArgs as CmdArgs
import qualified Hardware.KansasLava.Boards.Spartan3e as Board
import qualified Hardware.KansasLava.Simulators.Polyester as Sim
import Hardware.KansasLava.Boards.Spartan3e
import Hardware.KansasLava.Simulators.Spartan3e
data Opts = Opts { demoFabric :: String, fastSim :: Bool, beat :: Integer, vhdl :: Bool }
deriving (Show, Data, Typeable)
options = Opts { demoFabric = "lcd_inputs" &= help "demo fabric to be executed or built"
, fastSim = False &= help "if running board at full speed"
, beat = (50 * 1000 * 1000) &= help "approx number of clicks a second"
, vhdl = False &= help "generate VDHL"
}
&= summary "spartan3e-demo: run different examples for Spartan3e"
&= program "spartan3e-demo"
main = do
opts <- cmdArgs options
let fab :: (Spartan3e fabric) => fabric ()
fab = do
board_init
fabric opts (demoFabric opts)
case vhdl opts of
True -> vhdlUseFabric opts fab
False -> simUseFabric opts fab
-- The simulator's use of the Fabric
simUseFabric :: Opts -> Sim.Polyester () -> IO ()
simUseFabric opts fab =
Sim.runPolyester (case fastSim opts of
True -> Sim.Fast
False -> Sim.Friendly)
(2 * 1000 * 1000)
(case fastSim opts of
True -> 1000
False -> 50)
$ fab
-- The VHDL generators use of the Fabric
vhdlUseFabric :: Opts -> KL.Fabric () -> IO ()
vhdlUseFabric opts fab = do
kleg <- reifyFabric fab
Board.writeUCF "main.ucf" kleg
KL.writeVhdlCircuit "main" "main.vhd" kleg
return ()
-- Should be in sized types lib!
matrixOf :: (Size x) => x -> [a] -> Matrix x a
matrixOf _ = matrix
------------------------------------------------------------------------------
-- Sample fabrics
fabric :: (Spartan3e fabric) => Opts -> String -> fabric ()
fabric _ "leds" = do
sw <- switches
bu <- buttons
leds (sw `M.append` bu)
{-
fabric _ "dial" = do
d <- dial_button
r <- dial_rot
let val :: Seq U4
val = register 0 $ val + cASE
[ (isEnabled r .&&. enabledVal r, 1)
, (isEnabled r .&&. bitNot (enabledVal r), -1)
] 0
let ms :: Matrix X4 (Seq Bool)
ms = unpack ((bitwise) val :: Seq (Matrix X4 Bool))
leds (matrix $ [d, low] ++ M.toList ms ++ [low,low])
-}
fabric _ "lcd" = do
ticks <- tickTock (Witness :: Witness X24) 4
runF $ patchF (neverAckP $$ prependP msg $$ throttleP ticks) |$| mm_lcdP
where
msg :: Matrix X32 ((X2,X16),U8)
msg = boxU8 ["Example of Using", " the LCD driver "]
fabric _ "lcd_inputs" = do
sw <- switches
bu <- buttons
runF $ patchF (patch sw bu) |$| mm_lcdP
where
patch sw bu = emptyP
$$ forwardP (\ () -> pure ())
$$ backwardP (const ())
$$ matrixStackP (forAll $ \ (i::X4) ->
(outputP (changeS (sw M.! i)))
$$ enabledToAckBox
$$ mapP (\ s -> pack (pureS (fromIntegral i + 0), mux s (33,34)))
)
$$ matrixMergeP RoundRobinMerge
$$ mm_text_driver msg active
msg :: Matrix (X2,X16) U8
msg = boxU8' [" "," "]
active :: X4 -> (X2,X16)
active x = (0,fromIntegral x)
fabric _ "rs232out" = do
runF $ patchF (cycleP msg) |$| rs232_txP DCE 115200
where
msg :: Matrix X95 U8
msg = matrix [ i
| i <- [32..126]
]
fabric _ "rs232in" = do
ticks <- tickTock (Witness :: Witness X24) 4
rot_as_reset
runF $ rs232_rxP DCE 115200
|$| patchF (
enabledToAckBox
$$ fifo (Witness :: Witness X256) low
$$ matrixDupP
$$ matrixStackP (matrixOf (0 :: X3)
[ hexchain $$ mapP (startAt 0)
, count $$ mapP (startAt 16)
, asciichain $$ mapP (startAt 24)
])
$$ matrixMergeP RoundRobinMerge
$$ mm_text_driver msg active
$$ witnessP (Witness :: Witness (Enabled ((X2,X16),U8))))
|$| mm_lcdP
where
startAt :: (Size w, Rep w, Rep a, a ~ U8) => Signal clk X32 -> Signal clk (w,a) -> Signal clk (X32,a)
startAt pos inp = pack (pos + (unsigned) w,a)
where
(w,a) = unpack inp
hexchain :: Patch (Seq (Enabled U8)) (Seq (Enabled (X16,U8)))
(Seq Ack) (Seq Ack)
hexchain =
(mapP (\ ch -> packMatrix (matrixOf (0 :: X2) [hexVal ((unsigned) (ch `shiftR` 4)),hexVal ((unsigned) ch)]))
$$ matrixToElementsP
$$ scrollBar
$$ witnessP (Witness :: Witness (Enabled (X16,U8)))
)
asciichain :: Patch (Seq (Enabled U8)) (Seq (Enabled (X8,U8)))
(Seq Ack) (Seq Ack)
asciichain =
(mapP (\ ch -> mux (ch .>=. 32 .&&. ch .<=. 126) ((unsigned) $ pureS (ord '.'),ch))
$$ scrollBar
$$ witnessP (Witness :: Witness (Enabled (X8,U8)))
)
count :: Patch (Seq (Enabled U8)) (Seq (Enabled (X6,U8)))
(Seq Ack) (Seq Ack)
count = stateP adder (0 :: U24)
$$ witnessP (Witness :: Witness (Enabled U24))
$$ hexForm
$$ witnessP (Witness :: Witness (Enabled (X6,U8)))
adder :: forall clk . (Signal clk U24,Signal clk U8) -> (Signal clk U24,Signal clk U24)
adder (a,_) = (a + 1,a + 1)
hexVal :: Signal clk U4 -> Signal clk U8
hexVal = funMap (\ x -> if x >= 0 && x <= 9
then return (0x30 + fromIntegral x)
else return (0x41 + fromIntegral x - 10))
witnessP :: (Witness w) -> Patch (Seq w) (Seq w)
(Seq a) (Seq a)
witnessP _ = emptyP
msg :: Matrix (X2,X16) U8
msg = boxU8' [" "," "]
active :: X32 -> (X2,X16)
active x = (fromIntegral (x `div` 16),fromIntegral (x `mod` 16))
-- Remember when a value changes.
changeS :: forall c sig a . (Clock c, sig ~ Signal c, Eq a, Rep a) => sig a -> sig (Enabled a)
changeS sig = mux (start .||. diff) (disabledS,enabledS sig)
where
start :: sig Bool
start = probeS "start" $ register True low
diff :: sig Bool
diff = probeS "diff" $ sig ./=. delay sig
---------------------------------------------------------------------------------
-- later, this will use a sub-Clock.
stateP :: forall clk a b c sig .
(Rep a, Rep b, Rep c, Clock clk, sig ~ Signal clk)
=> (forall sig' clk' . (sig' ~ Signal clk') => (sig' a,sig' b) -> (sig' a,sig' c))
-> a
-> Patch (sig (Enabled b)) (sig (Enabled c))
(sig Ack) (sig Ack)
stateP st a =
loopP $
fstP (prependP (matrixOf (0 :: X1) [a]))
$$ zipP
$$ mapP st'
$$ unzipP
$$ fstP (fifo1)
where
st' :: forall clk' . Signal clk' (a,b) -> Signal clk' (a,c)
st' s = pack (st (unpack s) :: (Signal clk' a, Signal clk' c))