module Hardware.KansasLava.Simulators.Spartan3e
( Spartan3e(..)
, Graphic(..)
) where
import qualified Hardware.KansasLava.Boards.Spartan3e as Board
import Hardware.KansasLava.Boards.Spartan3e
import qualified Data.ByteString as B
import Data.Sized.Ix
import Data.Sized.Unsigned
import Data.Sized.Matrix as M
import Language.KansasLava
import qualified Language.KansasLava as KL
import System.IO
import Control.Monad
import Data.List as List
import Data.Char as Char
import Control.Concurrent
import System.IO.Unsafe
import Data.Maybe
import Hardware.KansasLava.Rate
import Hardware.KansasLava.Simulators.Polyester
instance Board.Spartan3e Polyester where
board_init = do
generic_init BOARD CLOCK
sw <- switches
sequence_
[ outPolyester (TOGGLE i) (map fromJust (fromS (sw ! i)))
| i <- [0..3]
]
sw <- buttons
sequence_
[ outPolyester (BUTTON i) (map fromJust (fromS (sw ! i)))
| i <- [0..3]
]
ss <- ll_dial
outPolyester DIAL ss
rot_as_reset = return ()
tickTock wit hz = do
simSpeed <- getPolyesterSimSpeed
return (rate wit (1 / ((fromIntegral simSpeed) / fromIntegral hz)))
mm_lcdP = patchF fromAckBox |$| buildF (\ ~(inp_lhs,_) -> do
outPolyesterEvents $ map (just $ \ ((x,y),ch) -> Just (LCD (x,y) (Char.chr (fromIntegral ch)))) inp_lhs
return ((),()))
where
just :: (a -> Maybe b) -> Maybe a -> Maybe b
just _ Nothing = Nothing
just k (Just a) = k a
rs232_txP port baud = patchF (shallowSlowDownAckBoxP slow_count $$ fromAckBox) |$| buildF fab
where
slow_count = 10 * Board.clockRate `div` baud
fab ~(inp,_) = do
writeSocketPolyester ("dev/" ++ serialName port)
$ map (fmap (\ i -> [chr (fromIntegral i)])) inp
outPolyesterCount (RS232 TX port) inp
return ((),())
rs232_rxP port baud = buildF (\ ~(_,_) -> do
clkSpeed <- getPolyesterClkSpeed
let slow_count = 10 * clkSpeed `div` baud
ss0 <- readSocketPolyester ("dev/" ++ serialName port)
let ss = concatMap (\ x -> x : replicate (fromIntegral slow_count) Nothing) ss0
outPolyesterCount (RS232 RX port) ss
return ((), toS (map (fmap fromIntegral) ss)))
switches = do
ms <- sequence [ do ss <- inPolyester False (sw i)
return ss
| i <- [0..3]
]
return (matrix (map toS ms))
where
sw i ch old | key ! i == ch = not old
| otherwise = old
key :: Matrix X4 Char
key = matrix "lkjh"
buttons = do
ms <- sequence [ do ss <- inPolyester False (sw i)
return ss
| i <- [0..3]
]
return (matrix (map toS ms))
where
sw i ch old | key ! i == ch = not old
| otherwise = old
key :: Matrix X4 Char
key = matrix "aegx"
leds m = do
sequence_ [ outPolyester (LED (fromIntegral i)) (fromS (m ! i))
| i <- [0..7]
]
dial_button = do
st <- ll_dial
return $ toS $ map (\ (Dial b _) -> b) $ st
dial_rot = do
st <- ll_dial
return $ toS $ rot $ map (\ (Dial _ p) -> p) $ st
where
rot xs = map f $ List.zipWith () (0:xs) xs
f 0 = Nothing
f 1 = Just False
f 2 = error "turned dial twice in one cycle?"
f 3 = Just True
serialName :: Serial -> String
serialName DCE = "dce"
serialName DTE = "dte"
data Dial = Dial Bool U2
deriving Eq
ll_dial :: Polyester [Dial]
ll_dial = do
ss <- inPolyester (Dial False 0) switch
return ss
where
switch 'd' (Dial b p) = Dial (not b) p
switch 's' (Dial b p) = Dial b (pred p)
switch 'f' (Dial b p) = Dial b (succ p)
switch _ other = other
shallowSlowDownAckBoxP ::
Integer -> Patch (Seq (Enabled U8)) (Seq (Enabled U8))
(Seq Ack) (Seq Ack)
shallowSlowDownAckBoxP slow ~(inp,ack) = (toAck (toS ack_out),packEnabled (toS good) (enabledVal inp))
where
ack_in :: [Bool]
ack_in = [ x | Just x <- fromS (fromAck ack) ]
inp_in :: [Bool]
inp_in = [ x | Just x <- fromS (isEnabled inp) ]
good :: [Bool]
good = f 0 inp_in
f 0 (False:is) = False : f 0 is
f 0 (True:is) = True : f slow is
f other (_:is) = False : f (pred other) is
ack_out :: [Bool]
ack_out = ack_in
clockRate :: Integer
clockRate = Board.clockRate
boardASCII = unlines
[ " _||_____|VGA|_____|X|__|232 DCE|__|232 DTE|__"
, " |o|| |_"
, " | | |"
, " | +----+ | |"
, " ----+ DIGILENT |FPGA| | |"
, " RJ45| ## | | SPARTAN-3E | |"
, " ----+ ## +----+ \\ / | |"
, " _|_ \\ / () | |"
, " USB| +--+ \\ / |_|"
, " ---' |##| +----+ FPGA |_"
, " |+--+ +--+ |####| oooooooo | |"
, " ||##| +----------------+ 76543210 |_|"
, " |+--+ (e) | | |_"
, " | (a) (|) (g) | | : : : : | |"
, " | (x) +----------------+ * * * * |_|"
, " +---------------------------------------------+"
, ""
, " Keyboard Commands:"
, " a, e, g, x - press buttons"
, " d - press dial"
, " s, f - turn dial counter-clock/clockwise"
, " h,j,k,l - toggle switches"
, " q - quit"
]
data Output
= LED X8 (Maybe Bool)
| TOGGLE X4 Bool
| CLOCK Integer
| LCD (X2,X16) Char
| BOARD
| BUTTON X4 Bool
| DIAL Dial
| QUIT Bool
| RS232 DIR Serial Integer
data DIR = RX | TX
at = AT
instance Graphic Output where
drawGraphic (LED x st) =
opt_green $ PRINT [ledASCII st] `at` (11,46 fromIntegral x)
where
opt_green = if st == Just True then COLOR Green else id
ledASCII :: Maybe Bool -> Char
ledASCII Nothing = '?'
ledASCII (Just True) = '@'
ledASCII (Just False) = '.'
drawGraphic (TOGGLE x b) = do
PRINT [up] `at` (14,46 2 * fromIntegral x)
PRINT [down] `at` (15,46 2 * fromIntegral x)
where
ch = "lkjh" !! fromIntegral x
up = if b then ch else ':'
down = if b then ':' else ch
drawGraphic (CLOCK n) =
PRINT ("clk: " ++ show n) `at` (5,35)
drawGraphic (LCD (row,col) ch) =
PRINT [ch] `at` (13 + fromIntegral row,20 + fromIntegral col)
drawGraphic BOARD = do
PRINT boardASCII `at` (1,1)
COLOR Red $ PRINT ['o'] `at` (2,4)
drawGraphic (BUTTON x b) =
(if b then REVERSE else id) $
PRINT [snd (buttons !! fromIntegral x)] `at`
(fst (buttons !! fromIntegral x))
where
buttons =
[ ((14,7),'a')
, ((13,11),'e')
, ((14,15),'g')
, ((15,11),'x')
]
drawGraphic (DIAL (Dial b p)) =
(if b then REVERSE else id) $
PRINT ["|/-\\" !! fromIntegral p] `at` (14,11)
drawGraphic (QUIT b)
| b = do PRINT "" `at` (25,1)
error "Simulation Quit"
| otherwise = return ()
drawGraphic (RS232 dir port val)
| val > 0 = PRINT (prefix ++ show val) `at` (col,row)
| otherwise = PRINT (prefix ++ "-") `at` (col,row)
where
row = case port of
DCE -> 27
DTE -> 38
prefix = case dir of
RX -> "rx "
TX -> "tx "
col = case dir of
RX -> 3
TX -> 2