graphics-drawingcombinators 0.2 → 0.3

raw patch · 3 files changed

+45/−29 lines, 3 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Graphics/DrawingCombinators.hs +34/−23
• example.hs +8/−3
• graphics-drawingcombinators.cabal +3/−3

@@ -30,7 +30,7 @@     -- * Selection     , selectRegion, click     -- * Combinators-    , over, empty+    , over, overlay, empty     -- * Initialization     , init     -- * Geometric Primitives@@ -72,7 +72,7 @@     DrawGL      :: DrawM () -> Draw ()     TransformGL :: (forall x. DrawM x -> DrawM x) -> Draw a -> Draw a     Empty       :: Draw a-    Over        :: Draw a -> Draw a -> Draw a+    Over        :: (a -> a -> a) -> Draw a -> Draw a -> Draw a     FMap        :: (a -> b) -> Draw a -> Draw b  -- |Draw a Drawing on the screen in the current OpenGL coordinate@@ -85,7 +85,7 @@     run' (DrawGL m) = m     run' (TransformGL f m) = f (run' m)     run' Empty = return ()-    run' (Over a b) = run' b >> run' a+    run' (Over f a b) = run' b >> run' a     run' (FMap f d) = run' d  -- |Like runDrawing, but clears the screen first.  This is so@@ -103,7 +103,7 @@ selectRegion ll ur drawing = do     ((), recs) <- GL.getHitRecords 64 $ do -- XXX hard coded crap         GL.preservingMatrix $ do-            GLU.ortho2D (fst ll) (fst ur) (snd ll) (snd ur)+            GLU.ortho2D (convReal $ fst ll) (convReal $ fst ur) (convReal $ snd ll) (convReal $ snd ur)             runReaderT (draw' 0 drawing) initDrawCxt             return ()     let nameList = concatMap (\(GL.HitRecord _ _ ns) -> ns) (maybe [] id recs)@@ -117,7 +117,7 @@         return $! n+1     draw' n (TransformGL f m) = f (draw' n m)     draw' n Empty = return n-    draw' n (Over a b) = do+    draw' n (Over f a b) = do         n' <- draw' n b         draw' n' a     draw' n (FMap f d) = draw' n d@@ -128,14 +128,19 @@         | otherwise            = (Nothing, n + 1)     lookupName n names (TransformGL _ m) = lookupName n names m     lookupName n names Empty = (Nothing, n)-    lookupName n names (Over a b) =+    lookupName n names (Over f a b) =         let (lb, n')  = lookupName n  names b             (la, n'') = lookupName n' names a-        in (la `mplus` lb, n'')+        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)+ click :: Vec2 -> Draw a -> IO (Maybe a) click (px,py) = selectRegion (px-e,py-e) (px+e,py+e)     where@@ -147,17 +152,20 @@ initDrawCxt = DrawCxt { colorTrans = id }  over :: Draw a -> Draw a -> Draw a-over = Over+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 (Draw a) where+instance (Monoid a) => Monoid (Draw a) where     mempty = empty-    mappend = over+    mappend = overlay mappend   {----------------@@ -173,6 +181,9 @@         when (not success) $ fail "SDL_ttf initialization failed"  +convReal :: Double -> GL.GLdouble+convReal = realToFrac+ {----------------   Geometric Primitives -----------------}@@ -181,23 +192,23 @@ point :: Vec2 -> Draw () point (ax,ay) = DrawGL $ lift $     GL.renderPrimitive GL.Points $-        GL.vertex $ GL.Vertex2 ax ay+        GL.vertex $ GL.Vertex2 (convReal ax) (convReal ay)  -- | 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 ax ay-        GL.vertex $ GL.Vertex2 bx by+        GL.vertex $ GL.Vertex2 (convReal ax) (convReal ay)+        GL.vertex $ GL.Vertex2 (convReal bx) (convReal by)  -- | 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 Double)+        GL.vertex $ (GL.Vertex2 0 0 :: GL.Vertex2 GL.GLdouble)         forM_ [0..n] $ \s -> do-            let theta = scaler * fromIntegral s+            let theta = convReal (scaler * fromIntegral s)             GL.vertex $ GL.Vertex2 (cos theta) (sin theta)  -- | Draw a unit circle centered at the origin.  This is equivalent@@ -210,7 +221,7 @@ convexPoly points = DrawGL $ lift $ do     GL.renderPrimitive GL.Polygon $ do         forM_ points $ \(x,y) -> do-            GL.vertex $ GL.Vertex2 x y+            GL.vertex $ GL.Vertex2 (convReal x) (convReal y)  {-----------------   Transformations@@ -221,7 +232,7 @@ translate (byx,byy) = TransformGL $ \d -> do     r <- ask     lift $ GL.preservingMatrix $ do-        GL.translate (GL.Vector3 byx byy 0)+        GL.translate (GL.Vector3 (convReal byx) (convReal byy) 0)         runReaderT d r  -- | Rotate the given drawing counterclockwise by the@@ -230,7 +241,7 @@ rotate rad = TransformGL $ \d -> do     r <- ask     lift $ GL.preservingMatrix $ do-        GL.rotate (180 * rad / pi) (GL.Vector3 0 0 1)+        GL.rotate (180 * convReal rad / pi) (GL.Vector3 0 0 1)         runReaderT d r  -- | @scale x y d@ scales @d@ by a factor of @x@ in the@@ -239,7 +250,7 @@ scale x y = TransformGL $ \d -> do     r <- ask     lift $ GL.preservingMatrix $ do-        GL.scale x y 1+        GL.scale (convReal x) (convReal y) 1         runReaderT d r  {------------@@ -265,7 +276,7 @@     setColor oldcolor     return result     where-    setColor (r,g,b,a) = lift $ GL.color $ GL.Color4 r g b a+    setColor (r,g,b,a) = lift $ GL.color $ GL.Color4 (convReal r) (convReal g) (convReal b) (convReal a)  -- | @color c d@ sets the color of the drawing to exactly @c@. color :: Color -> Draw a -> Draw a@@ -389,9 +400,9 @@     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 :: Double)+        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

@@ -1,5 +1,6 @@ import qualified Graphics.DrawingCombinators as Draw import qualified Graphics.UI.SDL as SDL+import Data.Monoid  resX = 640 resY = 480@@ -12,13 +13,17 @@     return ()  -drawing :: Draw.Draw ()-drawing = Draw.translate (0.0,0.2) +box :: Draw.Draw ()+box = Draw.translate (0.0,0.2)          $ Draw.scale 0.3 0.3          $ Draw.color (1,0,0,0)          $ Draw.convexPoly             [(1,1),(1,-1),(-1,-1),(-1,1)] +drawing = fmap (const "A") (Draw.color (0,0,1,0) box)+          `mappend`+          fmap (const "B") (Draw.translate (-0.1,0.2) box)+ main :: IO () main = do     initScreen@@ -39,7 +44,7 @@                  hit <- Draw.click (x',y') drawing                  case hit of                       Nothing -> waitClicks-                      Just () -> putStrLn "Hit!" >> waitClicks+                      Just xs -> putStrLn xs >> waitClicks              _ -> waitClicks  untilM :: (Monad m) => (a -> Bool) -> m a -> m a

@@ -4,14 +4,14 @@     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.2+Version: 0.3 Stability: experimental Synopsis: A functional interface to 2D drawing in OpenGL-License: LGPL+License: BSD3 Category: Graphics Author: Luke Palmer Maintainer: lrpalmer@gmail.com Build-Type: Simple-Build-Depends: base, mtl, containers, SDL, SDL-ttf, SDL-image, OpenGL+Build-Depends: base <= 4, mtl, containers, SDL, SDL-ttf, SDL-image, OpenGL Exposed-Modules: Graphics.DrawingCombinators Extra-Source-Files: example.hs