{-
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2016 Piotr Borek
 *
 *  Distributed under the terms of the GPL (GNU Public License)
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ImplicitParams   #-}
{-# LANGUAGE ViewPatterns     #-}

module Simple.UI.Core.UIApp (
    runUIApp,
    runMainLoop,
    runDialogLoop,
    mainLoopQuit,
    mainSchedule,
    mainScheduleAfter,
    mainScheduleRepeat,
    -- reexports
    UIApp,
    UIApp',
    UIAppEvent (..),
    liftUIApp,
    liftUIApp',
    appUserData,
    uniqueIdNew
) where

import           Control.Concurrent
import           Control.Concurrent.STM
import           Control.Lens
import           Control.Monad
import           Control.Monad.Catch
import           Control.Monad.IO.Class
import           Data.Maybe
import           GHC.Stack
import qualified Graphics.Vty                  as Vty

import           Simple.UI.Core.Draw
import           Simple.UI.Core.Internal.UIApp
import           Simple.UI.Core.ListenerList
import           Simple.UI.Widgets.Widget
import           Simple.UI.Widgets.Window

-- core functions

newtype UIAppException = UIAppWindowIsNotTopLevelException CallStack

instance Show UIAppException where
    show (UIAppWindowIsNotTopLevelException stack) = "UIAppWindowIsNotTopLevelException\n\n" ++ prettyCallStack stack

instance Exception UIAppException

runUIApp :: u -> UIApp u () -> IO ()
runUIApp userData app = do
    appConfig <- initAppConfig
    appState  <- initAppState

    void $ _runUIApp appConfig appState app `finally` Vty.shutdown (appConfig ^. appVty)
  where
    initAppConfig = do
        c <- liftIO Vty.standardIOConfig
        v <- liftIO $ Vty.mkVty c
        tasks <- liftIO $ atomically newTChan
        liftIO $ Vty.hideCursor (Vty.outputIface v)
        return AppConfig
            { _appVty = v
            , _appTasks = tasks
            , _appUserData = userData
            }

    initAppState = do
        d <- drawingNew 0 0
        return AppState
            { _appIdCounter = 0
            , _appWidth     = 0
            , _appHeight    = 0
            , _appDrawing   = d
            , _appRoot      = Nothing
            }

runMainLoop :: (HasCallStack, WindowClass w) => w a -> UIApp u ()
runMainLoop (castToWindow -> root) = do
    when (windowType root /= WindowTypeTopLevel) $ throwM $ UIAppWindowIsNotTopLevelException ?callStack

    appRoot .= (Just $ castToWidget root)

    vty <- view appVty
    tasks <- view appTasks

    (width, height) <- liftIO $ Vty.displayBounds (Vty.outputIface vty)
    mainResize width height
    mainDraw

    mainEventThreadRun tasks vty
    runDialogLoop root

mainEventThreadRun :: MonadIO m => UIAppTasks -> Vty.Vty -> m ()
mainEventThreadRun tasks vty = void $ liftIO $ forkIO $ forever $ do
    event <- Vty.nextEvent vty
    case event of
        Vty.EvKey key modifiers   -> atomically $ writeTChan tasks $ UIAppEventKeyPressed key modifiers
        Vty.EvResize width height -> atomically $ writeTChan tasks $ UIAppEventResize width height
        _                         -> return ()

mainDraw :: UIApp u ()
mainDraw = do
    root <- fromJust <$> use appRoot
    vty <- view appVty

    drawing <- use appDrawing
    (width, height) <- drawingRun drawing drawingGetSize

    fire root draw (drawing, width, height)

    pic <- drawingToPicture drawing
    liftIO $ Vty.update vty pic

mainResize :: Int -> Int -> UIApp u ()
mainResize width height = do
    d <- drawingNew width height
    appWidth .= width
    appHeight .= height
    appDrawing .= d

runDialogLoop :: WidgetClass w => w -> UIApp u ()
runDialogLoop (castToWidget -> widget) = do
    vty <- view appVty
    tasks <- view appTasks
    dialogLoop vty tasks
  where
    dialogLoop vty tasks = do
        event <- liftIO . atomically $ readTChan tasks

        case event of
            UIAppEventResize width height      -> mainResize width height
            UIAppEventKeyPressed key modifiers -> fire widget keyPressed (key, modifiers)
            UIAppEventAction action            -> liftUIApp' action
            UIAppEventQuit                     -> return ()

        mainDraw

        if event == UIAppEventQuit
            then return ()
            else dialogLoop vty tasks

mainLoopQuit :: UIApp u ()
mainLoopQuit = do
    tasks <- view appTasks
    liftIO . atomically $ writeTChan tasks UIAppEventQuit

mainSchedule :: UIApp' () -> UIApp u ()
mainSchedule action = do
    tasks <- view appTasks
    mainSchedule' tasks action

mainSchedule' :: MonadIO m => UIAppTasks -> UIApp' () -> m ()
mainSchedule' tasks action = liftIO $
    atomically $ writeTChan tasks $ UIAppEventAction action

mainScheduleAfter :: Int -> UIApp' () -> UIApp u ()
mainScheduleAfter timeInMillis action = do
    tasks <- view appTasks
    void $ liftIO $ forkIO $ do
        threadDelay (timeInMillis * 1000)
        mainSchedule' tasks action

mainScheduleRepeat :: Int -> UIApp' () -> UIApp u ()
mainScheduleRepeat timeInMillis action = do
    tasks <- view appTasks
    void $ liftIO $ forkIO $ forever $ do
        mainSchedule' tasks action
        threadDelay (timeInMillis * 1000)