-- | An interactive scene graph library for Cairo 
--
--   [@Author@] Jeff Heard
--
--   [@Copyright@] © 2008 Renaissance Computing Institute
--
module Graphics.Rendering.Hieroglyph.Interactive where

import Graphics.Rendering.Hieroglyph.Primitives
import Graphics.Rendering.Hieroglyph.ImageCache
import Graphics.Rendering.Hieroglyph.Cairo
import Graphics.Rendering.Hieroglyph.Scaffolds.Interactive
import Graphics.Rendering.Hieroglyph.Visual
import qualified Graphics.UI.Gtk.Cairo as Gtk
import qualified Graphics.Rendering.Cairo as Cairo
import qualified Graphics.UI.Gtk as Gtk
import qualified Graphics.UI.Gtk.Gdk.Events as Gtk
import Control.Parallel.Strategies

import Data.List
import Data.Maybe
import Control.Monad
import Control.Concurrent.MVar 
 
-- | Applies the current Interactive instance to a single scene element, returning an Object
applyDataToVisual :: (Interactive a, Visual b) => a -> (a -> b) -> b
applyDataToVisual vdata obj = obj vdata

-- | Render function.  All Cairo is called through here.  You do not need to call this in your own code.
renderer :: (Interactive a, Visual b) => MVar [Primitive] -> MVar a -> (a -> b) -> IO ()
renderer extant_geometry state scene = do 
    geom <- takeMVar extant_geometry
    st <- takeMVar state
    let state' = interactionFold st geom
        geom' = scene state'
    dwin <- Gtk.widgetGetDrawWindow . fromJust . getDrawing $ st  
    Gtk.renderWithDrawable dwin (render (fromJust (getImageCache st)) geom')
    putMVar extant_geometry . primitives $ geom'
    putMVar state state'                   


-- | Gets the keyboard state from Gtk and changes the Interactive.  You do not need
--   to call this in your own code
keyboardHandler :: Interactive a => MVar a -> Gtk.Event -> IO Bool
keyboardHandler uistate_mvar event = do
    let k = case Gtk.eventKeyName event of 
                "Insert" -> Insert
                "Delete" -> Delete
                "Enter" -> Enter
                "F1" -> PF1
                "F2" -> PF2
                "F3" -> PF3
                "F4" -> PF4
                "F5" -> PF5
                "F6" -> PF6
                "F7" -> PF7
                "F8" -> PF8
                "F9" -> PF9
                "F10" -> PF10
                "F11" -> PF11
                "F12" -> PF12
                "Home" -> Home
                "End" -> End
                "PageUp" -> PgUp
                "PageDown" -> PgDown
                [x] -> Character x
                _ -> Character '\0'
    modifyMVar_ uistate_mvar $ return . setKey k
    withMVar uistate_mvar $ \s -> do
        dwin <- Gtk.widgetGetDrawWindow . fromJust . getDrawing $ s
        Gtk.drawWindowInvalidateRect dwin (Gtk.Rectangle 0 0 (round . getSizeX $ s) (round . getSizeY $ s)) False
    return False
    
-- | Gets the mouse position and changes the Interactive to reflect it.  YOu do not need this in your own code.
mouseMotionHandler :: Interactive a => MVar a -> Gtk.Event -> IO Bool
mouseMotionHandler uistate_mvar event = do 
    state <- takeMVar uistate_mvar
    putMVar uistate_mvar 
        $ setMousePosition (Point (Gtk.eventX event) (Gtk.eventY event)) state
    dwin <- Gtk.widgetGetDrawWindow . fromJust . getDrawing $ state
    Gtk.drawWindowGetPointer dwin
    Gtk.drawWindowInvalidateRect dwin (Gtk.Rectangle 0 0 (round . getSizeX $ state) (round . getSizeY $ state)) False
    return False

mouseReleaseHandler :: Interactive a => MVar a -> Gtk.Event -> IO Bool
mouseReleaseHandler uistate_mvar event = do
    let x = Gtk.eventX event
        y = Gtk.eventY event
        button = Gtk.eventButton event
        modifiers = Gtk.eventModifier event
        shift = elem Gtk.Shift modifiers
        alt = elem Gtk.Alt modifiers
        ctrl = elem Gtk.Control modifiers
    
    modifyMVar_ uistate_mvar 
        $ return 
        . setMousePosition (Point x y)
        . setKeyShift shift
        . setKeyAlt alt
        . setKeyCtrl ctrl
        . (case button of
            Gtk.LeftButton -> setMouseLeftButtonDown False
                                . setMouseWheel 0 
            Gtk.RightButton -> setMouseRightButtonDown False
                                . setMouseWheel 0
            Gtk.MiddleButton -> setMouseRightButtonDown False
                                . setMouseWheel 0)
    withMVar uistate_mvar $ \s -> do
        dwin <- Gtk.widgetGetDrawWindow . fromJust . getDrawing $ s
        Gtk.drawWindowInvalidateRect dwin (Gtk.Rectangle 0 0 (round . getSizeX $ s) (round . getSizeY $ s)) False
    return True

-- | Gets the mouse button state and changes the Interactive to reflect it.  You do not need this in your own code.
mouseButtonHandler :: Interactive a => MVar a -> Gtk.Event -> IO Bool
mouseButtonHandler uistate_mvar event = do
    let x = Gtk.eventX event
        y = Gtk.eventY event
        button = Gtk.eventButton event
        modifiers = Gtk.eventModifier event
        shift = elem Gtk.Shift modifiers
        alt = elem Gtk.Alt modifiers
        ctrl = elem Gtk.Control modifiers
    
    modifyMVar_ uistate_mvar 
        $ return 
        . setMousePosition (Point x y)
        . setKeyShift shift
        . setKeyAlt alt
        . setKeyCtrl ctrl
        . (case button of
            Gtk.LeftButton -> setMouseLeftButtonDown True
                                . setMouseRightButtonDown False
                                . setMouseMiddleButtonDown False
                                . setMouseWheel 0 
            Gtk.RightButton -> setMouseLeftButtonDown False
                                . setMouseRightButtonDown True
                                . setMouseMiddleButtonDown False
                                . setMouseWheel 0
            Gtk.MiddleButton -> setMouseLeftButtonDown False
                                . setMouseRightButtonDown False
                                . setMouseRightButtonDown True
                                . setMouseWheel 0)
    withMVar uistate_mvar $ \s -> do
        dwin <- Gtk.widgetGetDrawWindow . fromJust . getDrawing $ s
        Gtk.drawWindowInvalidateRect dwin (Gtk.Rectangle 0 0 (round . getSizeX $ s) (round . getSizeY $ s)) False
    return True

-- | Window resize handler. Changes the Interactive to reflect the new sizing.  You do not need this in your own code.
resize state event = do
    let sizex = Gtk.eventWidth event
        sizey = Gtk.eventHeight event
    modifyMVar_ state $ return . setSizeX (fromIntegral sizex) . setSizeY (fromIntegral sizey)
    withMVar state $ \s -> do
        dwin <- Gtk.widgetGetDrawWindow . fromJust . getDrawing $ s
        Gtk.drawWindowInvalidateRect dwin (Gtk.Rectangle 0 0 sizex sizey) False
    return False


-- | A lowish level funtion for creating a GUI.  Does not set the size of the
--   window or expose any windows.
guiInit :: (Interactive a, Visual b) 
        => MVar a               -- ^ The current Interactive 
        -> (a->b)               -- ^ The scene to render
        -> String               -- ^ The name of the window 
        -> Bool                 -- ^ Whether or not to make this GUI motion sensitive
        -> IO Gtk.DrawingArea   -- ^ Returns the window that was created
guiInit state scene name motionSensitive = do 
    Gtk.unsafeInitGUIForThreadedRTS

    canvas <- Gtk.drawingAreaNew    
    imgcache <- initImageCache
    modifyMVar_ state $ return . setDrawing (Just . Gtk.castToWidget $ canvas) . setImageCache (Just imgcache)
    primitiveData <- newMVar []

    Gtk.onExpose canvas $ \evt -> renderer primitiveData state scene >> return True
    Gtk.onConfigure canvas $ resize state
    Gtk.onButtonPress canvas $ mouseButtonHandler state 
    Gtk.onButtonRelease canvas $ mouseReleaseHandler state 
    Gtk.onKeyPress canvas $ keyboardHandler state 
    when motionSensitive $ (Gtk.onMotionNotify canvas True $ mouseMotionHandler state) >> return ()
    return canvas

-- | A higher level function for creating a GUI.  Does not set the size of the 
--   window or expose any windows, but does kill the app if this window is 
--   closed
guiConstruct :: (Interactive a, Visual b)
             => a           -- ^ The default Interactive
             -> ( a -> b )   -- ^ The scene to render
             -> String      -- ^ The name of the scene
             -> Bool        -- ^ Whether or not this GUI is motion sensitive
             -> IO Gtk.Window
guiConstruct state scene name motionSensitive = do
    mvar <- newMVar state
    canvas <- guiInit mvar scene name motionSensitive
    window <- Gtk.windowNew
    Gtk.windowSetTitle window name
    Gtk.containerAdd window canvas
    Gtk.onDestroy window Gtk.mainQuit
    return window

-- | A high level function for creating a GUI.  Just specify a default
--   state, the name of the scene, and the scene, and you get an 800 by
--   600 motion insensitive GUI.
simpleGui :: (Interactive a, Visual b)
          => a 
          -> (a -> b)
          -> String 
          -> IO ()
simpleGui state scene name = do
    win <- guiConstruct state scene name False
    Gtk.windowSetDefaultSize win 800 600
    Gtk.widgetShowAll win
    Gtk.mainGUI

-- | A high level function for creating a GUI.  Just specify the default
--   state, the name of the scene, and the scene, and you get an 800 by
--   600 motion sensitive GUI
simpleMotionSensitiveGui state scene name = do
    win <- guiConstruct state scene name True
    Gtk.windowSetDefaultSize win 800 600
    Gtk.widgetShowAll win
    Gtk.mainGUI