GLFW-task (empty) → 0.1.0

raw patch · 6 files changed

+266/−0 lines, 6 filesdep +GLFWdep +OpenGLdep +basesetup-changed

Dependencies added: GLFW, OpenGL, base, monad-task, transformers

Files

GLFW-task.cabal +36/−0
Graphics/UI/GLFW/Task.hs +109/−0
LICENSE +20/−0
README.md +8/−0
Setup.hs +2/−0
example/example.lhs +91/−0

+ GLFW-task.cabal view

@@ -0,0 +1,36 @@+name:          GLFW-task+version:       0.1.0+homepage:      http://github.com/ninegua/GLFW-task+author:        Paul Liu +maintainer:    Paul Liu <paul@thev.net>+stability:     experimental+category:      Graphics+cabal-version: >= 1.6+build-type:    Simple+synopsis:      GLFW utility functions for use with monad-task.+description:   GLFW (http://hackage.haskell.org/package/GLFW) is a Haskell +               binding to the GLFW C library for writing OpenGL programs. +               This package provides some utility functions for writing GLFW +               programs using the monad-task library +               (http://hackage.haskell.org/package/GLFW-task). +license:       BSD3+license-file:  LICENSE++extra-source-files:+  README.md+  example/example.lhs++library+  build-depends:+    base       >= 3     && < 5,+    OpenGL     >= 2.1   && < 3,+    GLFW       == 0.5.*,+    monad-task == 0.*,+    transformers < 4+    +  exposed-modules:+    Graphics.UI.GLFW.Task++source-repository head+  type:     git+  location: git://github.com/ninegua/GLFW-task

+ Graphics/UI/GLFW/Task.hs view

@@ -0,0 +1,109 @@+{- | GLFW helper functions for use with a @`TaskT`@ monad transformer (from monad-task package).+-}+{-# LANGUAGE FlexibleContexts, TupleSections #-}+module Graphics.UI.GLFW.Task +  (+    Event(..)+  , or+  , onKey+  , onChar+  , onButton+  , onPos+  , onWheel+  , onSize+  , onClose+  , onRefresh+  , isKey+  , isChar+  , isButton+  , isPress+  , isRelease+  , registerTaskCallbacks+  ) where++import Control.Concurrent+import Graphics.UI.GLFW +import qualified Graphics.Rendering.OpenGL as GL+import Graphics.Rendering.OpenGL (($=))+import Control.Monad.IO.Class +import Control.Monad.Task.Class ++-- | @Event@ is a unified data type for all GLFW events.+data Event +  = KeyEvent Key KeyButtonState+  | CharEvent Char KeyButtonState+  | MouseButtonEvent MouseButton KeyButtonState+  | MousePosEvent GL.Position +  | MouseWheelEvent Int+  | WindowSizeEvent GL.Size +  | WindowCloseEvent +  | WindowRefreshEvent+  deriving (Eq, Show)+++onKey     :: Event -> Maybe (Key, KeyButtonState)+onKey     (KeyEvent k s)         = Just (k, s)+onKey     _                      = Nothing+onChar    :: Event -> Maybe (Char, KeyButtonState)+onChar    (CharEvent ch s)       = Just (ch, s)+onChar    _                      = Nothing+onButton  :: Event -> Maybe (MouseButton, KeyButtonState)+onButton  (MouseButtonEvent b s) = Just (b, s)+onButton  _                      = Nothing+onPos     :: Event -> Maybe GL.Position+onPos     (MousePosEvent p)      = Just p+onPos     _                      = Nothing+onWheel   :: Event -> Maybe Int+onWheel   (MouseWheelEvent w)    = Just w+onWheel   _                      = Nothing+onSize    :: Event -> Maybe GL.Size+onSize    (WindowSizeEvent s)    = Just s+onSize    _                      = Nothing+onClose   :: Event -> Maybe ()+onClose   WindowCloseEvent       = Just ()+onClose   _                      = Nothing+onRefresh :: Event -> Maybe ()+onRefresh WindowRefreshEvent     = Just ()+onRefresh _                      = Nothing++isKey :: Enum a => a -> Key -> Maybe ()+isKey key k | fromEnum k == fromEnum key = Just ()+            | otherwise                  = Nothing++isChar :: Char -> Char -> Maybe ()+isChar ch c | ch == c   = Just ()+            | otherwise = Nothing++isButton :: MouseButton -> (MouseButton, KeyButtonState) -> Maybe KeyButtonState+isButton but (b, s) | b == but  = Just s+                    | otherwise = Nothing++isPress, isRelease :: (a, KeyButtonState) -> Maybe a+isPress   (b, s) | s == Press   = Just b +                 | otherwise    = Nothing++isRelease (b, s) | s == Release = Just b +                 | otherwise    = Nothing++-- | @registerTaskCallbacks@ sets up all event callbacks, and returns a +--   'Graphics.UI.GLFW.waitEvent' equivalent function for task monad,+--   which must be called repeatedly in order to pump events to other +--   task co-routines.+--+--   These task co-routines should use 'Control.Monad.Task.Class.watch' +--   to select event of interest, and they should be forked prior to+--   the waitEvent call.+registerTaskCallbacks :: (MonadIO m, MonadTask Event m) => IO (m ())+registerTaskCallbacks = do+  q <- newMVar []+  let enqueue = modifyMVar_ q . (return .) . (:)+      dequeue = modifyMVar q $ return . ([],)+  windowRefreshCallback $= enqueue WindowRefreshEvent+  windowSizeCallback    $= enqueue . WindowSizeEvent+  windowCloseCallback   $= (enqueue WindowCloseEvent >> return True)+  keyCallback           $= (enqueue .) . KeyEvent+  charCallback          $= (enqueue .) . CharEvent+  mouseButtonCallback   $= (enqueue .) . MouseButtonEvent+  mousePosCallback      $= enqueue . MousePosEvent+  mouseWheelCallback    $= enqueue . MouseWheelEvent+  return (liftIO (waitEvents >> dequeue) >>= mapM_ signal . reverse)

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2012 Paul H. Liu <paul@thev.net>++This software is provided 'as-is', without any express or implied+warranty. In no event will the authors be held liable for any damages+arising from the use of this software.++Permission is granted to anyone to use this software for any purpose,+including commercial applications, and to alter it and redistribute it+freely, subject to the following restrictions:++1. The origin of this software must not be misrepresented; you must not+   claim that you wrote the original software. If you use this software+   in a product, an acknowledgment in the product documentation would+   be appreciated but is not required.++2. Altered source versions must be plainly marked as such, and must not+   be misrepresented as being the original software.++3. This notice may not be removed or altered from any source+   distribution.

+ README.md view

@@ -0,0 +1,8 @@+GLFW-task+=========++GLFW utility functions for use with monad-task.++See [Invert the Inversion of Control](http://www.thev.net/PaulLiu/invert-inversion.html)+for a tutorial on writing a GLFW/OpenGL application using task monad.+

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ example/example.lhs view

@@ -0,0 +1,91 @@+This program is adapted from GLFW/example/example.hs to use monad-control library, and is identital to the code from the tutorial [Invert the Inversion of Control](http://www.thev.net/PaulLiu/invert-inversion.html), which has more details. ++To demonstrate the usage of GLFW for OpenGL based Haskell applications, here is a sample program that allows user to draw lines by holding the left mouse button and move the mouse.++\begin{code}+import qualified Graphics.Rendering.OpenGL as GL+import qualified Graphics.UI.GLFW as GLFW+import Graphics.UI.GLFW.Task+import Graphics.Rendering.OpenGL (($=))+import Control.Monad.Task+import Control.Monad.IO.Class+import Control.Monad.State+import Control.Monad+import Prelude hiding (lines)++main = do+  GLFW.initialize+  -- open window+  GLFW.openWindow (GL.Size 400 400) [GLFW.DisplayAlphaBits 8] GLFW.Window+  GLFW.windowTitle $= "GLFW Demo"+  GL.shadeModel    $= GL.Smooth+  -- enable antialiasing+  GL.lineSmooth $= GL.Enabled+  GL.blend      $= GL.Enabled+  GL.blendFunc  $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)+  GL.lineWidth  $= 1.5+  -- set the color to clear background+  GL.clearColor $= GL.Color4 0 0 0 0+  -- run the main app+  lineTask+  -- finish up+  GLFW.closeWindow+  GLFW.terminate++set2DViewport size@(GL.Size w h) = do+  GL.viewport   $= (GL.Position 0 0, size)+  GL.matrixMode $= GL.Projection+  GL.loadIdentity+  GL.ortho2D 0 (realToFrac w) (realToFrac h) 0++type Lines = [(GL.GLint, GL.GLint)]++drawLines :: Lines -> IO ()+drawLines lines = do+  GL.clear [GL.ColorBuffer]+  GL.color $ GL.Color3 1 0 (0::GL.GLdouble)+  GL.renderPrimitive GL.Lines $ mapM_ +    (\ (x, y) -> GL.vertex (GL.Vertex3 (fromIntegral x) +                                       (fromIntegral y) +                                       (0::GL.GLdouble))) lines++data S = S { lines :: Lines, dirty :: Bool }+type M a = TaskT Event (StateT S IO) a++getLines      = fmap lines get+modifyLines f = modify $ \x -> x { lines = f (lines x), dirty = True }+getDirty      = fmap dirty get+putDirty y    = modify $ \x -> x { dirty = y }++repeatUntil f m = loop+  where loop = m >> watch Just >>= maybe loop return . f++buttonPress   = onButton >=> isPress+buttonRelease = onButton >=> isRelease+isESC = onKey >=> isPress >=> isKey GLFW.ESC ++lineTask :: IO ()+lineTask = (`evalStateT` (S [] False)) . runTask $ do+  -- here the monad is of type M ()+  waitForEvents <- liftIO registerTaskCallbacks+  fork $ forever $ watch onSize >>= liftIO . set2DViewport+  fork $ forever $ watch onClose >> exit+  fork $ forever $ watch onRefresh >> putDirty True+  fork $ forever $ watch isESC >> exit+  fork $ forever $ interaction+  forever $ do+    waitForEvents+    d <- getDirty+    when d $ getLines >>= liftIO . drawLines >> liftIO GLFW.swapBuffers+    putDirty False+    yield+  where+    interaction = do+      watch buttonPress+      (GL.Position x y) <- liftIO $ GL.get GLFW.mousePos+      modifyLines (((x,y):) . ((x,y):)) +      repeatUntil buttonRelease $ do+        (GL.Position x y) <- liftIO $ GL.get GLFW.mousePos+        modifyLines (((x,y):) . tail) +\end{code}+