packages feed

graphics-drawingcombinators 0.43 → 1.0.0

raw patch · 3 files changed

+250/−238 lines, 3 files

Files

Graphics/DrawingCombinators.hs view
@@ -1,10 +1,8 @@-{-# LANGUAGE GADTs, RankNTypes #-}- -------------------------------------------------------------- -- |  -- Module      : Graphics.DrawingCombinators--- Copyright   : (c) Luke Palmer 2008--- License     : LGPL+-- Copyright   : (c) Luke Palmer 2008-2010+-- License     : BSD3 -- -- Maintainer  : Luke Palmer <lrpalmer@gmail.com> -- Stability   : experimental@@ -19,26 +17,25 @@ -- -- It is recommended that you use this module in combination -- with SDL; it has not been tested in any other environments.--- For some reason the selection stuff ("selectRegion", "click")--- crashes GHCi, but it works okay compiled.+-- For some reason the GL picking stuff ('sample') crashes GHCi, +-- but it works okay compiled. --------------------------------------------------------------  module Graphics.DrawingCombinators     (+      module Graphics.DrawingCombinators.Affine     -- * Basic types-      Draw, runDrawing, draw, Vec2+    , Image, render, clearRender     -- * Selection-    , selectRegion, click-    -- * Combinators-    , over, overlay, empty+    , sample     -- * Initialization     , init-    -- * Geometric Primitives-    , point, line, regularPoly, circle, convexPoly-    -- * Transformations-    , translate, rotate, scale-    -- * Colors -    , Color, color, colorFunc+    -- * Geometry+    -- +    -- $geometry+    , point, line, regularPoly, circle, convexPoly, (%%)+    -- * Colors+    , Color(..), modulate, tint     -- * Sprites (images from files)     , Sprite, SpriteScaling(..), surfaceToSprite, imageToSprite, sprite     -- * Text@@ -47,137 +44,103 @@ where  import Prelude hiding (init)-import Data.Monoid-import Control.Monad-import Control.Monad.Reader+import Graphics.DrawingCombinators.Affine+import Control.Applicative (Applicative(..), liftA2, (*>))+import Control.Monad (when, forM_)+import Data.Monoid (Monoid(..), Any(..))+import System.Mem.Weak (addFinalizer)+import qualified Data.Set as Set import qualified Graphics.Rendering.OpenGL.GL as GL import qualified Graphics.Rendering.OpenGL.GLU as GLU import qualified Graphics.UI.SDL as SDL import qualified Graphics.UI.SDL.Image as Image import qualified Graphics.UI.SDL.TTF as TTF-import System.Mem.Weak-import Data.IORef -import System.IO.Unsafe-import qualified Data.Set as Set-import Debug.Trace+import Data.IORef (IORef, newIORef, atomicModifyIORef)+import System.IO.Unsafe (unsafePerformIO)  -- for hacking around OpenGL bug :-( -type Vec2 = (Double,Double)-type Color = (Double,Double,Double,Double)+type Renderer = Affine -> Color -> IO ()+type Picker a = Affine -> GL.GLuint -> IO (GL.GLuint, Set.Set GL.GLuint -> a) -type DrawM a = ReaderT DrawCxt IO a+-- | The type of images.+--+-- > [[Image a]] = R2 -> (Color, a)+data Image a = Image { dRender :: Renderer+                     , dPick   :: Picker a+                     } --- | @Draw a@ represents a drawing which returns a value of type--- a when selected.-data Draw a where-    DrawGL      :: DrawM () -> Draw ()-    TransformGL :: (forall x. DrawM x -> DrawM x) -> Draw a -> Draw a-    Empty       :: Draw a-    Over        :: (a -> a -> a) -> Draw a -> Draw a -> Draw a-    FMap        :: (a -> b) -> Draw a -> Draw b+instance Functor Image where+    fmap f d = Image { +        dRender = dRender d,+        dPick = (fmap.fmap.fmap.fmap.fmap) f (dPick d)+      } --- |Draw a Drawing on the screen in the current OpenGL coordinate+instance Applicative Image where+    pure x = Image { +        dRender = (pure.pure.pure) (),+        dPick = \tr z -> pure (z, const x)+      }+    +    df <*> dx = Image {+        -- reversed so that things that come first go on top+        dRender = (liftA2.liftA2) (*>) (dRender dx) (dRender df),+        dPick = \tr z -> do+            (z', m') <- dPick dx tr z+            (z'', m) <- dPick df tr z'+            return (z'', m <*> m')+      }++instance (Monoid m) => Monoid (Image m) where+    mempty = pure mempty+    mappend = liftA2 mappend++-- |Draw an Image on the screen in the current OpenGL coordinate -- system (which, in absense of information, is (-1,-1) in the -- lower left and (1,1) in the upper right).-runDrawing :: Draw a -> IO ()-runDrawing d = runReaderT (run' d) initDrawCxt-    where-    run' :: Draw a -> DrawM ()-    run' (DrawGL m) = m-    run' (TransformGL f m) = f (run' m)-    run' Empty = return ()-    run' (Over f a b) = run' b >> run' a-    run' (FMap f d) = run' d---- |Like runDrawing, but clears the screen first, and sets up--- a little necessary OpenGL state.  This is so--- you can use this module and pretend that OpenGL doesn't--- exist at all.-draw :: Draw a -> IO ()-draw d = do-    GL.clear [GL.ColorBuffer]+render :: Image a -> IO ()+render d = do     GL.preservingAttrib [GL.AllServerAttributes] $ do         GL.texture GL.Texture2D GL.$= GL.Enabled         GL.blend GL.$= GL.Enabled         GL.blendFunc GL.$= (GL.SrcAlpha, GL.OneMinusSrcAlpha)-        runDrawing d+        GL.depthFunc GL.$= Nothing+        dRender d identity mempty +-- |Like @render@, but clears the screen first. This is so+-- you can use this module and pretend that OpenGL doesn't+-- exist at all.+clearRender :: Image a -> IO ()+clearRender d = do+    GL.clear [GL.ColorBuffer]+    render d+ -- | Given a bounding box, lower left and upper right in the default coordinate -- system (-1,-1) to (1,1), return the topmost drawing's value (with respect to -- @`over`@) intersecting that bounding box.-selectRegion :: Vec2 -> Vec2 -> Draw a -> IO (Maybe a)+selectRegion :: R2 -> R2 -> Image a -> IO a selectRegion ll ur drawing = do-    ((), recs) <- GL.getHitRecords 64 $ do -- XXX hard coded crap+    (lookup, recs) <- GL.getHitRecords 64 $ do -- XXX hard coded crap         GL.preservingMatrix $ do-            GLU.ortho2D (convReal $ fst ll) (convReal $ fst ur) (convReal $ snd ll) (convReal $ snd ur)-            runReaderT (draw' 0 drawing) initDrawCxt-            return ()+            GLU.ortho2D (fst ll) (fst ur) (snd ll) (snd ur)+            (_, lookup) <- dPick drawing identity 0+            return lookup     let nameList = concatMap (\(GL.HitRecord _ _ ns) -> ns) (maybe [] id recs)     let nameSet  = Set.fromList $ map (\(GL.Name n) -> n) nameList-    return $ fst $ lookupName 0 nameSet drawing-    where-    draw' :: GL.GLuint -> Draw a -> DrawM GL.GLuint-    draw' n (DrawGL m) = do-        r <- ask-        lift $ GL.withName (GL.Name n) $ runReaderT m r-        return $! n+1-    draw' n (TransformGL f m) = f (draw' n m)-    draw' n Empty = return n-    draw' n (Over f a b) = do-        n' <- draw' n b-        draw' n' a-    draw' n (FMap f d) = draw' n d-    -    lookupName :: GL.GLuint -> Set.Set GL.GLuint -> Draw a -> (Maybe a, GL.GLuint)-    lookupName n names (DrawGL m)-        | n `Set.member` names = (Just (), n + 1)-        | otherwise            = (Nothing, n + 1)-    lookupName n names (TransformGL _ m) = lookupName n names m-    lookupName n names Empty = (Nothing, n)-    lookupName n names (Over f a b) =-        let (lb, n')  = lookupName n  names b-            (la, n'') = lookupName n' names a-        in (joinMaybes f la lb, n'')-    lookupName n names (FMap f d) = -        let (l, n') = lookupName n names d-        in (fmap f l, n')--joinMaybes :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a-joinMaybes f Nothing x = x-joinMaybes f x Nothing = x-joinMaybes f (Just x) (Just y) = Just (f x y)+    return $ lookup nameSet -click :: Vec2 -> Draw a -> IO (Maybe a)-click (px,py) = selectRegion (px-e,py-e) (px+e,py+e)+-- | Sample the value of the image at a point.  +--+-- > [[sample p i]] = snd ([[i]] [[p]])+sample :: R2 -> Image a -> IO a+sample (px,py) = selectRegion (px-e,py-e) (px+e,py+e)     where     e = 1/1024 -data DrawCxt -    = DrawCxt { colorTrans :: Color -> Color } -initDrawCxt = DrawCxt { colorTrans = id }--over :: Draw a -> Draw a -> Draw a-over = overlay const--overlay :: (a -> a -> a) -> Draw a -> Draw a -> Draw a-overlay = Over--empty :: Draw a-empty = Empty--instance Functor Draw where-    fmap = FMap--instance (Monoid a) => Monoid (Draw a) where-    mempty = empty-    mappend = overlay mappend-- {----------------   Initialization ----------------} --- |Perform initialization of the library.  This can fail.+-- |Perform initialization of the library.  This can throw an exception. init :: IO () init = do     wasinit <- TTF.wasInit@@ -186,121 +149,158 @@         when (not success) $ fail "SDL_ttf initialization failed"  -convReal :: Double -> GL.GLdouble-convReal = realToFrac  {-----------------  Geometric Primitives+  Geometry -----------------} --- | Draw a single pixel at the specified point.-point :: Vec2 -> Draw ()-point (ax,ay) = DrawGL $ lift $-    GL.renderPrimitive GL.Points $-        GL.vertex $ GL.Vertex2 (convReal ax) (convReal ay)+-- $geometry+-- The geomertic combinators all return an 'Image' 'Any'.  'Any'+-- is a wrapper around 'Bool' with @(False, (||))@ as its 'Monoid'.+-- This is so you can use the 'Monoid' instance on 'Image' to+-- automatically get the union of primitives.  So:+--+-- > circle `mappend` (translate (1,0) %% circle)+--+-- Will have the value @Any True@ when /either/ of the circles is+-- sampled.  To extract the Bool, use 'getAny', or pattern match+-- on @Any True@ and @Any False@ instead of @True@ and @False@. --- | Draw a line connecting the two given points.-line :: Vec2 -> Vec2 -> Draw ()-line (ax,ay) (bx,by) = DrawGL $ lift $ -    GL.renderPrimitive GL.Lines $ do-        GL.vertex $ GL.Vertex2 (convReal ax) (convReal ay)-        GL.vertex $ GL.Vertex2 (convReal bx) (convReal by)+toVertex :: Affine -> R2 -> GL.Vertex2 GL.GLdouble+toVertex tr p = let (x,y) = tr `apply` p in GL.Vertex2 x y --- | Draw a regular polygon centered at the origin with n sides.-regularPoly :: Int -> Draw ()-regularPoly n = DrawGL $ lift $ do-    let scaler = 2 * pi / fromIntegral n :: Double-    GL.renderPrimitive GL.TriangleFan $ do-        GL.vertex $ (GL.Vertex2 0 0 :: GL.Vertex2 GL.GLdouble)-        forM_ [0..n] $ \s -> do-            let theta = convReal (scaler * fromIntegral s)-            GL.vertex $ GL.Vertex2 (cos theta) (sin theta)+inSet :: (Ord a) => a -> Set.Set a -> Any+inSet x s = Any (x `Set.member` s) --- | Draw a unit circle centered at the origin.  This is equivalent--- to @regularPoly 24@.-circle :: Draw ()+picker :: Renderer -> Picker Any+picker r tr z = z `seq` do+    GL.withName (GL.Name z) (r tr mempty)+    return (z+1, inSet z)++-- | A single pixel at the specified point.+--+-- > [[point p]] r | [[r]] == [[p]] = (one, Any True) +-- >               | otherwise      = (zero, Any False)+point :: R2 -> Image Any+point p = Image render (picker render)+    where+    render tr col = GL.renderPrimitive GL.Points . GL.vertex $ toVertex tr p++-- | A line connecting the two given points.+line :: R2 -> R2 -> Image Any+line src dest = Image render (picker render)+    where+    render tr col = +        GL.renderPrimitive GL.Lines $ do+            GL.vertex $ toVertex tr src+            GL.vertex $ toVertex tr dest+        ++-- | A regular polygon centered at the origin with n sides.+regularPoly :: Int -> Image Any+regularPoly n = Image render (picker render)+    where+    render tr col = do+        let scaler = 2 * pi / fromIntegral n+        GL.renderPrimitive GL.TriangleFan $ do+            GL.vertex $ toVertex tr (0,0)+            forM_ [0..n] $ \s -> do+                let theta = scaler * fromIntegral s+                GL.vertex $ toVertex tr (cos theta, sin theta)++-- | An (imperfect) unit circle centered at the origin.  Implemented as:+--+-- > circle = regularPoly 24+circle :: Image Any circle = regularPoly 24 --- | Draw a convex polygon given by the list of points.-convexPoly :: [Vec2] -> Draw ()-convexPoly points = DrawGL $ lift $ do-    GL.renderPrimitive GL.Polygon $ do-        forM_ points $ \(x,y) -> do-            GL.vertex $ GL.Vertex2 (convReal x) (convReal y)+-- | A convex polygon given by the list of points.+convexPoly :: [R2] -> Image Any+convexPoly points = Image render (picker render)+    where+    render tr col = +        GL.renderPrimitive GL.Polygon $ +            mapM_ (GL.vertex . toVertex tr) points  {-----------------   Transformations ------------------} --- | Translate the given drawing by the given amount.-translate :: Vec2 -> Draw a -> Draw a-translate (byx,byy) = TransformGL $ -    cong (lift $ GL.translate (GL.Vector3 (convReal byx) (convReal byy) 0))-         (lift $ GL.translate (GL.Vector3 (-convReal byx) (-convReal byy) 0))+infixr 1 %% --- | Rotate the given drawing counterclockwise by the--- given number of radians.-rotate :: Double -> Draw a -> Draw a-rotate rad = TransformGL $ -    cong (lift $ GL.rotate theta (GL.Vector3 0 0 1))-         (lift $ GL.rotate (-theta) (GL.Vector3 0 0 1))-  where-    theta = 180 * convReal rad / pi+-- | Transform an image by an 'Affine' transformation.+--+-- > [[tr % im]] = [[im]] . inverse [[tr]]+(%%) :: Affine -> Image a -> Image a+tr' %% d = Image render pick+    where+    render tr col = dRender d (tr' `compose` tr) col+    pick tr z = dPick d (tr' `compose` tr) z --- | @scale x y d@ scales @d@ by a factor of @x@ in the--- horizontal direction and @y@ in the vertical direction.-scale :: Double -> Double -> Draw a -> Draw a-scale x y = TransformGL $ -    cong (lift $ GL.scale (convReal x) (convReal y) 1)-         (lift $ GL.scale (1/convReal x) (1/convReal y) 1) -cong :: (Monad m) => m () -> m () -> m a -> m a-cong ma mb mx = do-    ma-    x <- mx-    mb-    return x- {------------   Colors -------------} --- | @colorFunc f d@ modifies all colors appearing in @d@ with--- the function @f@.  For example:+-- | Color is defined in the usual computer graphics sense, of +-- a 4 vector containing red, green, blue, and alpha. ----- > colorFunc (\(r,g,b,a) -> (r,g,b,a/2)) d+-- The Monoid instance is given by alpha transparency blending,+-- so: ----- Will draw d at greater transparency, regardless of the calls--- to color within.-colorFunc :: (Color -> Color) -> Draw a -> Draw a-colorFunc cf = TransformGL $ \d -> do-    r <- ask-    let trans    = colorTrans r-        newtrans = trans . cf-        oldcolor = trans (1,1,1,1)-        newcolor = newtrans (1,1,1,1)-    setColor newcolor-    result <- local (const (r { colorTrans = newtrans })) d-    setColor oldcolor-    return result-    where-    setColor (r,g,b,a) = lift $ GL.color $ GL.Color4 (convReal r) (convReal g) (convReal b) (convReal a)+-- > mempty = Color 1 1 1 1+-- > mappend c@(Color _ _ _ a) c'@(Color _ _ _ a') = a*c + (1-a)*c'+--+-- Where multiplication is componentwise.  In the semantcs the+-- values @zero@ and @one@ are used, which are defined as:+--+-- > zero = Color 0 0 0 0+-- > one = Color 1 1 1 1+data Color = Color R R R R --- | @color c d@ sets the color of the drawing to exactly @c@.-color :: Color -> Draw a -> Draw a-color c = colorFunc (const c)+instance Monoid Color where+    mempty = Color 1 1 1 1+    mappend (Color r g b a) (Color r' g' b' a') = Color (i r r') (i g g') (i b b') (i a a')+        where+        i x y = a*x + (1-a)*y +-- | Modulate two colors by each other.+--+-- > modulate (Color r g b a) (Color r' g' b' a') +-- >           = Color (r*r') (g*g') (b*b') (a*a')+modulate :: Color -> Color -> Color+modulate (Color r g b a) (Color r' g' b' a') = Color (r*r') (g*g') (b*b') (a*a') +-- | Tint an image by a color; i.e. modulate the colors of an image by +-- a color.+--+-- > [[tint c im]] = first (modulate c) . [[im]]+-- >    where first f (x,y) = (f x, y)+tint :: Color -> Image a -> Image a+tint c d = Image render (dPick d)+    where+    render tr col = do+        let oldColor = col+            newColor = modulate c col+        setColor newColor+        result <- dRender d tr newColor+        setColor oldColor+        return result+    setColor (Color r g b a) = GL.color $ GL.Color4 r g b a++ {-------------------------   Sprites (bitmap images) -------------------------} --- | A sprite represents a bitmap image.+-- | A Sprite represents a bitmap image.+--+-- > [[Sprite]] = [-1,1]^2 -> Color data Sprite = Sprite { spriteObject :: GL.TextureObject-                     , spriteWidthRat :: Double-                     , spriteHeightRat :: Double-                     , spriteWidth :: Double-                     , spriteHeight :: Double+                     , spriteWidthRat :: R+                     , spriteHeightRat :: R+                     , spriteWidth :: R+                     , spriteHeight :: R                      }  -- FUUUUUUUUUCKKK Why doesn't glGenTextures work!!??@@ -322,9 +322,9 @@ freeTexture :: GL.TextureObject -> IO () freeTexture (GL.TextureObject b) = do     GL.deleteObjectNames [GL.TextureObject b]-    modifyIORef textureHack (b:)+    atomicModifyIORef textureHack (\xs -> (b:xs,())) --- | Indicate how a nonrectangular image is to be mapped to a sprite.+-- | Indicate how a non-square image is to be mapped to a sprite. data SpriteScaling     -- | ScaleMax will set the maximum of the height and width of the image to 1.     = ScaleMax    @@ -402,23 +402,28 @@ imageToSprite :: SpriteScaling -> FilePath -> IO Sprite imageToSprite scaling path = Image.load path >>= surfaceToSprite scaling --- | Draw a sprite at the origin.-sprite :: Sprite -> Draw ()-sprite spr = DrawGL $ liftIO $ do-    oldtex <- GL.get (GL.textureBinding GL.Texture2D)-    GL.textureBinding GL.Texture2D GL.$= (Just $ spriteObject spr)-    GL.renderPrimitive GL.Quads $ do-        let (xofs, yofs) = (convReal $ 0.5 * spriteWidth spr, convReal $ 0.5 * spriteHeight spr)-            (xrat, yrat) = (convReal $ spriteWidthRat spr, convReal $ spriteHeightRat spr)-        GL.texCoord $ GL.TexCoord2 0 (0 :: GL.GLdouble)-        GL.vertex   $ GL.Vertex2 (-xofs) yofs-        GL.texCoord $ GL.TexCoord2 xrat 0-        GL.vertex   $ GL.Vertex2 xofs yofs-        GL.texCoord $ GL.TexCoord2 xrat yrat-        GL.vertex   $ GL.Vertex2 xofs (-yofs)-        GL.texCoord $ GL.TexCoord2 0 yrat-        GL.vertex   $ GL.Vertex2 (-xofs) (-yofs)-    GL.textureBinding GL.Texture2D GL.$= oldtex+-- | The image of a sprite at the origin.+--+-- > [[sprite s]] p | p `elem` [-1,1]^2 = ([[s]] p, Any True) +-- >                | otherwise         = (zero, Any False)+sprite :: Sprite -> Image Any+sprite spr = Image render (picker render)+    where+    render tr colt = do+        oldtex <- GL.get (GL.textureBinding GL.Texture2D)+        GL.textureBinding GL.Texture2D GL.$= (Just $ spriteObject spr)+        GL.renderPrimitive GL.Quads $ do+            let (xofs, yofs) = (0.5 * spriteWidth spr, 0.5 * spriteHeight spr)+                (xrat, yrat) = (spriteWidthRat spr, spriteHeightRat spr)+            GL.texCoord $ GL.TexCoord2 0 (0 :: GL.GLdouble)+            GL.vertex   $ toVertex tr (-xofs, yofs)+            GL.texCoord $ GL.TexCoord2 xrat 0+            GL.vertex   $ toVertex tr (xofs, yofs)+            GL.texCoord $ GL.TexCoord2 xrat yrat+            GL.vertex   $ toVertex tr (xofs,-yofs)+            GL.texCoord $ GL.TexCoord2 0 yrat+            GL.vertex   $ toVertex tr (-xofs,-yofs)+        GL.textureBinding GL.Texture2D GL.$= oldtex  {---------  Text@@ -426,7 +431,8 @@  data Font = Font { getFont :: TTF.Font } --- | Load a TTF font from a file.+-- | Load a TTF font from a file with the given point size (higher numbers+-- mean smoother text but more expensive rendering). openFont :: String -> Int -> IO Font openFont path res = do     font <- TTF.openFont path res@@ -438,6 +444,7 @@     surf <- TTF.renderTextBlended (getFont font) str (SDL.Color 255 255 255)     surfaceToSprite ScaleHeight surf --- | Draw a string using a font.  The resulting string will have height 1.-text :: Font -> String -> Draw ()+-- | The image representing some text rendered with a font.  The resulting +-- string will have height 1.+text :: Font -> String -> Image Any text font str = sprite $ unsafePerformIO $ textSprite font str
example.hs view
@@ -10,42 +10,47 @@     SDL.init [SDL.InitTimer, SDL.InitVideo]     -- resolution & color depth     SDL.setVideoMode resX resY 32 [SDL.OpenGL]+    Draw.init     return () +textBox :: Draw.Color -> Draw.Font -> String -> Draw.Image (Maybe String)+textBox color font text = fmap (\(Any b) -> if b then Just text else Nothing) $+                            Draw.text font text+                                `mappend`+                            Draw.tint color (Draw.convexPoly [(1,1),(1,-1),(-1,-1),(-1,1)]) -box :: Draw.Draw ()-box = Draw.translate (0.0,0.2) -        $ Draw.scale 0.3 0.3 -        $ Draw.color (1,0,0,1) -        $ Draw.convexPoly-            [(1,1),(1,-1),(-1,-1),(-1,1)]+juxtapose :: (Monoid a) => Draw.Image a -> Draw.Image a -> Draw.Image a+juxtapose d1 d2 = (Draw.translate (-1,0) Draw.%% Draw.scale 0.5 1 Draw.%% d1)+                    `mappend`+                  (Draw.translate (1,0) Draw.%% Draw.scale 0.5 1 Draw.%% d2) -drawing = fmap (const "A") (Draw.color (0,0,1,1) box)-          `mappend`-          fmap (const "B") (Draw.translate (-0.1,0.2) box)+drawing :: Draw.Font -> Draw.Image (Maybe String)+drawing font = juxtapose (textBox (Draw.Color 1 0 0 1) font "A") +                         (textBox (Draw.Color 0 0 1 1) font "B")  main :: IO () main = do     initScreen-    Draw.draw drawing+    font <- Draw.openFont "font.ttf" 72+    Draw.clearRender (drawing font)     SDL.glSwapBuffers-    waitClicks+    waitClicks font     SDL.quit     return ()      where-    waitClicks = do+    waitClicks font = do         ev <- SDL.waitEvent         case ev of              SDL.Quit -> return ()              SDL.MouseButtonDown x y _ -> do                  let x' = 2*(fromIntegral x / fromIntegral resX) - 1                  let y' = 1 - 2*(fromIntegral y / fromIntegral resY)-                 hit <- Draw.click (x',y') drawing+                 hit <- Draw.sample (x',y') (drawing font)                  case hit of-                      Nothing -> waitClicks-                      Just xs -> putStrLn xs >> waitClicks-             _ -> waitClicks+                      Nothing   -> waitClicks font+                      Just str  -> putStrLn str >> waitClicks font+             _ -> waitClicks font  untilM :: (Monad m) => (a -> Bool) -> m a -> m a untilM f m = do
graphics-drawingcombinators.cabal view
@@ -4,7 +4,7 @@     have to go into the deep, dark world of imperative stateful     programming just to draw stuff.  It supports 2D only (for now),     with support drawing geometry, images, and text.-Version: 0.43+Version: 1.0.0 Stability: experimental Synopsis: A functional interface to 2D drawing in OpenGL License: BSD3