diff --git a/GLFW-task.cabal b/GLFW-task.cabal new file mode 100644 --- /dev/null +++ b/GLFW-task.cabal @@ -0,0 +1,36 @@ +name: GLFW-task +version: 0.1.0 +homepage: http://github.com/ninegua/GLFW-task +author: Paul Liu +maintainer: Paul Liu +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 diff --git a/Graphics/UI/GLFW/Task.hs b/Graphics/UI/GLFW/Task.hs new file mode 100644 --- /dev/null +++ b/Graphics/UI/GLFW/Task.hs @@ -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) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2012 Paul H. Liu + +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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/example/example.lhs b/example/example.lhs new file mode 100644 --- /dev/null +++ b/example/example.lhs @@ -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} +