diagrams-input 0.1.5 → 0.1.5.1

raw patch · 4 files changed

+36/−18 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• diagrams-input.cabal +1/−1
• src/Diagrams/SVG/Path.hs +24/−13
• src/Diagrams/SVG/ReadSVG.hs +7/−4

@@ -1,3 +1,7 @@+# v0.1.5.1 (26 March 2026)++- Correctly render open paths with fill ([#23](https://github.com/diagrams/diagrams-input/pull/23); thanks to Xavier Shay)+ # v0.1.5 (3 April 2025)  - Update SVG parser to account for optional comma separation of values ([#21](https://github.com/diagrams/diagrams-input/pull/21), thanks to @Chobbes)

@@ -1,5 +1,5 @@ Name:                diagrams-input-Version:             0.1.5+Version:             0.1.5.1 Synopsis:            Parse raster and SVG files for diagrams Description:         Parse raster and SVG images for the diagrams DSL. License:             BSD3

@@ -9,6 +9,7 @@     (     -- * Converting Path Commands       commandsToPaths+    , commandsToSVGPaths     , splittedCommands     , outline     , nextSegment@@ -146,9 +147,19 @@  -- | Convert path commands into trails commandsToPaths :: (RealFloat n, Show n) => [PathCommand n] -> [Path V2 n]-commandsToPaths pathCommands = map fst $ foldl' outline [] (splittedCommands pathCommands)+commandsToPaths pathCommands = map (\(p,_,_) -> p) $ foldl' outline [] (splittedCommands pathCommands) +-- | Like 'commandsToPaths', but separates fill-only paths (closed loops from open SVG paths)+--   from normal paths (closed loops and open stroke lines).+--   Fill-only paths should be rendered without stroke; normal paths render as usual.+commandsToSVGPaths :: (RealFloat n, Show n) => [PathCommand n] -> ([Path V2 n], [Path V2 n])+commandsToSVGPaths pathCommands =+    let tagged = foldl' outline [] (splittedCommands pathCommands)+    in  ( [p | (p, True,  _) <- tagged]+        , [p | (p, False, _) <- tagged]+        ) + -- | split list when there is a Z(closePath) and also when there is a (M)oveto command (keep the M) --   and merge repeated lists of single Ms into one M command splittedCommands pathCommands = concat $ map (S.split (S.keepDelimsR (S.whenElt isZ))) $ -- a path ends with a Z@@ -177,19 +188,19 @@ getTrail (O a)      = a  -- | Take the endpoint of the latest path, append another path that has been generated from the path commands--- and return this whole path-outline :: (RealFloat n, Show n) => [(Path V2 n, (n, n))] -> [PathCommand n] -> [(Path V2 n, (n, n))]-outline paths cs = paths ++ [(newPath,newPoint)]+-- and return this whole path.  The Bool tag is True for fill-only paths (closed loops derived from open+-- SVG paths) and False for normal paths.+outline :: (RealFloat n, Show n) => [(Path V2 n, Bool, (n, n))] -> [PathCommand n] -> [(Path V2 n, Bool, (n, n))]+outline paths cs = paths ++ newPaths  where-  newPath = translate (r2 (trx,try)) $-            pathFromTrail $-            if isClosed trail-            then wrapLoop $ closeLine (mconcat (getTrail trail))-            else wrapLoop $ closeLine (mconcat (getTrail trail)) -- unfortunately this has to be closed also, -                                                                 -- because some svgs fill paths that are open+  newPaths+    | isClosed trail = [(mk $ wrapLoop $ closeLine line, False, (trx, try))]+    | otherwise      = [(mk $ wrapLoop $ closeLine line, True,  startPoint)  -- fill-only path+                       ,(mk $ wrapLine             line, False, startPoint)  -- stroke path+                       ] -  newPoint | isClosed trail = (trx, try) -- the endpoint is the old startpoint-           | otherwise      = startPoint+  mk t = translate (r2 (trx,try)) $ pathFromTrail t+  line = mconcat (getTrail trail)    (ctrlPoint, startPoint, trail) = foldl' nextSegment ((x,y), (x,y), O []) cs @@ -199,7 +210,7 @@                                                        -- because we splitted the commands like that   (x,y) = case NE.nonEmpty paths of     Nothing -> (0,0)-    Just nePaths -> snd (NE.last nePaths)+    Just nePaths -> (\(_,_,ep) -> ep) (NE.last nePaths)    sel2 (a,b,c) = a 

@@ -91,7 +91,7 @@ import           Diagrams.SVG.Arguments import           Diagrams.SVG.Attributes import           Diagrams.SVG.Fonts.ReadFont-import           Diagrams.SVG.Path (commands, commandsToPaths, PathCommand(..))+import           Diagrams.SVG.Path (commands, commandsToPaths, commandsToSVGPaths, PathCommand(..)) import           Diagrams.SVG.Tree import           Filesystem.Path (FilePath(..), extension) import           Filesystem.Path.CurrentOS (encodeString)@@ -429,9 +429,12 @@     let st hmaps = (parseStyles style hmaps) ++                    (parsePA  pa  hmaps) ++                    (cssStylesFromMap hmaps "path" (id1 ca) class_)-    let path viewbox = (mconcat $ commandsToPaths $ commands d) # applyTr (parseTr tr)-    let f (maps,viewbox) = path viewbox # strokePath-                                        # applyStyleSVG st maps+    let (fillPs, strokePs) = commandsToSVGPaths (commands d)+    let path viewbox = mconcat (fillPs ++ strokePs) # applyTr (parseTr tr)+    let f (maps,viewbox) = ( mconcat strokePs # strokePath+                          <> mconcat fillPs   # strokePath # lw none+                           ) # applyStyleSVG st maps+                             # applyTr (parseTr tr)     return $ Leaf (id1 ca) path f  -------------------------------------------------------------------------------------------------