{-# LANGUAGE RecordWildCards #-}

module Control.FRPNow.Vty.Widgets where

import Control.FRPNow.Vty.Core
import Control.FRPNow
import Graphics.Vty hiding (Event)
import Control.Applicative
import Data.Monoid

data Widget = Widget {
      widgetLocation :: (Int,Int)
    , widgetChildrean :: [Widget]
    , widgetImage :: Image
    , widgetRegion :: DisplayRegion
    , widgetVisible :: Bool
    }
type MakeWidget = Behavior DisplayRegion -> Behavior Bool -> Behavior (Behavior Widget)

originWidget = Widget (0,0)

makeWidget :: Behavior DisplayRegion -> Behavior Bool -> MakeWidget -> Behavior (Behavior Widget)
makeWidget bD bVis w = w bD bVis

drawWidget :: Widget -> Picture
drawWidget = picForLayers . helper
    where helper Widget{..}
                | widgetVisible = map (uncurry translate (widgetLocation)) $
                    widgetImage : concatMap helper widgetChildrean 
                | otherwise = []

keyToQuit :: Key -> EvStream VEvent -> Behavior DisplayRegion -> MakeWidget -> Behavior (Behavior Widget)
keyToQuit k eEv bDis mW = next (filterEs (isKey k) eEv) >>= mW bDis . flip (cstep True) False

runWidget :: (EvStream VEvent -> Behavior Double -> Behavior DisplayRegion -> Now (Behavior Widget)) -> IO ()
runWidget f = runVTY $ \eEv bT bD -> do
    masterWidget <- f eEv bT bD
    endEv <- sampleNow $ when $ (not . widgetVisible) <$> masterWidget
    return (endEv, drawWidget <$> masterWidget)

tabbingWidget :: EvStream a -> EvStream b -> [MakeWidget] -> MakeWidget
tabbingWidget eUp eDown ws bDis bVis = do
    let sz = length ws
    eNum <- fmap (\x -> mod x sz) <$> foldEs (+) 0 ((1 <$ eDown) <> ((-1) <$ eUp))
    children <- sequence $  zipWith (\f n -> f bDis ((== n) <$> eNum)) ws [0..] 
    return $ originWidget <$> sequence children <*> pure mempty <*> bDis <*> bVis

horzPane :: Int -> MakeWidget -> MakeWidget -> MakeWidget
horzPane = paneWidget (\d (x,y) -> (x+d,y))

vertPane :: Int -> MakeWidget -> MakeWidget -> MakeWidget
vertPane = paneWidget (\d (x,y) -> (x,y+d))

paneWidget :: (Int -> (Int,Int) -> (Int,Int) ) -> Int -> MakeWidget -> MakeWidget -> MakeWidget
paneWidget fTran n w1 w2 bDis bVis = do
    c1 <- makeWidget bDis bVis w1
    c2 <- fmap (\w -> w {widgetLocation = fTran n (widgetLocation w)}) <$> makeWidget bDis bVis w2
    return $ originWidget <$> sequence [c1,c2] <*> pure mempty <*> bDis <*> bVis

simpleWidget :: Image -> MakeWidget
simpleWidget i bDis bVis = return $ Widget (0,0) [] i <$> bDis <*> bVis 
