Hieroglyph-1.1: Graphics/Rendering/Hieroglyph/Interactive.hs
-- | 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