module Control.FRPNow.Vty.Core where

import Control.Applicative
import Control.Concurrent
import Control.FRPNow
import Control.Monad hiding (when)
import Data.Time.Clock.POSIX
import Graphics.Vty hiding (Event)
import qualified Graphics.Vty as V (Event)

drawAndRender :: Vty -> Picture -> IO ()
drawAndRender v pic = do
    update v pic
    refresh v

pushEventThread :: Vty -> (V.Event -> IO ()) -> IO ()
pushEventThread v push = forever $ nextEvent v >>= push

bClock :: Now (Behavior Double)
bClock = do
    st <- sync getPOSIXTime
    let loop n = do
                e <- async $ threadDelay (10 ^ 5) >> getPOSIXTime
                e' <- planNow $ loop <$> e
                return $ pure n `switch` e'
    currentTime <- loop st
    return $ fmap realToFrac $ (-) <$> currentTime <*> pure st

bWindowSize :: Vty -> Now (Behavior DisplayRegion)
bWindowSize v = do
    let loop x = do
                e <- async $ threadDelay (10 ^ 5) >> displayBounds (outputIface v)
                e' <- planNow $ loop <$> e
                return $ pure x `switch` e'
    sync (displayBounds $ outputIface v) >>= loop

isKey :: Key -> V.Event -> Bool
isKey k (EvKey a _) = k == a
isKey _ _ = False

justKeys :: EvStream V.Event -> EvStream Key
justKeys = catMaybesEs . fmap helper
    where helper (EvKey a _) = Just a
          helper _ = Nothing

filterKeyChar :: Char -> EvStream VEvent -> EvStream ()
filterKeyChar c = void . filterEs (isKey $ KChar c)
    
runVTY :: (EvStream V.Event -> Behavior Double -> Behavior DisplayRegion -> Now (Event a, Behavior Picture)) -> IO ()
runVTY func = do
    vty <- standardIOConfig >>= mkVty 
    runNowMaster $ do
        (esEvent, puEvent) <- callbackStream
        bC <- bClock
        bD <- bWindowSize vty
        sync $ forkIO $ pushEventThread vty puEvent
        (eEnd,bPic) <- func esEvent bC bD
        sample bPic >>= sync . drawAndRender vty 
        callIOStream (drawAndRender vty ) $ toChanges bPic
        return eEnd
    
    shutdown vty

type VEvent = V.Event

instance Eq Picture where
    a == b = picCursor a == picCursor b && picLayers a == picLayers b 
        && picBackground a == picBackground b

instance Eq Background where
    ClearBackground == ClearBackground = True
    ClearBackground == _ = False
    a == b = backgroundChar a == backgroundChar b && backgroundAttr a == backgroundAttr b

instance Eq Cursor where
    NoCursor == NoCursor = True
    NoCursor == _ = False
    (Cursor ax ay) == (Cursor bx by) = ax == bx && ay == by


