-- | This API mirrors 'Hardware.KansasLava.Boards.Spartan3e' via a class
-- abstaction. The other API also contains some Board specific utilties
-- that can also be used for simulation.

module Hardware.KansasLava.Simulators.Spartan3e 
        ( Spartan3e(..)
        , Graphic(..)
        ) where

import qualified Hardware.KansasLava.Boards.Spartan3e as Board
import Hardware.KansasLava.Boards.Spartan3e -- (board_init, rot_as_reset)
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

------------------------------------------------------------
-- initialization
------------------------------------------------------------

-- | 'board_init' sets up the use of the clock.
-- Always call 'board_init' first. 
-- Required.
instance Board.Spartan3e Polyester where 

   board_init = do
        generic_init BOARD CLOCK

        -- we now grab the input streams, and display any change of switches.
        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

        
   -- This does nothing on the simulator, because the shallow circuits
   -- can not do a hard reset.
   rot_as_reset = return ()
 
   --tickTock :: (Size w) => Witness w -> Integer -> fabric (Seq Bool)
   tickTock wit hz = do
           simSpeed <- getPolyesterSimSpeed
           return (rate wit (1 / ((fromIntegral simSpeed) / fromIntegral hz)))

   -----------------------------------------------------------------------
   -- Patches
   -----------------------------------------------------------------------

-- (Seq (Enabled ((X2,X16),U8)))  ()
-- (Seq Ack)	                 ()
	                  
   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
        -- 10 bits per byte
        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
        -- 10 bits per byte
        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)))

   -----------------------------------------------------------------------
   -- Native APIs
   -----------------------------------------------------------------------

   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       -- flip
                    | otherwise     = old           -- leave
         
        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       -- flip
                    | otherwise     = old           -- leave
         
        key :: Matrix X4 Char
        key = matrix "aegx"

   leds m = do
        sequence_ [ outPolyester (LED (fromIntegral i)) (fromS (m ! i))
	          | i <- [0..7]
	          ]

{-
   mm_vgaP = fromAckBox $$ forwardP fab
      where
        fab :: [Maybe ((X40, X80), (VGA.Attr, U7))] -> Polyester ()
        fab inp = do
                writeFilePolyester ("dev/vga") 
                        ((Just $ VGA.init_VCG_ANSI) : map (fmap (VGA.show_VCG_ANSI)) inp)
-}

   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

-----------------------------------------------------------------------
-- Utilities uses in the class defintion.
-----------------------------------------------------------------------

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


-- | The clock rate on the Spartan3e (50MHz), in hertz.
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"
 ]



-----------------------------------------------------------------------
-- Output To Screen Driver
-----------------------------------------------------------------------

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