svg-icons 2.4.0.1 → 2.5.0.0
raw patch · 3 files changed
+320/−33 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ SvgIcons.Core.Geometry: starPolygonOverlap :: Int -> Float -> Float -> (Float, Float) -> Svg
+ SvgIcons.Core.Geometry: starPolygonWithBorder :: Int -> Float -> Float -> (Float, Float) -> Svg
Files
- src/Main.hs +18/−9
- src/SvgIcons/Core/Geometry.hs +301/−23
- svg-icons.cabal +1/−1
src/Main.hs view
@@ -1,4 +1,4 @@- +{-# LANGUAGE OverloadedStrings #-} {- | The main purpose of this module is @@ -10,6 +10,7 @@ import System.Directory import Text.Blaze.Svg11 ((!)) import Text.Blaze.Svg11 as S +import Text.Blaze.Svg11.Attributes as A import SvgIcons.Core.Geometry import SvgIcons.Core.Render @@ -60,7 +61,7 @@ renderExamples (svgFolder ++ "/examples/") renderIcons (svgFolder ++ "/icons/") renderImages (svgFolder ++ "/images/") - renderTest (svgFolder ++ "/test/") (asteriskStar 3 0.3 (0.1,0.2)) + renderTest (svgFolder ++ "/test/") (starPolygonOverlap 7 900 50 (0,0)) putStrLn "Svg files compiled correctly" @@ -192,10 +193,18 @@ createDirectory path renderSvgFiles path test where - test = - [ (,) "test_fill" (stdDims $ fillStyle svgFramed) - , (,) "test_full" (stdDims $ fullStyle svgFramed) - , (,) "test_strk" (stdDims $ strkStyle svgFramed) - ] - svgFramed = - S.g $ svgTest >> frame 0.01 "black" (-1) (-1) 2 2+ -- test = + -- [ (,) "test_fill" (stdDims $ fillStyle svgFramed) + -- , (,) "test_full" (stdDims $ fullStyle svgFramed) + -- , (,) "test_strk" (stdDims $ strkStyle svgFramed) + -- ] + test = + [ ("test", svgFramed)] + svgFramed = + S.svg + ! A.viewbox "-1000 -1000 2000 2000" + $ do + S.g (svgTest >> frame 0.1 "black" (-1) (-1) 2 2) + ! A.stroke "black" + ! A.strokeWidth "10" + ! A.fill "white"
src/SvgIcons/Core/Geometry.hs view
@@ -4,12 +4,16 @@ {- | Module for geometrical shapes. + +Tip: you may want to use @stroke-miterlimit@ -} module SvgIcons.Core.Geometry ( geometryExamples , regularPolygon , starPolygonFirstSpecies + , starPolygonWithBorder + , starPolygonOverlap , starOutline , starFat , starRegular @@ -32,30 +36,42 @@ >geometryExamples :: [ (String, Svg) ] >geometryExamples = -> [ (,) "regular_polygon_5" $ regularPolygon 5 0.9 (0,0) -> , (,) "regular_polygon_6" $ regularPolygon 6 0.9 (0,0) -> , (,) "star_polygon_5" $ starPolygonFirstSpecies 5 0.9 (0,0) -> , (,) "star_polygon_6" $ starPolygonFirstSpecies 6 0.9 (0,0) -> , (,) "star_fat_5" $ starFat 5 0.9 (0,0) -> , (,) "star_fat_6" $ starFat 6 0.9 (0,0) -> , (,) "star_regular_5" $ starRegular 5 0.9 (0,0) -> , (,) "star_regular_6" $ starRegular 6 0.9 (0,0) -> , (,) "asterisk_3" $ asterisk 3 0.9 (0,0) -> , (,) "asterisk_star_3" $ asteriskStar 3 0.9 (0,0) +> [ (,) "regular_polygon_5" $ regularPolygon 5 0.9 (0,0) +> , (,) "regular_polygon_6" $ regularPolygon 6 0.9 (0,0) +> , (,) "star_polygon_5" $ starPolygonFirstSpecies 5 0.9 (0,0) +> , (,) "star_polygon_6" $ starPolygonFirstSpecies 6 0.9 (0,0) +> , (,) "star_polygon_border_5" $ starPolygonWithBorder 5 0.9 0.1 (0,0) +> , (,) "star_polygon_border_6" $ starPolygonWithBorder 6 0.9 0.1 (0,0) +> , (,) "star_polygon_overlap_5" $ starPolygonOverlap 5 0.9 0.1 (0,0) +> , (,) "star_polygon_overlap_6" $ starPolygonOverlap 6 0.9 0.1 (0,0) +> , (,) "star_fat_5" $ starFat 5 0.9 (0,0) +> , (,) "star_fat_6" $ starFat 6 0.9 (0,0) +> , (,) "star_regular_5" $ starRegular 5 0.9 (0,0) +> , (,) "star_regular_6" $ starRegular 6 0.9 (0,0) +> , (,) "star_slim_5" $ starSlim 5 0.9 (0,0) +> , (,) "star_slim_6" $ starSlim 6 0.9 (0,0) +> , (,) "asterisk_3" $ asterisk 3 0.9 (0,0) +> , (,) "asterisk_star_3" $ asteriskStar 3 0.9 (0,0) > ] -} geometryExamples :: [ (String, Svg) ] geometryExamples = - [ (,) "regular_polygon_5" $ regularPolygon 5 0.9 (0,0) - , (,) "regular_polygon_6" $ regularPolygon 6 0.9 (0,0) - , (,) "star_polygon_5" $ starPolygonFirstSpecies 5 0.9 (0,0) - , (,) "star_polygon_6" $ starPolygonFirstSpecies 6 0.9 (0,0) - , (,) "star_fat_5" $ starFat 5 0.9 (0,0) - , (,) "star_fat_6" $ starFat 6 0.9 (0,0) - , (,) "star_regular_5" $ starRegular 5 0.9 (0,0) - , (,) "star_regular_6" $ starRegular 6 0.9 (0,0) - , (,) "asterisk_3" $ asterisk 3 0.9 (0,0) - , (,) "asterisk_star_3" $ asteriskStar 3 0.9 (0,0) + [ (,) "regular_polygon_5" $ regularPolygon 5 0.9 (0,0) + , (,) "regular_polygon_6" $ regularPolygon 6 0.9 (0,0) + , (,) "star_polygon_5" $ starPolygonFirstSpecies 5 0.9 (0,0) + , (,) "star_polygon_6" $ starPolygonFirstSpecies 6 0.9 (0,0) + , (,) "star_polygon_border_5" $ starPolygonWithBorder 5 0.9 0.1 (0,0) + , (,) "star_polygon_border_6" $ starPolygonWithBorder 6 0.9 0.1 (0,0) + , (,) "star_polygon_overlap_5" $ starPolygonOverlap 5 0.9 0.1 (0,0) + , (,) "star_polygon_overlap_6" $ starPolygonOverlap 6 0.9 0.1 (0,0) + , (,) "star_fat_5" $ starFat 5 0.9 (0,0) + , (,) "star_fat_6" $ starFat 6 0.9 (0,0) + , (,) "star_regular_5" $ starRegular 5 0.9 (0,0) + , (,) "star_regular_6" $ starRegular 6 0.9 (0,0) + , (,) "star_slim_5" $ starSlim 5 0.9 (0,0) + , (,) "star_slim_6" $ starSlim 6 0.9 (0,0) + , (,) "asterisk_3" $ asterisk 3 0.9 (0,0) + , (,) "asterisk_star_3" $ asteriskStar 3 0.9 (0,0) ] @@ -165,12 +181,243 @@ S.z +{- | +`starPolygonWithBorder` builds a first species regular star polygon with border. +First species means that one vertice is skipped when joining vertices. +The number of vertices must be strictly greater than 4. + +Examples: + + + + + + + + + + + + +-} +starPolygonWithBorder + :: Int -- ^ number of vertices + -> Float -- ^ circumradius + -> Float -- ^ width of the line + -> (Float , Float) -- ^ coordinates of the central point + -> Svg -- ^ resulting svg path +starPolygonWithBorder n r1 w (c1,c2) = + S.path + ! A.d directions + where + β = 2 * pi / (fromIntegral n) + ɣ = pi / 2 - β + r2 = r1 - (w / tan ɣ) + outerV k = (,) + (c1 + r1 * sin (β * fromIntegral k)) + (c2 - r1 * cos (β * fromIntegral k)) + innerV k = (,) + (c1 + r2 * sin (β * fromIntegral k)) + (c2 - r2 * cos (β * fromIntegral k)) + directions = + if even n + then + mkPath $ do + (uncurry S.m) (outerV 0) + mapM_ (uncurry S.l) (map outerV [2, 4 .. n]) + S.z + (uncurry S.m) (outerV 1) + mapM_ (uncurry S.l) (map outerV [3, 5 .. n]) + S.z + (uncurry S.m) (innerV 0) + mapM_ (uncurry S.l) (reverse $ map innerV [2, 4 .. n]) + S.z + (uncurry S.m) (innerV 1) + mapM_ (uncurry S.l) (reverse $ map innerV [3, 5 .. n]) + S.z + else + mkPath $ do + (uncurry S.m) (outerV 0) + mapM_ (uncurry S.l) (map outerV [2, 4 .. (2*n-1)]) + S.z + (uncurry S.m) (innerV 0) + mapM_ (uncurry S.l) (reverse $ map innerV [2, 4 .. (2*n-1)]) + S.z + + + {- | +`starPolygonOverlap` builds a first species regular star polygon with overlapping sides. + +Visually, it only difers from the previous function when both fill and stroke are enabled. + +First species means that one vertice is skipped when joining vertices. +The number of vertices must be strictly greater than 4. + +Examples: + + + + + + + + + + + + + +-} +starPolygonOverlap + :: Int -- ^ number of vertices + -> Float -- ^ circumradius + -> Float -- ^ width of the line + -> (Float , Float) -- ^ coordinates of the central point + -> Svg -- ^ resulting svg path +starPolygonOverlap n r1 w (c1,c2) = + S.g $ do + starPolygonWithBorder n r1 w (c1,c2) + ! A.stroke "none" + mapM_ (makeSide . fromIntegral . ((-1)*)) [0 .. (n-1)] + fixFirstSide + where + β = 2 * pi / (fromIntegral n) + r2 = r1 - w * tan β + r3 = r1 * (2*cos(β/2) - 1/cos(β/2)) + apt3 = r3 * cos (β/2) + r4 = r2 * (2*cos(β/2) - 1/cos(β/2)) + apt4 = r4 * cos (β/2) + outerV k = (,) + (c1 + r1 * sin (β * fromIntegral k)) + (c2 - r1 * cos (β * fromIntegral k)) + innerV k = (,) + (c1 + r2 * sin (β * fromIntegral k)) + (c2 - r2 * cos (β * fromIntegral k)) + fixFirstSide = + let + (om1,om2) = (c1 + apt3 * sin(-β) , c2 - apt3 * cos(-β)) + (im1,im2) = (c1 + apt4 * sin(-β) , c2 - apt4 * cos(-β)) + fillFix = mkPath $ do + uncurry S.m $ outerV 0 + uncurry S.l $ (om1,om2) + uncurry S.l $ (im1,im2) + uncurry S.l $ innerV 0 + S.z + strokeFix = mkPath $ do + uncurry S.m $ outerV 0 + uncurry S.l $ (om1,om2) + uncurry S.m $ (im1,im2) + uncurry S.l $ innerV 0 + in + S.g $ do + S.path + ! A.stroke "none" + ! A.d fillFix + S.path + ! A.strokeLinecap "round" + ! A.d strokeFix + makeSide k = + S.g $ do + S.path + ! A.d (sideDirs1 k) + ! A.stroke "none" + S.path + ! A.d (sideDirs2 k) + ! A.strokeLinecap "round" + sideDirs1 k = mkPath $ do + uncurry S.m $ outerV k + uncurry S.l $ outerV (k-2) + uncurry S.l $ innerV (k-2) + uncurry S.l $ innerV k + S.z + sideDirs2 k = mkPath $ do + uncurry S.m $ outerV k + uncurry S.l $ outerV (k-2) + uncurry S.m $ innerV (k-2) + uncurry S.l $ innerV k + + + + +{- +starPolygonBorderOverlap + :: Int -- ^ number of vertices + -> Float -- ^ circumradius + -> Float -- ^ width of the line + -> (Float , Float) -- ^ coordinates of the central point + -> Svg -- ^ resulting svg path +starPolygonBorderOverlap n r1 w (c1,c2) = do + S.path + ! A.d directions + where + β = 2 * pi / (fromIntegral n) + ɣ = pi / 2 - β + -- r2 = r1 - (w / tan ɣ) + r2 = r1 - w * tan β + -- r3 = r1 * (2*cos(β/2) - 1/cos(β/2)) + r3 = r1 * (cos β) / cos (β/2) + -- r4 = r2 * (2*cos(β/2) - 1/cos(β/2)) + r4 = (r1 * cos β - w * sin β) / (cos (β/2)) + apt0 = r4 * cos (β/2) + h0 = r2 - w - apt0 + y0 = h0 * sin ɣ + r5 = sqrt $ y0^2 + (apt0 + w)^2 + θ = atan $ y0 / (apt0 + w) + rMad = (r2 - w - apt0) / cos ɣ + outerV k = (,) + (c1 + r1 * sin (β * fromIntegral k)) + (c2 - r1 * cos (β * fromIntegral k)) + innerV k = (,) + (c1 + r2 * sin (β * fromIntegral k)) + (c2 - r2 * cos (β * fromIntegral k)) + shortLegOuterV k = (,) + (c1 + r3 * sin (β/2 + β * fromIntegral k)) + (c2 - r3 * cos (β/2 + β * fromIntegral k)) + longLegInnerV k = (,) + (c1 + r4 * sin (-3*β/2 + β * fromIntegral k)) + (c2 - r4 * cos (-3*β/2 + β * fromIntegral k)) + -- shortLegInnerV k = (,) + -- (c1 + r5 * sin (β * (fromIntegral k) + θ)) + -- (c2 - r5 * cos (β * (fromIntegral k) + θ)) + shortLegInnerV k = + let + (i1,i2) = innerV k + in + (,) + (i1 + rMad * sin (ɣ - β * fromIntegral k)) + (i2 + rMad * cos (ɣ - β * fromIntegral k)) + longLegOuterV k = + let + (i1,i2) = innerV (k-1) + in + (,) + (i1 - rMad * sin (ɣ + β * fromIntegral (k-1))) + (i2 + rMad * cos (ɣ + β * fromIntegral (k-1))) + -- longLegOuterV k = (,) + -- (c1 + r5 * sin (β * (fromIntegral $ k-1) - θ)) + -- (c2 - r5 * cos (β * (fromIntegral $ k-1) - θ)) + makeCorner k = do + (uncurry S.m) (shortLegOuterV k) + (uncurry S.l) (outerV k) + (uncurry S.l) (longLegOuterV k) + (uncurry S.l) (longLegInnerV k) + (uncurry S.l) (innerV k) + (uncurry S.l) (shortLegInnerV k) + S.z + directions = + mkPath $ mapM_ (makeCorner . fromIntegral . ((-1)*)) [0 .. (n-1)] +-} + + + + +{- | `starOutline` builds a first species irregular star polygon. -The difference with the previous function is the stroke: -the previous function's stroke runs inside the figure +The difference with function `starPolygonFirstSpecies` is the stroke: +that function's stroke runs inside the figure (so it would draw a pentagram), while this function's stroke runs outside the shape (so it would draw a star). There is no visual difference if you only fill the paths (with no stroke). @@ -263,7 +510,38 @@ starOutline n r1 r2 (c1,c2) where β = 2 * pi / (fromIntegral n) - r2 = r1 * (2*cos(β/2) - 1/cos(β/2)) + r2 = r1 * (2*cos(β/2) - 1/cos(β/2)) -- = r1 * (cos(β/2) - tan(β/2)*sin(β/2)) + + + +{- | +`starSlim` builds a first species irregular star polygon. + +Works as `starOutline` but you don't need to specify +the inner radius, it is already coded so that you get a +"slim" star. + +Examples: + + + + + + + + + + + + +-} +starSlim :: + Int -> Float -> (Float, Float) -> Svg +starSlim n r1 (c1,c2) = + starOutline n r1 r2 (c1,c2) + where + β = 2 * pi / (fromIntegral n) + r2 = r1 * cos β
svg-icons.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: svg-icons -version: 2.4.0.1 +version: 2.5.0.0 homepage: https://github.com/RamiroPastor/SvgIcons license: BSD-3-Clause license-file: LICENSE