gtk-toy (empty) → 0.1.0

raw patch · 4 files changed

+295/−0 lines, 4 filesdep +basedep +containersdep +gtksetup-changed

Dependencies added: base, containers, gtk

Files

LICENSE +30/−0
Setup.hs +3/−0
gtk-toy.cabal +27/−0
src/Graphics/UI/Gtk/Toy.hs +235/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2011 Michael Sloan.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain

+ gtk-toy.cabal view

@@ -0,0 +1,27 @@+Name:                gtk-toy+Version:             0.1.0+Cabal-Version:       >= 1.6+Synopsis:            Convenient Gtk canvas with mouse and keyboard input.+Category:            Graphics, GUI+Description: +   The Gtk Toy Framework is a simplifying interface over Gtk for creating+   applications which draw things and interact with the mouse and keyboard.  It+   handles the minutae of setting up the Gtk window and canvas, and processes+   the input events into more palatable data structures.+License:             BSD3+License-file:        LICENSE+Author:              Michael Sloan+Maintainer:          Michael Sloan <mgsloan@gmail.com>+Stability:           experimental+Build-Type:          Simple+Source-repository head+  type:              git +  location:          git://github.com/mgsloan/gtk-toy.git++Library+  Extensions:        TupleSections, ViewPatterns+  Build-Depends:     base >= 4.2 && < 4.6,+                     gtk >= 0.12.0 && < 0.13.0,+                     containers+  Hs-source-dirs:    src+  Exposed-Modules:   Graphics.UI.Gtk.Toy

+ src/Graphics/UI/Gtk/Toy.hs view

@@ -0,0 +1,235 @@+{-# LANGUAGE TupleSections, ViewPatterns #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.Gtk.Toy+-- Copyright   :  (c) 2011 Michael Sloan +-- License     :  BSD-style (see the LICENSE file)+-- Maintainer  :  Michael Sloan <mgsloan@gmail.com>+-- Stability   :  experimental+-- Portability :  GHC only+--+-- The Gtk Toy Framework is an interface over Gtk for creating applications+-- which draw things and use the mouse or keyboard.+--+-- It handles the minutiae of setting up the Gtk window and canvas, and+-- processes mouse and keyboard inputs into more palatable data structures.+-----------------------------------------------------------------------------+module Graphics.UI.Gtk.Toy+  (+    KeyInfo, KeyTable, InputState(..), Interactive(..)+  , runToy, quitToy++  -- * InputState Accessors+  , keyInfo, keyHeld, mouseHeld++  -- * Utilities+  -- | Functions to allow for writing simpler, pure implementations of the+  --   different members of Interactive.+  , simpleTick, simpleDisplay, simpleMouse, simpleKeyboard+  , quitKeyboard++  ) where++import Control.Monad (when)+import Data.IORef+import qualified Data.Map as M+import qualified Graphics.UI.Gtk as G+import qualified Graphics.UI.Gtk.Gdk.Events as E++-- | Information about the most recent key-state transition.+--   The tuple contains whether the button was pressed, @True@, or released, @False,+--   at what time in msec, with which GTK modifiers.+type KeyInfo = (Bool, Int, [G.Modifier])++-- | A map of GTK keynames to last-received event regarding each respective+--   key.  This can be interpreted as the current keyboard state - a key is+--   down if it was last seen being pressed.+type KeyTable = M.Map String KeyInfo++data InputState = InputState +  { mousePos :: (Double, Double) -- ^ The most recent mouse position+  , keyTable :: KeyTable         -- ^ Map from key-name to most recent event+  }++-- | A KeyEvent tuple specifies whether the key was pressed or not, and+--   which key was pressed.  @(Right Char)@ is yielded for keys which would+--   normally correspond to character insertions, while @(Left String) provides+--   GTK-convention names for the rest.+type KeyEvent = (Bool, Either String Char)++-- | A MouseEvent is @Nothing@ if it's a mouse motion event, and otherwise+--   provides mouse press information.+type MouseEvent = Maybe (Bool, Int)++-- | A class for things which can be drawn and change within an interactive+--   context.  The default method implementations do nothing.+class Interactive a where++  -- | @tick@ is (ideally) called every 30ms.  The bool result indicates if the+  --   graphics need to be refreshed.+  tick                     :: InputState -> a -> IO (a, Bool)++  -- | @display@ is called when the rendering needs to be refreshed.+  display  :: G.DrawWindow -> InputState -> a -> IO a++  -- | @mouse@ is called when the mouse moves or presses occur.+  mouse    :: MouseEvent   -> InputState -> a -> IO a++  -- | @keyboard@ is called on key-presses.  +  keyboard :: KeyEvent     -> InputState -> a -> IO a++  -- No-op defaults.+  tick _ = return . (, False)+  display  _ _ = return+  mouse    _ _ = return+  keyboard _ _ = return++-- InputState Queries.++-- | Gets the information for the most recent key event of the named key.  +keyInfo :: String -> InputState -> Maybe KeyInfo+keyInfo name = M.lookup name . keyTable++-- | Gets whether the named key is currently thought to be held down.+keyHeld :: String -> InputState -> Bool+keyHeld name (keyInfo name -> Just (True, _, _)) = True+keyHeld _ _ = False++-- | Postfixes "_L" and "_R" on the key name, and returns true if either of+--   those keys are being held. +eitherHeld :: String -> InputState -> Bool+eitherHeld key inp = (keyHeld (key ++ "_L") inp || keyHeld (key ++ "_R") inp)++-- | Yields whether the mouse button (1st parameter) is considered pressed+--   in the passed InputState.+mouseHeld :: Int -> InputState -> Bool+mouseHeld ix = keyHeld ("Mouse" ++ show ix)++-- | Converts a pure state transform to a function for Interactive 'tick'.+simpleTick :: (a -> a)+           -> InputState -> a -> IO (a, Bool)+simpleTick f _ = return . (, True) . f++-- | Converts a diagram projection to a function for Interactive 'display'.+simpleDisplay :: (G.DrawWindow -> a -> a)+              -> G.DrawWindow -> InputState -> a -> IO a+simpleDisplay f dw _ = return . f dw++-- | Converts a function which responds to mouse-presses, and transforms state+--   accordingly to a function for Interactive 'mouse'.+simpleMouse :: (MouseEvent -> (Double, Double) -> a -> a)+            -> (MouseEvent -> InputState -> a -> IO a)+simpleMouse f c inp = return . f c (mousePos inp)++-- | Converts a function which responds to mouse-presses, and transforms state+--   accordingly to a function for Interactive 'mouse'.+simpleMouseClick :: ((Bool, Int) -> (Double, Double) -> a -> a)+                 -> (MouseEvent -> InputState -> a -> IO a)+simpleMouseClick f (Just c) inp = return . f c (mousePos inp)+simpleMouseClick _ _ _ = return++simpleMousePos :: ((Double, Double) -> a -> a)+               -> (MouseEvent -> InputState -> a -> IO a)+simpleMousePos f _ inp = return . f (mousePos inp)++-- | Converts a function which responds to key-presses, and transforms state+--   accordingly to a function for Interactive 'keyboard'.+simpleKeyboard :: (KeyEvent -> a -> a)+               -> (KeyEvent -> InputState -> a -> IO a)+simpleKeyboard f e _ = return . f e++-- | A definition for the keyboard handler that just calls "quitToy" when+--   Escape is pressed.+quitKeyboard :: KeyEvent -> InputState -> a -> IO a+quitKeyboard (True, (Left "Escape")) _ x = quitToy >> return x+quitKeyboard _ _ x = return x++-- | Like it says on the can.  This is a synonym for 'Graphics.UI.Gtk.mainQuit'+quitToy :: IO ()+quitToy = G.mainQuit++-- | Main program entrypoint. This is how you turn an instance of Interactive+--   into an application.+runToy :: Interactive a => a -> IO ()+runToy toy = do+  G.initGUI++  window <- G.windowNew+  canvas <- G.drawingAreaNew+  state <- newIORef (InputState (0, 0) M.empty, toy)++  let doRedraw = G.widgetQueueDraw canvas >> return True+  G.windowSetDefaultSize window 640 480++  G.onKeyPress   window $ (>> doRedraw) . handleKey state+  G.onKeyRelease window $ (>> doRedraw) . handleKey state++  G.onMotionNotify  window True $ (>> doRedraw) . handleMotion state+  G.onButtonPress   window      $ (>> doRedraw) . handleButton state+  G.onButtonRelease window      $ (>> doRedraw) . handleButton state++  G.onExposeRect canvas $ \(G.Rectangle x y w h) -> do+    let r = ((x, y), (x + w, y + h))+    dw <- G.widgetGetDrawWindow canvas+    sz <- G.widgetGetSize canvas+    (inp, x) <- readIORef state+    x' <- display dw inp x+    writeIORef state (inp, x')++  G.set window $ [G.containerChild G.:= canvas]+  G.widgetShowAll window++  let tickHandler = do+        st@(inp, _) <- readIORef state+        (state', redraw) <- uncurry tick st+        when redraw (doRedraw >> return ())+        writeIORef state (inp, state')+        return True+  +  G.timeoutAddFull tickHandler G.priorityDefaultIdle 30++  G.mainGUI+ where++handleKey :: Interactive a => IORef (InputState, a) -> E.Event -> IO ()+handleKey st ev = do+  (InputState p m, x) <- readIORef st+  let inp' = InputState p (M.insert name (pres, time, mods) m)+  x' <- keyboard (pres, maybe (Left name) Right char) inp' x+  writeIORef st (inp', x')+ where+  name = E.eventKeyName ev+  char = E.eventKeyChar ev+  time = fromIntegral $ E.eventTime ev+  mods = E.eventModifier ev+  pres = not $ E.eventRelease ev++handleMotion :: Interactive a => IORef (InputState, a) -> E.Event -> IO ()+handleMotion st ev = do+  (InputState p m, x) <- readIORef st+  let inp' = InputState pos m+  x' <- mouse Nothing inp' x+  writeIORef st (inp', x')+ where+  pos = (E.eventX ev, E.eventY ev)++handleButton :: Interactive a => IORef (InputState, a) -> E.Event -> IO ()+handleButton st ev = do+  when (click == E.SingleClick || click == E.ReleaseClick) $ do+    (InputState p m, x) <- readIORef st+    let m' = M.insert ("Mouse" ++ show but) (pressed, time, mods) m+        inp' = InputState pos m'+    x' <- mouse (Just (pressed, but)) inp' x+    writeIORef st (inp', x')+ where+  pos = (E.eventX ev, E.eventY ev)+  time = fromIntegral $ E.eventTime ev+  mods = E.eventModifier ev+  click = E.eventClick ev+  pressed = click /= E.ReleaseClick+  but = case E.eventButton ev of+    E.LeftButton -> 0+    E.RightButton -> 1+    E.MiddleButton -> 2+--TODO: guaranteed to not be 0,1,2?+    E.OtherButton ix -> ix