diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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) ] ``` diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 ] diff --git a/nanovg-simple.cabal b/nanovg-simple.cabal --- a/nanovg-simple.cabal +++ b/nanovg-simple.cabal @@ -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 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 diff --git a/src/Graphics/NanoVG/Picture.hs b/src/Graphics/NanoVG/Picture.hs --- a/src/Graphics/NanoVG/Picture.hs +++ b/src/Graphics/NanoVG/Picture.hs @@ -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 ()