nanovg-simple 0.4.0.0 → 0.5.0.0
raw patch · 4 files changed
+47/−25 lines, 4 filesdep ~GLFW-b
Dependency ranges changed: GLFW-b
Files
- README.md +4/−4
- app/Main.hs +2/−2
- nanovg-simple.cabal +4/−4
- src/Graphics/NanoVG/Picture.hs +37/−15
README.md view
@@ -19,12 +19,12 @@ ```haskell import Graphics.NanoVG.Picture import Graphics.NanoVG.Simple-import qualified NanoVG as NVG main :: IO () main = run 800 600 "Simple app" $ asWindow $- pure $ translateP 50 0 $ pictures- [ fill (NVG.Color 1 1 1 1) $ circle (10, 10) 10- , stroke (NVG.Color 1 1 1 1) $ circle (10, 10) 15+ pure $ translateP 50 0 $ mconcat+ [ fill (Color 1 1 1 1) $ circle (10, 10) 10+ , stroke (Color 1 1 1 1) $ circle (10, 10) 15+ , fill (Color 0 1 0 1) $ $ translateS (-50) 0 $ line (0, 0) (5, 5) ] ```
app/Main.hs view
@@ -16,13 +16,13 @@ P.asWindow $ getPOSIXTime >>= \time -> pure $ P.rotateP (400, 300) (realToFrac $ time - start) $ P.scaleP' (0, 0) 10 $- P.pictures+ mconcat [ P.translateP (12 * (x+1)) (12 * (y+1)) myRing | x <- [0..4] , y <- [0..3] ] where- myRing = P.fill (NVG.Color 1 0 0 1) $ P.shapes+ myRing = P.fill (NVG.Color 1 0 0 1) $ mconcat [ P.circle (0, 0) 4 , P.hole $ P.circle (0, 0) 3 ]
nanovg-simple.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.30.0.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 22f7fc580e230609358f61cb4760e5977eac5580c4ad6cc72bbee6ccda151a2b+-- hash: 727aa62760ab2a7feb3730282c16b678ad0c6fc0900141ab62414c6d56b7bc50 name: nanovg-simple-version: 0.4.0.0+version: 0.5.0.0 synopsis: Simple interface to rendering with NanoVG description: Please see the README on GitHub at <https://github.com/CthulhuDen/nanovg-simple#readme> category: Graphics@@ -46,7 +46,7 @@ c-sources: cbits/glew.c build-depends:- GLFW-b >=3.2.1.0 && <3.3+ GLFW-b >=3.2.1.0 && <3.4 , OpenGL >=3.0.2.2 && <3.1 , base >=4.7 && <5 , monad-loops >=0.4.3 && <0.5
src/Graphics/NanoVG/Picture.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} -- | Description: Rendering composable picture fragments -- The module was originally inspired by gloss Picture data type.@@ -8,9 +9,9 @@ -- Example of composite picture (filled circle inside stroked one, both moved to the side by 50 pixels): -- -- @--- translateP 50 0 $ pictures--- [ fill (NVG.Color 1 1 1 1) $ circle (10, 10) 10--- , stroke (NVG.Color 1 1 1 1) $ circle (10, 10) 15+-- translateP 50 0 $ mconcat+-- [ fill (Color 1 1 1 1) $ circle (10, 10) 10+-- , stroke (Color 1 1 1 1) $ circle (10, 10) 15 -- ] -- @ module Graphics.NanoVG.Picture@@ -27,8 +28,9 @@ , circle , line , rectangle+ , path+ , closedPath , arc- , shapes , translateS , rotateS , scaleS@@ -49,7 +51,6 @@ , stroke , fill- , pictures , translateP , rotateP , scaleP@@ -62,6 +63,9 @@ -- * Rendering as 'Window' , asWindow++ -- * Re-export+ , NVG.Color (..) ) where import Control.Exception.Safe@@ -85,7 +89,7 @@ -- Action should define set of paths for the passed 'NVG.Context'. newtype Shape = Shape { unShape :: NVG.Context -> IO ()- }+ } deriving (Semigroup, Monoid) -- | Saves NanoVG state, applies modifications (first argument), -- runs actions (second argument) and restores state.@@ -109,16 +113,28 @@ NVG.rect ctx (realToFrac $ min ax bx) (realToFrac $ min ay by) (realToFrac $ abs $ ax - bx) (realToFrac $ abs $ ay - by) +-- | Continuous path following the points+path :: [Point] -> Shape+path ps = Shape $ \ctx -> do+ case (ps, head ps) of+ (_:_:_, (x, y)) -> -- Extract first element but only if list has at least two+ NVG.moveTo ctx (realToFrac x) (realToFrac y)+ _ ->+ pure ()+ forM_ (tail ps) $ \(x, y) -> NVG.lineTo ctx (realToFrac x) (realToFrac y)++-- | Continuous path following the points then returning to the first one+closedPath :: [Point] -> Shape+closedPath ps = path ps <> case ps of+ ((x, y):_:_:_) -> Shape $ \ctx -> NVG.lineTo ctx (realToFrac x) (realToFrac y)+ _ -> Shape $ const $ pure ()+ -- | Make arc shape with given center and going counter-clockwise -- from first angle to the second. arc :: Center -> Radius -> Angle -> Angle -> Shape arc (x, y) r a0 a1 = Shape $ \ctx -> NVG.arc ctx (realToFrac x) (realToFrac y) (realToFrac r) (realToFrac a0) (realToFrac a1) NVG.CCW --- | Combine multiple shapes together.-shapes :: [Shape] -> Shape-shapes ss = Shape $ \ctx -> traverse_ (`unShape` ctx) ss- -- | Translate shape by given @x@ and @y@ offsets. translateS :: Float -> Float -> Shape -> Shape translateS x y s = Shape $ \ctx ->@@ -167,7 +183,7 @@ -- | Turns shape into a hole which can then be combined -- with other (solid) shape. E.g. ----- > fill (Color 1 0 0 1) $ shapes [circle (0, 0) 40, hole $ circle (0, 0) 30]+-- > fill (Color 1 0 0 1) $ circle (0, 0) 40 <> hole (circle (0, 0) 30) -- -- can be used to create a ring of width 10. hole :: Shape -> Shape@@ -182,6 +198,16 @@ | Fill NVG.Color Shape | Pictures [Picture] +instance Semigroup Picture where+ -- Could have get away with only last but let's try to reduce nesting+ Pictures ps1 <> Pictures ps2 = Pictures $ ps1 <> ps2+ Pictures ps <> pic = Pictures $ ps <> [pic]+ pic <> Pictures ps = Pictures $ pic : ps+ pic1 <> pic2 = Pictures [pic1, pic2]++instance Monoid Picture where+ mempty = Pictures []+ -- | Modify shape(s) the picture was based off. mapShape :: (Shape -> Shape) -> Picture -> Picture mapShape f = \case@@ -223,10 +249,6 @@ -- | Fill the shape to create a picture. fill :: NVG.Color -> Shape -> Picture fill = Fill---- | Combine multiple pictures together.-pictures :: [Picture] -> Picture-pictures = Pictures -- | Render picture with given NanoVG context. render :: NVG.Context -> Picture -> IO ()