Thingie 0.51 → 0.80

raw patch · 6 files changed

+368/−49 lines, 6 filesdep +gtk

Dependencies added: gtk

Files

Graphics/Rendering/Thingie/BasicUIState.hs +59/−0
Graphics/Rendering/Thingie/Cairo.hs +26/−35
Graphics/Rendering/Thingie/Interactive.hs +199/−0
Graphics/Rendering/Thingie/Primitives.hs +23/−12
Graphics/Rendering/Thingie/UIState.hs +56/−0
Thingie.cabal +5/−2

+ Graphics/Rendering/Thingie/BasicUIState.hs view

@@ -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@] &copy; 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

Graphics/Rendering/Thingie/Cairo.hs view

@@ -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

+ Graphics/Rendering/Thingie/Interactive.hs view

@@ -0,0 +1,199 @@+-- | An interactive scene graph library for Cairo +--+--   [@Author@] Jeff Heard+--+--   [@Copyright@] &copy; 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

Graphics/Rendering/Thingie/Primitives.hs view

@@ -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

+ Graphics/Rendering/Thingie/UIState.hs view

@@ -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@] &copy; 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)+

Thingie.cabal view

@@ -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