diff --git a/Graphics/Rendering/Thingie/BasicUIState.hs b/Graphics/Rendering/Thingie/BasicUIState.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Thingie/BasicUIState.hs @@ -0,0 +1,59 @@ +-- | If the items in the UIState module are the only state you need in your +-- program, then it is sufficient to import this module and start with the +-- defaultBasicState. +-- +-- [@Author@] Jeff Heard +-- +-- [@Copyright@] © 2008 Renaissance Computing Institute +-- +module Graphics.Rendering.Thingie.BasicUIState where + +import qualified Graphics.Rendering.Thingie.UIState as U +import Graphics.Rendering.Thingie.Primitives +import qualified Graphics.UI.Gtk as Gtk + + +-- The most basic implementation of a UIState +data BasicUIState = BasicUIState + { mousePosition :: Point2D + , mouseLeftButtonDown :: Bool + , mouseRightButtonDown :: Bool + , mouseMiddleButtonDown :: Bool + , mouseWheel :: Int + , keyCtrl :: Bool + , keyShift :: Bool + , keyAlt :: Bool + , key :: U.Key + , drawing :: Maybe Gtk.Widget + , sizeX :: Double + , sizeY :: Double } + +instance U.UIState BasicUIState where + mousePosition = mousePosition + mouseLeftButtonDown = mouseLeftButtonDown + mouseRightButtonDown = mouseRightButtonDown + mouseMiddleButtonDown = mouseMiddleButtonDown + mouseWheel = mouseWheel + keyCtrl = keyCtrl + keyShift = keyShift + keyAlt = keyAlt + key = key + drawing = drawing + sizeX = sizeX + sizeY = sizeY + + setMousePosition p a = a{ mousePosition = p } + setMouseLeftButtonDown p a = a{ mouseLeftButtonDown = p } + setMouseRightButtonDown p a = a{ mouseRightButtonDown = p } + setMouseMiddleButtonDown p a = a{ mouseMiddleButtonDown = p } + setMouseWheel p a = a{ mouseWheel = p } + setKeyCtrl p a = a{ keyCtrl = p } + setKeyShift p a = a{ keyShift = p } + setKeyAlt p a = a{ keyAlt = p } + setKey p a = a{ key = p } + setDrawing p a = a{ drawing = p } + setSizeX p a = a{ sizeX = p } + setSizeY p a = a{ sizeY = p } + +-- This is the default state you should pass to the interactive function. +defaultBasicUIState = BasicUIState (Point2D 0 0) False False False 0 False False False (U.Character '\0') Nothing 800 600 diff --git a/Graphics/Rendering/Thingie/Cairo.hs b/Graphics/Rendering/Thingie/Cairo.hs --- a/Graphics/Rendering/Thingie/Cairo.hs +++ b/Graphics/Rendering/Thingie/Cairo.hs @@ -62,19 +62,9 @@ -- | A tree structure that defines a frame. The first argument is either a -- 'Draw' or a 'Setup' command and the list is a list of children. -data Frame = Node MyEither [Frame] - --- | A more mnemonic Either type, constraining the Left to be drawing primitives --- and the Right to be lists of state changes to make before drawing children. -data MyEither = Draw Primitive | Setup [StateModifier] - --- | @e --\< c@ is a combinator to create a @Node e c@ structure. The point --- is that the left side happens before the children. Suggest a better name --- for this operator and consider it done. -e --< c = Node e c - --- | @leaf e@ is equivalent to @e --\< []@. It creates a leaf node. -leaf e = e --< [] +data Object = Group [Object] + | Draw Primitive + | Context [StateModifier] Object -- | The current state of the renderer. Carried down the tree and modified with 'StateModifier' 'Node's. data RendererState = RendererState @@ -257,36 +247,37 @@ applyStateChangeToCairo state (OutlineRGB r g b) = return () applyStateChangeToCairo state (OutlineRGBA r g b a) = return () --- | @renderFrame node@ renders a Frame object to the current surface -renderFrame :: Frame -> Cairo.Render () -renderFrame node = renderFrameCustom defaultState node -renderFrameCustom state (Node (Draw prim) frames) = do - renderPrimitive state prim - mapM_ (renderFrameCustom state) frames -renderFrameCustom state (Node (Setup pdirective) frames) = do +renderObject :: Object -> Cairo.Render () +renderObject = renderObjectWithState defaultState + +renderObjectWithState :: RendererState -> Object -> Cairo.Render () +renderObjectWithState state (Group objects) = mapM_ (renderObjectWithState state) objects +renderObjectWithState state (Draw prim) = renderPrimitive state prim +renderObjectWithState state (Context setup object) = do Cairo.save - state' <- changeRenderState state pdirective - mapM_ (renderFrameCustom state') frames + state' <- changeRenderState state setup + renderObjectWithState state' object Cairo.restore + loadStateIntoCairo state -- | @renderFrameToSurface surface frame@ renders a frame to a particular surface -renderFrameToSurface :: Cairo.Surface -> Frame -> IO () -renderFrameToSurface surf frame = Cairo.renderWith surf (renderFrame frame) +renderObjectToSurface :: Cairo.Surface -> Object -> IO () +renderObjectToSurface surf frame = Cairo.renderWith surf (renderObject frame) -- | @renderframeToPNG filename xres yres frame@ renders a frame to an image file -renderFrameToPNG :: FilePath -> Int -> Int -> Frame -> IO () -renderFrameToPNG filename xres yres frame = Cairo.withImageSurface Cairo.FormatARGB32 xres yres $ \s -> renderFrameToSurface s frame >> Cairo.surfaceWriteToPNG s filename +renderObjectToPNG :: FilePath -> Int -> Int -> Object -> IO () +renderObjectToPNG filename xres yres frame = Cairo.withImageSurface Cairo.FormatARGB32 xres yres $ \s -> renderObjectToSurface s frame >> Cairo.surfaceWriteToPNG s filename --- | @renderFrameToPDF filename width height frame@ renders a frame to a PDF file. width and height are in points. -renderFrameToPDF :: FilePath -> Double -> Double -> Frame -> IO () -renderFrameToPDF filename width height frame = Cairo.withPDFSurface filename width height $ \s -> renderFrameToSurface s frame +-- | @renderObjectToPDF filename width height frame@ renders a frame to a PDF file. width and height are in points. +renderObjectToPDF :: FilePath -> Double -> Double -> Object -> IO () +renderObjectToPDF filename width height frame = Cairo.withPDFSurface filename width height $ \s -> renderObjectToSurface s frame --- | @renderFrameToPostscript filename width height frame@ renders a frame to a Postscript file. width and height are in points. -renderFrameToPostscript :: FilePath -> Double -> Double -> Frame -> IO () -renderFrameToPostscript filename width height frame = Cairo.withPSSurface filename width height $ \s -> renderFrameToSurface s frame +-- | @renderObjectToPostscript filename width height frame@ renders a frame to a Postscript file. width and height are in points. +renderObjectToPostscript :: FilePath -> Double -> Double -> Object -> IO () +renderObjectToPostscript filename width height frame = Cairo.withPSSurface filename width height $ \s -> renderObjectToSurface s frame --- | @renderFrameToSVG filename width height frame@ renders a frame to a SVG file. width and height are in points. -renderFrameToSVG :: FilePath -> Double -> Double -> Frame -> IO () -renderFrameToSVG filename width height frame = Cairo.withSVGSurface filename width height $ \s -> renderFrameToSurface s frame +-- | @renderObjectToSVG filename width height frame@ renders a frame to a SVG file. width and height are in points. +renderObjectToSVG :: FilePath -> Double -> Double -> Object -> IO () +renderObjectToSVG filename width height frame = Cairo.withSVGSurface filename width height $ \s -> renderObjectToSurface s frame diff --git a/Graphics/Rendering/Thingie/Interactive.hs b/Graphics/Rendering/Thingie/Interactive.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Thingie/Interactive.hs @@ -0,0 +1,199 @@ +-- | An interactive scene graph library for Cairo +-- +-- [@Author@] Jeff Heard +-- +-- [@Copyright@] © 2008 Renaissance Computing Institute +-- +module Graphics.Rendering.Thingie.Interactive where + +import Graphics.Rendering.Thingie.Primitives +import Graphics.Rendering.Thingie.Cairo +import Graphics.Rendering.Thingie.UIState +import qualified Graphics.UI.Gtk.Cairo as Gtk +import qualified Graphics.Rendering.Cairo as Cairo +import qualified Graphics.UI.Gtk as Gtk + +import Data.List +import Data.Maybe +import Control.Monad +import Control.Concurrent.MVar + +-- | A scene element. This is the basic building block of your interactive app. +data SceneElement a = + StaticElement Object Rect2D -- ^ An unreactive element in the scene. Not modified by program state. + | BoundedElement (a -> Object) Rect2D -- ^ A reactive, but bounded element in the scene. The element reacts to a UIState instance, but is confined within a particular rectangle. + | UnboundedElement (a -> Object) -- ^ An unbounded reactive element in the scene. The element reacts to a UIState instance, but can go anywhere in the scene. + | ElementGroup [SceneElement a] -- ^ A group of scene elements. + +-- | The scene itself +type Scene a = [SceneElement a] + +-- | Applies the current UIState instance to a single scene element, returning an Object +-- FIXME: Should do bounds checking. +renderSceneElement :: UIState a => a -> SceneElement a -> Object +renderSceneElement _ (StaticElement obj _) = obj +renderSceneElement uistate (BoundedElement obj _) = obj uistate +renderSceneElement uistate (UnboundedElement obj) = obj uistate +renderSceneElement uistate (ElementGroup elts) = Group . map (renderSceneElement uistate) $ elts + +-- | @renderScene state scene applies the current UIState to the entire scene +renderScene :: UIState a => a -> Scene a -> Object +renderScene state = Group . map (renderSceneElement state) + +-- | Gets the keyboard state from Gtk and changes the UIState. You do not need +-- to call this in your own code +keyboardHandler :: UIState a => MVar a -> Scene a ->Gtk.Event -> IO Bool +keyboardHandler uistate_mvar scene 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 . drawing $ s + Gtk.drawWindowInvalidateRect dwin (Gtk.Rectangle 0 0 (round . sizeX $ s) (round . sizeY $ s)) False + return False + +-- | Gets the mouse position and changes the UIState to reflect it. YOu do not need this in your own code. +mouseMotionHandler :: UIState a => MVar a -> Gtk.Event -> IO Bool +mouseMotionHandler uistate_mvar event = do + state <- takeMVar uistate_mvar + putMVar uistate_mvar + $ setMousePosition (Point2D (Gtk.eventX event) (Gtk.eventY event)) state + dwin <- Gtk.widgetGetDrawWindow . fromJust . drawing $ state + Gtk.drawWindowGetPointer dwin + Gtk.drawWindowInvalidateRect dwin (Gtk.Rectangle 0 0 (round . sizeX $ state) (round . sizeY $ state)) False + return False + +-- | Gets the mouse button state and changes the UIState to reflect it. You do not need this in your own code. +mouseButtonHandler :: UIState a => MVar a -> Scene a -> Gtk.Event -> IO Bool +mouseButtonHandler uistate_mvar scene 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 (Point2D 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 . drawing $ s + Gtk.drawWindowInvalidateRect dwin (Gtk.Rectangle 0 0 (round . sizeX $ s) (round . sizeY $ s)) False + return True + +-- | Window resize handler. Changes the UIState to reflect the new sizing. You do not need this in your own code. +resize state scene 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 . drawing $ s + Gtk.drawWindowInvalidateRect dwin (Gtk.Rectangle 0 0 sizex sizey) False + return False + +-- | Render function. All Cairo is called through here. You do not need to call this in your own code. +renderer :: UIState a => MVar a -> Scene a -> IO () +renderer state scene = withMVar state $ \st -> do + dwin <- Gtk.widgetGetDrawWindow . fromJust . drawing $ st + Gtk.renderWithDrawable dwin $ (renderObject . renderScene st $ scene) + + +-- | A lowish level funtion for creating a GUI. Does not set the size of the +-- window or expose any windows. +guiInit :: UIState a + => MVar a -- ^ The current UIState + -> Scene a -- ^ The scene graph to render + -> String -- ^ The name of the window + -> Bool -- ^ Whether or not to make this GUI motion sensitive + -> IO Gtk.Window -- ^ Returns the window that was created +guiInit state scene name motionSensitive = do + Gtk.unsafeInitGUIForThreadedRTS + + window <- Gtk.windowNew + canvas <- Gtk.drawingAreaNew + Gtk.windowSetTitle window name + Gtk.containerAdd window canvas + + modifyMVar_ state $ return . setDrawing (Just . Gtk.castToWidget $ canvas) + + Gtk.onExpose canvas $ \evt -> renderer state scene >> return True + Gtk.onConfigure window $ resize state scene + Gtk.onButtonPress canvas $ mouseButtonHandler state scene + Gtk.onKeyPress window $ keyboardHandler state scene + when motionSensitive $ (Gtk.onMotionNotify canvas True $ mouseMotionHandler state) >> return () + return window + +-- | 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 :: UIState a + => a -- ^ The default UIState + -> Scene a -- ^ 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 + window <- guiInit mvar scene name motionSensitive + 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 :: UIState a + => a + -> Scene a + -> 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 diff --git a/Graphics/Rendering/Thingie/Primitives.hs b/Graphics/Rendering/Thingie/Primitives.hs --- a/Graphics/Rendering/Thingie/Primitives.hs +++ b/Graphics/Rendering/Thingie/Primitives.hs @@ -19,8 +19,11 @@ -- | A 2D point data Point2D = Point2D Double Double deriving (Show, Read) +data Rect2D = Rect2D Double Double Double Double + -- | A 2D primitive in an arbitrary Cartesian 2d space data Primitive = + -- | An arc Arc -- A possibly filled pie slice or arc { center :: Point2D -- ^ center of the arc , radius :: Double -- ^ radius of the arc @@ -29,46 +32,54 @@ , negative :: Bool -- ^ whether or not to consider this a slice of or a slice out of the pie , filled :: Bool -- ^ pie, or just crust? , outlined :: Bool -- ^ crustless pie? - , clipped :: Bool } -- ^ add this to the clipping plane - + , clipped :: Bool -- ^ add this to the clipping plane + } + -- | A cubic spline | Curve -- An arbitrary cubic spline { begin :: Point2D -- ^ starting point , curve_segments :: [(Point2D,Point2D,Point2D)] -- ^ A sequential list of curve segments. Note that the first two points are control points. , closed :: Bool -- ^ Whether or not to close this curve with a final line , filled :: Bool -- ^ Whether or not to fill the curve , outlined :: Bool -- ^ Whether or not to outline the curve - , clipped :: Bool } -- ^ Add the curve to the clipping plane - + , clipped :: Bool -- ^ Add the curve to the clipping plane + } + -- | A series of straight lines | Line -- An arbitrary series of line segments { begin :: Point2D -- ^ Starting Point , segments :: [Point2D] -- ^ Line segments. , closed :: Bool -- ^ Whether or not to finish this curve with a last line from the end segment to the begin point. , filled :: Bool -- ^ Whether or not to fill the curve , outlined :: Bool -- ^ Whether or not to draw the outline - , clipped :: Bool } -- ^ Add to the clipping plane + , clipped :: Bool -- ^ Add to the clipping plane + } + -- | Move the pen | Pen - { moveto :: Point2D } -- ^ Move the current point. Matters for arcs sometimes. May remove the begin point for Curve and Line in favor of this. - + { moveto :: Point2D -- ^ Move the current point. Matters for arcs sometimes. May remove the begin point for Curve and Line in favor of this. + } + -- | A rectangle | Rectangle -- An possibly filled rectangle { topleft :: Point2D -- ^ The top left point , width :: Double -- ^ The width , height :: Double -- ^ The height , filled :: Bool -- ^ Fill the rectangle? , outlined :: Bool -- ^ Draw the outline? - , clipped :: Bool } -- ^ Add to the clipping plane? - + , clipped :: Bool -- ^ Add to the clipping plane? + } + -- | A simple text object | Text -- A simple text string { str :: String -- ^ The string to print , bottomleft :: Point2D -- ^ The anchor point for the text. Baseline, not bottom. , filled :: Bool -- ^ Fill the text? Usually you want this and not outline. , outlined :: Bool -- ^ Draw the outline? - , clipped :: Bool } -- ^ Add to the clipping plane? - + , clipped :: Bool -- ^ Add to the clipping plane? + } + -- | A compound object | Compound -- Use this to create an arbitrary shape before calling fill, stroke, and clip. { primitives :: [Primitive] -- ^ primitives to use , filled :: Bool -- ^ fill the result? , outlined :: Bool -- ^ outline the result? - , clipped :: Bool } -- ^ clip the result? + , clipped :: Bool -- ^ clip the result? + } deriving (Show,Read) -- | the origin point diff --git a/Graphics/Rendering/Thingie/UIState.hs b/Graphics/Rendering/Thingie/UIState.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Thingie/UIState.hs @@ -0,0 +1,56 @@ +-- | Establish a class for all things that are utterly required to be part of +-- the program state for the interactive renderer. These will all be set +-- by the interactive system for you, so they just must be defined in your +-- state object. +-- +-- [@Author@] Jeff Heard +-- +-- [@Copyright@] © 2008 Renaissance Computing Institute +-- +module Graphics.Rendering.Thingie.UIState where + +import Graphics.Rendering.Thingie.Primitives +import qualified Graphics.UI.Gtk as Gtk + +-- | A keystroke +data Key = + Character Char + | Enter + | Tab + | BackSpace + | Insert + | Delete + | Home + | End + | PgUp + | PgDown + | PF1 | PF2 | PF3 | PF4 | PF5 | PF6 | PF7 | PF8 | PF9 | PF10 | PF11 | PF12 + +-- | The basic UI state. This will get passed to all scene elements +class UIState a where + mousePosition :: a -> Point2D -- ^ The current mouse position + mouseLeftButtonDown :: a -> Bool -- ^ Mouse left button. Is it down? + mouseRightButtonDown :: a -> Bool -- ^ Mouse right button, is it down? + mouseMiddleButtonDown :: a -> Bool -- ^ Mouse middle button, is it down? + mouseWheel :: a -> Int -- ^ Moues wheel, has it moved? + keyCtrl :: a -> Bool -- ^ Is the control key down? + keyShift :: a -> Bool -- ^ Is the shift key down? + keyAlt :: a -> Bool -- ^ Is the alt key down? + key :: a -> Key -- ^ Is there a real key down? + drawing :: a -> Maybe Gtk.Widget -- ^ The draw window + sizeX :: a -> Double -- ^ The width of the drawing area + sizeY :: a -> Double -- ^ The height of the drawing area + + setMousePosition :: Point2D -> a-> a -- ^ Set the mouse position (do not call in your own code) + setMouseLeftButtonDown :: Bool -> a-> a -- ^ Set the left button (do not call in your own code) + setMouseRightButtonDown :: Bool -> a-> a -- ^ Set the right button (do not call in your own code) + setMouseMiddleButtonDown :: Bool -> a-> a -- ^ Set the middle button (do not call in your own code) + setMouseWheel :: Int -> a-> a -- ^ Set the mouse wheel delta (do not call in your own code) + setKeyCtrl :: Bool -> a-> a -- ^ Set the control modifier state (do not call in your own code) + setKeyShift :: Bool -> a-> a -- ^ Set the shift modifier state (do not call in your own code) + setKeyAlt :: Bool -> a-> a -- ^ Set the alt modifier state (do not call in your own code) + setKey :: Key -> a-> a -- ^ Set the key that is pressed (do not call in your own code) + setDrawing :: Maybe Gtk.Widget -> a-> a -- ^ Set the draw window (do not call in your own code) + setSizeX :: Double -> a -> a -- ^ Set the drawing area width (do not call in your own code) + setSizeY :: Double -> a -> a -- ^ Set the drawing area height (do not call in your own code) + diff --git a/Thingie.cabal b/Thingie.cabal --- a/Thingie.cabal +++ b/Thingie.cabal @@ -1,5 +1,5 @@ Name: Thingie -Version: 0.51 +Version: 0.80 Cabal-Version: >= 1.2 License: BSD3 License-File: LICENSE @@ -13,8 +13,11 @@ Build-Type: Simple Library - Build-Depends: cairo, base, mtl + Build-Depends: cairo, base, mtl, gtk Exposed-Modules: Graphics.Rendering.Thingie.Primitives Graphics.Rendering.Thingie.Cairo + Graphics.Rendering.Thingie.BasicUIState + Graphics.Rendering.Thingie.UIState + Graphics.Rendering.Thingie.Interactive