packages feed

juicy-draw 0.1.0.0 → 0.2.0.0

raw patch · 4 files changed

+91/−10 lines, 4 filesdep +numeric-extrasPVP ok

version bump matches the API change (PVP)

Dependencies added: numeric-extras

API changes (from Hackage documentation)

+ Codec.Picture.Drawing: fillPolygon :: (Pixel px, PrimMonad m) => MutableImage (PrimState m) px -> [Point2D] -> px -> m ()
+ Codec.Picture.Geometry: centroid :: [Point2D] -> Maybe FPoint2D
+ Codec.Picture.Geometry: clockwise :: [Point2D] -> [Point2D]
+ Codec.Picture.Geometry: closed :: [Point2D] -> [Point2D]
+ Codec.Picture.Geometry: type FPoint2D = (Double, Double)
+ Codec.Picture.Geometry: type Point2D = (Int, Int)
- Codec.Picture.Drawing: drawPolygon :: (Pixel px, PrimMonad m) => MutableImage (PrimState m) px -> [(Int, Int)] -> px -> m ()
+ Codec.Picture.Drawing: drawPolygon :: (Pixel px, PrimMonad m) => MutableImage (PrimState m) px -> [Point2D] -> px -> m ()

Files

app/Main.hs view
@@ -2,6 +2,7 @@  import           Codec.Picture import           Codec.Picture.Drawing+import           Codec.Picture.Geometry  main :: IO () main = do@@ -24,15 +25,14 @@         -- A dark green filled triangle         fillTriangle m 50 200 250 300 70 350 (PixelRGB8 0 150 50) -        -- A blue pentagon-        drawPolygon m+        -- A blue filled pentagon+        fillPolygon m ((closed . clockwise)             [ (340, 80)             , (245, 149)             , (281, 261)             , (399, 261)             , (435, 149)-            , (340, 80)-            ]+            ])             (PixelRGB8 0 0 255)      writePng "example.png" img
juicy-draw.cabal view
@@ -1,7 +1,7 @@ name:                   juicy-draw-version:                0.1.0.0-synopsis:               Functions for drawing and filling lines, rectangles and polygons directly onto a mutable image-description:            This package provides 2D primitives for drawing/fill simple 2D shapes+version:                0.2.0.0+synopsis:               Draw and fill lines, rectangles and polygons+description:            This package provides 2D primitives for drawing/filling simple 2D shapes directly onto a JuicyPixels mutable image homepage:               https://github.com/rcook/juicy-draw#readme license:                MIT license-file:           LICENSE@@ -24,8 +24,11 @@   build-depends:       JuicyPixels     , base >= 4.7 && < 5+    , numeric-extras     , primitive-  exposed-modules:      Codec.Picture.Drawing+  exposed-modules:+      Codec.Picture.Drawing+    , Codec.Picture.Geometry  executable juicy-draw-demo   default-language:     Haskell2010
src/Codec/Picture/Drawing.hs view
@@ -14,12 +14,14 @@     ( drawLine     , drawPolygon     , drawRectangle+    , fillPolygon     , fillRectangle     , fillTriangle     , withDefaultMutableImage     , withMutableImage     ) where +import           Codec.Picture.Geometry (Point2D) import           Codec.Picture.Types                     ( Image                     , MutableImage(..)@@ -82,7 +84,7 @@ -- | Draw a polygon in the specified colour drawPolygon :: (Pixel px, PrimMonad m) =>     MutableImage (PrimState m) px   -- ^ mutable image-    -> [(Int, Int)]                 -- ^ sequence of vertices+    -> [Point2D]                    -- ^ sequence of vertices     -> px                           -- ^ colour     -> m ()                         -- ^ action drawPolygon _ [] _ = pure ()@@ -139,6 +141,18 @@                 w2 = orient2D v1x v1y v2x v2y x y             when (w0 >= 0 && w1 >= 0 && w2 >= 0) $ writePixel m x y px +-- | Fill a polygon as a series of triangles with the specified colour+fillPolygon :: (Pixel px, PrimMonad m) =>+    MutableImage (PrimState m) px   -- ^ mutable image+    -> [Point2D]                    -- ^ sequence of vertices+    -> px                           -- ^ colour+    -> m ()                         -- ^ action+fillPolygon m ((x1, y1) : vs) px =+    let temp = zip vs (drop 1 vs)+    in for_ temp $ \((x2, y2), (x3, y3)) ->+        fillTriangle m x1 y1 x2 y2 x3 y3 px+fillPolygon _ _ _ = pure ()+ orient2D :: Int -> Int -> Int -> Int -> Int -> Int -> Int orient2D ax ay bx by cx cy = (bx - ax) * (cy - ay) - (by - ay) * (cx - ax) @@ -152,5 +166,5 @@     | a > b = max a c     | otherwise = max b c -minMax3 :: Int -> Int -> Int -> (Int, Int)+minMax3 :: Int -> Int -> Int -> Point2D minMax3 a b c = (min3 a b c, max3 a b c)
+ src/Codec/Picture/Geometry.hs view
@@ -0,0 +1,64 @@+{-|+Module      : Codec.Picture.Geometry+Description : Essential geometry for 2D shapes+Copyright   : (C) Richard Cook, 2018+Licence     : MIT+Maintainer  : rcook@rcook.org+Stability   : stable+Portability : portable++Essential geometric functions to generate 2D shapes and paths+-}++module Codec.Picture.Geometry+    ( FPoint2D+    , Point2D+    , centroid+    , clockwise+    , closed+    ) where++import           Data.Foldable (foldl')+import           Data.List (sortBy)+import           Numeric.Extras (fmod)++-- | 2D coordinate+type Point2D = (Int, Int)++-- | 2D coordinate+type FPoint2D = (Double, Double)++-- | Compute the centroid of a polygon+centroid ::+    [Point2D]           -- ^ sequence of vertices+    -> Maybe FPoint2D   -- ^ centroid+centroid [] = Nothing+centroid ps =+    let (totalX, totalY, n') = foldl' (\(accX, accY, n) (x, y) -> (accX + x, accY + y, n + 1)) (0, 0, 0 :: Int) ps+        n'' = fromIntegral n'+    in Just (fromIntegral totalX / n'', fromIntegral totalY / n'')++-- | Closed sequence of vertices+closed ::+    [Point2D]       -- ^ sequence of vertices+    -> [Point2D]    -- ^ sequence of vertices+closed [] = []+closed ps@(p : _ ) = ps ++ [p]++-- | Sequence of vertices in clockwise order relative to its centroid+clockwise ::+    [Point2D]       -- ^ sequence of vertices+    -> [Point2D]    -- ^ sequence of vertices+clockwise ps =+    case centroid ps of+        Just (cx, cy) -> sortBy (\(ax, ay) (bx, by) ->+            let a1 = angle (fromIntegral ax) (fromIntegral ay) cx cy+                a2 = angle (fromIntegral bx) (fromIntegral by) cx cy+            in compare a2 a1) ps+        Nothing -> []++angle :: Double -> Double -> Double -> Double -> Double+angle x y cx cy = fmod (degrees (atan2 (x - cx) (y - cy)) + 360) 360++degrees :: Double -> Double+degrees rad = rad * pi / 180