{-# LANGUAGE     OverloadedStrings       #-}



{- |
Module for geometrical shapes.

Tip: you may want to use @stroke-miterlimit@
-}

module SvgIcons.Core.Geometry 
  ( geometryExamples
  , anglesHelp
  , regularPolygon
  , starPolygonFirstSpecies
  , starPolygonWithBorder
  , starPolygonOverlap
  , starOutline
  , starFat
  , starRegular
  , starSlim
  , asterisk
  , asteriskStar
  ) where

import           Text.Blaze.Svg11 ((!))
import           Text.Blaze.Svg11 as S
import           Text.Blaze.Svg11.Attributes as A

import SvgIcons.Core.Utils



--------------------------------------------------------------------------------


{- |
Some examples for this module.

>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_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 :: [(String, Svg)]
geometryExamples =
  [ (,) String
"regular_polygon_5"      forall a b. (a -> b) -> a -> b
$ Int -> Float -> (Float, Float) -> Svg
regularPolygon Int
5 Float
0.9 (Float
0,Float
0)
  , (,) String
"regular_polygon_6"      forall a b. (a -> b) -> a -> b
$ Int -> Float -> (Float, Float) -> Svg
regularPolygon Int
6 Float
0.9 (Float
0,Float
0)
  , (,) String
"star_polygon_5"         forall a b. (a -> b) -> a -> b
$ Int -> Float -> (Float, Float) -> Svg
starPolygonFirstSpecies Int
5 Float
0.9 (Float
0,Float
0)
  , (,) String
"star_polygon_6"         forall a b. (a -> b) -> a -> b
$ Int -> Float -> (Float, Float) -> Svg
starPolygonFirstSpecies Int
6 Float
0.9 (Float
0,Float
0)
  , (,) String
"star_polygon_border_5"  forall a b. (a -> b) -> a -> b
$ Int -> Float -> Float -> (Float, Float) -> Svg
starPolygonWithBorder Int
5 Float
0.9 Float
0.1 (Float
0,Float
0)
  , (,) String
"star_polygon_border_6"  forall a b. (a -> b) -> a -> b
$ Int -> Float -> Float -> (Float, Float) -> Svg
starPolygonWithBorder Int
6 Float
0.9 Float
0.1 (Float
0,Float
0)
  , (,) String
"star_polygon_overlap_5" forall a b. (a -> b) -> a -> b
$ Int -> Float -> Float -> (Float, Float) -> Svg
starPolygonOverlap Int
5 Float
0.9 Float
0.1 (Float
0,Float
0)
  , (,) String
"star_polygon_overlap_6" forall a b. (a -> b) -> a -> b
$ Int -> Float -> Float -> (Float, Float) -> Svg
starPolygonOverlap Int
6 Float
0.9 Float
0.1 (Float
0,Float
0)
  , (,) String
"star_fat_5"             forall a b. (a -> b) -> a -> b
$ Int -> Float -> (Float, Float) -> Svg
starFat Int
5 Float
0.9 (Float
0,Float
0)
  , (,) String
"star_fat_6"             forall a b. (a -> b) -> a -> b
$ Int -> Float -> (Float, Float) -> Svg
starFat Int
6 Float
0.9 (Float
0,Float
0)
  , (,) String
"star_regular_5"         forall a b. (a -> b) -> a -> b
$ Int -> Float -> (Float, Float) -> Svg
starRegular Int
5 Float
0.9 (Float
0,Float
0)
  , (,) String
"star_regular_6"         forall a b. (a -> b) -> a -> b
$ Int -> Float -> (Float, Float) -> Svg
starRegular Int
6 Float
0.9 (Float
0,Float
0)
  , (,) String
"star_slim_5"            forall a b. (a -> b) -> a -> b
$ Int -> Float -> (Float, Float) -> Svg
starSlim Int
5 Float
0.9 (Float
0,Float
0)
  , (,) String
"star_slim_6"            forall a b. (a -> b) -> a -> b
$ Int -> Float -> (Float, Float) -> Svg
starSlim Int
6 Float
0.9 (Float
0,Float
0)
  , (,) String
"asterisk_3"             forall a b. (a -> b) -> a -> b
$ Int -> Float -> (Float, Float) -> Svg
asterisk Int
3 Float
0.9 (Float
0,Float
0)
  , (,) String
"asterisk_star_3"        forall a b. (a -> b) -> a -> b
$ Int -> Float -> (Float, Float) -> Svg
asteriskStar Int
3 Float
0.9 (Float
0,Float
0)
  ]



{- |
`anglesHelp` is just a helpful graphic showing some angles (in radians)
involved in regular polygons and first species star polygons of @n@ vertices:

  (1) In black: central angle of a regular polygon.
  (2) In blue: inner angle of a regular polygon.
  (3) In red: outer angle of a first species star polygon.
  (4) In green: inner angle of a first species star polygon.

![angles help](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/anglesHelp.svg)
-}
anglesHelp :: Svg
anglesHelp :: Svg
anglesHelp =
    Svg -> Svg
S.svg
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.viewbox AttributeValue
"-1 -1 2 2"
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.width  AttributeValue
"500"
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.height AttributeValue
"500"
      forall a b. (a -> b) -> a -> b
$ do
        Svg
pentagon
        Svg
centralAngle
        Svg
internalAngle
        Svg
starOuterAngle
        Svg
starInnerAngle
        Svg -> (Float, Float) -> Svg
mkText Svg
"apothema = r cos(π/n)" (Float
0 , -Float
0.2)
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"indigo"
  where
    r1 :: Float
r1 = Float
0.9
    vertice :: Float -> (Float, Float)
vertice Float
k =
      (Float
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin(Float
kforall a. Num a => a -> a -> a
*Float
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/Float
7) , -Float
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos(Float
kforall a. Num a => a -> a -> a
*Float
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/Float
7))
    pentagon :: Svg
pentagon = 
      Svg
S.path
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"white"
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.stroke AttributeValue
"silver"
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeWidth AttributeValue
"0.02"
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
pentagonDirs
    pentagonDirs :: AttributeValue
pentagonDirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
0
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> (Float, Float)
vertice forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Integer
1 .. Integer
6]
      Path
S.z
    mkText :: Svg -> (Float, Float) -> Svg
mkText Svg
txt (Float
t1,Float
t2) =
      Svg -> Svg
S.text_ Svg
txt
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.stroke AttributeValue
"none"
        forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.x (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
t1)
        forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.y (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
t2)
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fontSize AttributeValue
"0.09"
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fontWeight AttributeValue
"bold"
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.dominantBaseline AttributeValue
"middle"
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.textAnchor AttributeValue
"middle"
    centralAngle :: Svg
centralAngle =
      Svg -> Svg
S.g
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.stroke AttributeValue
"black"
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"black"
        forall a b. (a -> b) -> a -> b
$ do
          Svg
S.path
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"none"
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeWidth AttributeValue
"0.01"
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
centralDirs
          Svg -> (Float, Float) -> Svg
mkText Svg
"2π/n" (Float
0 , Float
0.25)
    centralDirs :: AttributeValue
centralDirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
3
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ (Integer
0,Integer
0)
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
4
    internalAngle :: Svg
internalAngle =
      Svg -> Svg
S.g
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.stroke AttributeValue
"blue"
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"blue"
        forall a b. (a -> b) -> a -> b
$ do
          Svg
S.path
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"none"
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeWidth AttributeValue
"0.01"
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
internalDirs
          Svg -> (Float, Float) -> Svg
mkText 
            Svg
"π - 2π/n"
            ( Float
0.18 forall a. Num a => a -> a -> a
+ (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
6)
            , Float
0.05 forall a. Num a => a -> a -> a
+ (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
6)
            )
    internalDirs :: AttributeValue
internalDirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
0
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
6
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
5  
    starOuterAngle :: Svg
starOuterAngle =
      Svg -> Svg
S.g
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.stroke AttributeValue
"red"
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"red"
        forall a b. (a -> b) -> a -> b
$ do
          Svg
S.path
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"none"
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeWidth AttributeValue
"0.01"
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
starOuterAngleDirs
          Svg -> (Float, Float) -> Svg
mkText
            Svg
"π/n"
            ( Float
0.3  forall a. Num a => a -> a -> a
+ (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
0)
            , Float
0.25 forall a. Num a => a -> a -> a
+ (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
0)
            )
    starOuterAngleDirs :: AttributeValue
starOuterAngleDirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
1
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
0
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
2
    starInnerAngle :: Svg
starInnerAngle =
      Svg -> Svg
S.g
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.stroke AttributeValue
"green"
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"green"
        forall a b. (a -> b) -> a -> b
$ do
          Svg
S.path
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"none"
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeWidth AttributeValue
"0.01"
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
starInnerAngleDirs
          Svg -> (Float, Float) -> Svg
mkText
            Svg
"π - 4π/n"
            ( -Float
0.05 forall a. Num a => a -> a -> a
+ (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
3)
            , -Float
0.5  forall a. Num a => a -> a -> a
+ (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
3)
            )
    starInnerAngleDirs :: AttributeValue
starInnerAngleDirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
1
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
3
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ Float -> (Float, Float)
vertice Float
5   




{- |
`regularPolygon` builds a regular polygon.

You can customize fill and stroke using the
usual [blaze-svg](https://hackage.haskell.org/package/blaze-svg) functions. For example:

>regularPolygon 5 100 (200,300)
>  ! A.fill "pink"
>  ! A.stroke "#0000FF"
>  ! A.strokeWidth "10"

will return a __path element__ corresponding to a 
regular pentagon of radius 100 centered at point
(200,300) filled in pink, green stroke and stroke
width 10.

Examples:

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/regular_polygon_5_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/regular_polygon_5_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/regular_polygon_5_strk.svg)

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/regular_polygon_6_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/regular_polygon_6_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/regular_polygon_6_strk.svg)
-}
regularPolygon 
  :: Int             -- ^ number of vertices

  -> Float           -- ^ circumradius

  -> (Float , Float) -- ^ coordinates of the central point

  -> Svg             -- ^ resulting svg path

regularPolygon :: Int -> Float -> (Float, Float) -> Svg
regularPolygon Int
n Float
r (Float
x0,Float
y0) =
    Svg
S.path
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
directions
  where
    α :: Float
α  = Float
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    draw :: Float -> Path
draw Float
k =
      forall a. Show a => a -> a -> Path
l  (Float
x0 forall a. Num a => a -> a -> a
+ Float
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Float
kforall a. Num a => a -> a -> a
*Float
α))
         (Float
y0 forall a. Num a => a -> a -> a
- Float
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
kforall a. Num a => a -> a -> a
*Float
α))
    directions :: AttributeValue
directions =
      Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
        forall a. Show a => a -> a -> Path
m   Float
x0   (Float
y0 forall a. Num a => a -> a -> a
- Float
r)
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Float -> Path
draw forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Int
1..Int
n]
        Path
S.z



{- |
`starPolygonFirstSpecies` builds a first species regular star polygon.

First species means that one vertice is skipped when joining vertices.
The number of vertices must be strictly greater than 4.
Can be customized with the usual [blaze-svg](https://hackage.haskell.org/package/blaze-svg) functions.

Examples:

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_5_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_5_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_5_strk.svg)

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_6_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_6_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_6_strk.svg)
-}
starPolygonFirstSpecies 
  :: Int             -- ^ number of vertices 

  -> Float           -- ^ circumradius

  -> (Float , Float) -- ^ coordinates of the central point

  -> Svg             -- ^ resulting svg path

starPolygonFirstSpecies :: Int -> Float -> (Float, Float) -> Svg
starPolygonFirstSpecies Int
n Float
r (Float
c1,Float
c2) =
    Svg
S.path
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
directions
  where
    α :: Float
α  = Float
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    vertice :: p -> (Float, Float)
vertice p
k' = 
      let k :: Float
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral p
k'
      in 
        (,) (Float
c1 forall a. Num a => a -> a -> a
+ Float
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Float
kforall a. Num a => a -> a -> a
*Float
α))
            (Float
c2 forall a. Num a => a -> a -> a
- Float
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
kforall a. Num a => a -> a -> a
*Float
α))
    verticesList :: [(Float, Float)]
verticesList = forall a b. (a -> b) -> [a] -> [b]
map forall {p}. Integral p => p -> (Float, Float)
vertice [Int
0 .. (Int
nforall a. Num a => a -> a -> a
-Int
1)]
    directions :: AttributeValue
directions =
      if forall a. Integral a => a -> Bool
even Int
n 
        then 
          Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
            forall a. Show a => a -> a -> Path
m   (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Float, Float)]
verticesList)  (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Float, Float)]
verticesList)
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l) (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> ([a], [a])
evenOddSplit [(Float, Float)]
verticesList)
            Path
S.z
            forall a. Show a => a -> a -> Path
m   (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ [(Float, Float)]
verticesList forall a. [a] -> Int -> a
!! Int
1)  (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ [(Float, Float)]
verticesList forall a. [a] -> Int -> a
!! Int
1)
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l) (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> ([a], [a])
evenOddSplit [(Float, Float)]
verticesList)
            Path
S.z
        else
          Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
            forall a. Show a => a -> a -> Path
m   (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Float, Float)]
verticesList)  (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Float, Float)]
verticesList)
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l) (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> ([a], [a])
evenOddSplit forall a b. (a -> b) -> a -> b
$ [(Float, Float)]
verticesList forall a. [a] -> [a] -> [a]
++ [(Float, Float)]
verticesList)
            Path
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:

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_border_5_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_border_5_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_border_5_strk.svg)

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_border_6_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_border_6_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_border_6_strk.svg)
-}
starPolygonWithBorder
  :: Int             -- ^ number of vertices 

  -> Float           -- ^ circumradius

  -> Float           -- ^ width of the line

  -> (Float , Float) -- ^ coordinates of the central point

  -> Svg             -- ^ resulting svg path

starPolygonWithBorder :: Int -> Float -> Float -> (Float, Float) -> Svg
starPolygonWithBorder Int
n Float
r1 Float
w (Float
c1,Float
c2) =
    Svg
S.path
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
directions
  where
    β :: Float
β = Float
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    ɣ :: Float
ɣ = forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Float
2 forall a. Num a => a -> a -> a
- Float
β
    r2 :: Float
r2 = Float
r1 forall a. Num a => a -> a -> a
- (Float
w forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
tan Float
ɣ)
    outerV :: a -> (Float, Float)
outerV a
k = (,)
      (Float
c1 forall a. Num a => a -> a -> a
+ Float
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Float
β forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k))
      (Float
c2 forall a. Num a => a -> a -> a
- Float
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
β forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k))
    innerV :: a -> (Float, Float)
innerV a
k = (,)
      (Float
c1 forall a. Num a => a -> a -> a
+ Float
r2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Float
β forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k))
      (Float
c2 forall a. Num a => a -> a -> a
- Float
r2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
β forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k))
    directions :: AttributeValue
directions = 
      if forall a. Integral a => a -> Bool
even Int
n
        then
          Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
            (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m)  (forall {p}. Integral p => p -> (Float, Float)
outerV Integer
0)
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_  (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l) (forall a b. (a -> b) -> [a] -> [b]
map forall {p}. Integral p => p -> (Float, Float)
outerV [Int
2, Int
4 .. Int
n])
            Path
S.z
            (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m)  (forall {p}. Integral p => p -> (Float, Float)
outerV Integer
1)
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_  (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l) (forall a b. (a -> b) -> [a] -> [b]
map forall {p}. Integral p => p -> (Float, Float)
outerV [Int
3, Int
5 .. Int
n])
            Path
S.z
            (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m)  (forall {p}. Integral p => p -> (Float, Float)
innerV Integer
0)
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_  (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l) (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {p}. Integral p => p -> (Float, Float)
innerV [Int
2, Int
4 .. Int
n])
            Path
S.z
            (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m)  (forall {p}. Integral p => p -> (Float, Float)
innerV Integer
1)
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_  (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l) (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {p}. Integral p => p -> (Float, Float)
innerV [Int
3, Int
5 .. Int
n])
            Path
S.z
        else
          Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
            (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m)  (forall {p}. Integral p => p -> (Float, Float)
outerV Integer
0)
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_  (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l) (forall a b. (a -> b) -> [a] -> [b]
map forall {p}. Integral p => p -> (Float, Float)
outerV [Int
2, Int
4 .. (Int
2forall a. Num a => a -> a -> a
*Int
nforall a. Num a => a -> a -> a
-Int
1)])
            Path
S.z
            (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m)  (forall {p}. Integral p => p -> (Float, Float)
innerV Integer
0)
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_  (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l) (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {p}. Integral p => p -> (Float, Float)
innerV [Int
2, Int
4 .. (Int
2forall a. Num a => a -> a -> a
*Int
nforall a. Num a => a -> a -> a
-Int
1)])
            Path
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:

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_overlap_5_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_overlap_5_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_overlap_5_strk.svg)

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_overlap_6_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_overlap_6_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_polygon_overlap_6_strk.svg)

-}
starPolygonOverlap
  :: Int             -- ^ number of vertices 

  -> Float           -- ^ circumradius

  -> Float           -- ^ width of the line

  -> (Float , Float) -- ^ coordinates of the central point

  -> Svg             -- ^ resulting svg path

starPolygonOverlap :: Int -> Float -> Float -> (Float, Float) -> Svg
starPolygonOverlap Int
n Float
r1 Float
w (Float
c1,Float
c2) = 
    Svg -> Svg
S.g forall a b. (a -> b) -> a -> b
$ do
      Int -> Float -> Float -> (Float, Float) -> Svg
starPolygonWithBorder Int
n Float
r1 Float
w (Float
c1,Float
c2)
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.stroke AttributeValue
"none"
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {a}. Integral a => a -> Svg
makeSide forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((-Int
1)forall a. Num a => a -> a -> a
*)) [Int
0 .. (Int
nforall a. Num a => a -> a -> a
-Int
1)]
      Svg
fixFirstSide
  where
    β :: Float
β = Float
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    r2 :: Float
r2 = Float
r1 forall a. Num a => a -> a -> a
- Float
w forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
tan Float
β
    r3 :: Float
r3   = Float
r1 forall a. Num a => a -> a -> a
* (Float
2forall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
cos(Float
βforall a. Fractional a => a -> a -> a
/Float
2) forall a. Num a => a -> a -> a
- Float
1forall a. Fractional a => a -> a -> a
/forall a. Floating a => a -> a
cos(Float
βforall a. Fractional a => a -> a -> a
/Float
2))
    apt3 :: Float
apt3 = Float
r3 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
βforall a. Fractional a => a -> a -> a
/Float
2)
    r4 :: Float
r4   = Float
r2 forall a. Num a => a -> a -> a
* (Float
2forall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
cos(Float
βforall a. Fractional a => a -> a -> a
/Float
2) forall a. Num a => a -> a -> a
- Float
1forall a. Fractional a => a -> a -> a
/forall a. Floating a => a -> a
cos(Float
βforall a. Fractional a => a -> a -> a
/Float
2))
    apt4 :: Float
apt4 = Float
r4 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
βforall a. Fractional a => a -> a -> a
/Float
2)
    outerV :: a -> (Float, Float)
outerV a
k = (,)
      (Float
c1 forall a. Num a => a -> a -> a
+ Float
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Float
β forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k))
      (Float
c2 forall a. Num a => a -> a -> a
- Float
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
β forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k))
    innerV :: a -> (Float, Float)
innerV a
k = (,)
      (Float
c1 forall a. Num a => a -> a -> a
+ Float
r2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Float
β forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k))
      (Float
c2 forall a. Num a => a -> a -> a
- Float
r2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
β forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
k))
    fixFirstSide :: Svg
fixFirstSide = 
      let
        (Float
om1,Float
om2) = (Float
c1 forall a. Num a => a -> a -> a
+ Float
apt3 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin(-Float
β) , Float
c2 forall a. Num a => a -> a -> a
- Float
apt3 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos(-Float
β))
        (Float
im1,Float
im2) = (Float
c1 forall a. Num a => a -> a -> a
+ Float
apt4 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin(-Float
β) , Float
c2 forall a. Num a => a -> a -> a
- Float
apt4 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos(-Float
β))
        fillFix :: AttributeValue
fillFix = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
          forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m forall a b. (a -> b) -> a -> b
$ forall {p}. Integral p => p -> (Float, Float)
outerV Integer
0
          forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ (Float
om1,Float
om2)
          forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ (Float
im1,Float
im2)
          forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ forall {p}. Integral p => p -> (Float, Float)
innerV Integer
0
          Path
S.z
        strokeFix :: AttributeValue
strokeFix = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
          forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m forall a b. (a -> b) -> a -> b
$ forall {p}. Integral p => p -> (Float, Float)
outerV Integer
0
          forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ (Float
om1,Float
om2)
          forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m forall a b. (a -> b) -> a -> b
$ (Float
im1,Float
im2)
          forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ forall {p}. Integral p => p -> (Float, Float)
innerV Integer
0
      in
        Svg -> Svg
S.g forall a b. (a -> b) -> a -> b
$ do
          Svg
S.path
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.stroke AttributeValue
"none"
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
fillFix
          Svg
S.path
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeLinecap AttributeValue
"round"
            forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
strokeFix
    makeSide :: a -> Svg
makeSide a
k =
      Svg -> Svg
S.g forall a b. (a -> b) -> a -> b
$ do
        Svg
S.path
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d (forall {a}. Integral a => a -> AttributeValue
sideDirs1 a
k)
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.stroke AttributeValue
"none"
        Svg
S.path
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d (forall {a}. Integral a => a -> AttributeValue
sideDirs2 a
k)
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeLinecap AttributeValue
"round"
    sideDirs1 :: a -> AttributeValue
sideDirs1 a
k = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m forall a b. (a -> b) -> a -> b
$ forall {p}. Integral p => p -> (Float, Float)
outerV a
k
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ forall {p}. Integral p => p -> (Float, Float)
outerV (a
kforall a. Num a => a -> a -> a
-a
2)
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ forall {p}. Integral p => p -> (Float, Float)
innerV (a
kforall a. Num a => a -> a -> a
-a
2)
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ forall {p}. Integral p => p -> (Float, Float)
innerV a
k
      Path
S.z
    sideDirs2 :: a -> AttributeValue
sideDirs2 a
k = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m forall a b. (a -> b) -> a -> b
$ forall {p}. Integral p => p -> (Float, Float)
outerV a
k
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ forall {p}. Integral p => p -> (Float, Float)
outerV (a
kforall a. Num a => a -> a -> a
-a
2)
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.m forall a b. (a -> b) -> a -> b
$ forall {p}. Integral p => p -> (Float, Float)
innerV (a
kforall a. Num a => a -> a -> a
-a
2)
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l forall a b. (a -> b) -> a -> b
$ forall {p}. Integral p => p -> (Float, Float)
innerV a
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 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).


-}
starOutline 
  :: Int             -- ^ number of vertices

  -> Float           -- ^ circumradius

  -> Float           -- ^ inner radius (circumradius of the inner polygon)

  -> (Float , Float) -- ^ coordinates of the central point

  -> Svg             -- ^ resulting path

starOutline :: Int -> Float -> Float -> (Float, Float) -> Svg
starOutline Int
n Float
r1 Float
r2 (Float
c1,Float
c2) =
    Svg
S.path
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
directions
  where
    β :: Float
β  = Float
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    outerV :: Float -> (Float, Float)
outerV Float
k = (,)
      (Float
c1 forall a. Num a => a -> a -> a
+ Float
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Float
kforall a. Num a => a -> a -> a
*Float
β))
      (Float
c2 forall a. Num a => a -> a -> a
- Float
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
kforall a. Num a => a -> a -> a
*Float
β))
    innerV :: Float -> (Float, Float)
innerV Float
k = (,)
      (Float
c1 forall a. Num a => a -> a -> a
+ Float
r2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Float
kforall a. Num a => a -> a -> a
*Float
β forall a. Num a => a -> a -> a
+ Float
βforall a. Fractional a => a -> a -> a
/Float
2))
      (Float
c2 forall a. Num a => a -> a -> a
- Float
r2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
kforall a. Num a => a -> a -> a
*Float
β forall a. Num a => a -> a -> a
+ Float
βforall a. Fractional a => a -> a -> a
/Float
2))
    vertices :: [(Float, Float)]
vertices = 
      forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 
        (\Float
k [(Float, Float)]
acc -> (Float -> (Float, Float)
outerV Float
k) forall a. a -> [a] -> [a]
: (Float -> (Float, Float)
innerV Float
k) forall a. a -> [a] -> [a]
: [(Float, Float)]
acc) 
        [] 
        (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int
0 .. (Int
nforall a. Num a => a -> a -> a
-Int
1)])
    directions :: AttributeValue
directions = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m     (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Float, Float)]
vertices) (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Float, Float)]
vertices)
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Show a => a -> a -> Path
S.l) (forall a. [a] -> [a]
tail [(Float, Float)]
vertices)
      Path
S.z



{- |
`starFat` 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
"fat" star.

Examples:

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_fat_5_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_fat_5_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_fat_5_strk.svg)

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_fat_6_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_fat_6_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_fat_6_strk.svg)
-}
starFat ::
  Int -> Float -> (Float , Float) -> Svg
starFat :: Int -> Float -> (Float, Float) -> Svg
starFat Int
n Float
r1 (Float
c1,Float
c2) =
    Int -> Float -> Float -> (Float, Float) -> Svg
starOutline Int
n Float
r1 Float
r2 (Float
c1,Float
c2)
  where
    β :: Float
β  = Float
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    r2 :: Float
r2 = Float
r1 forall a. Num a => a -> a -> a
* (Float
1 forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
sin(Float
βforall a. Fractional a => a -> a -> a
/Float
2)forall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
tan(Float
βforall a. Fractional a => a -> a -> a
/Float
2))



{- |
`starRegular` builds a first species regular star polygon.

Works as `starOutline` but you don't need to specify 
the inner radius, and you will get a regular star.

Examples:

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_regular_5_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_regular_5_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_regular_5_strk.svg)

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_regular_6_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_regular_6_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_regular_6_strk.svg)
-}
starRegular ::
  Int -> Float -> (Float , Float) -> Svg
starRegular :: Int -> Float -> (Float, Float) -> Svg
starRegular Int
n Float
r1 (Float
c1,Float
c2) =
    Int -> Float -> Float -> (Float, Float) -> Svg
starOutline Int
n Float
r1 Float
r2 (Float
c1,Float
c2)
  where
    β :: Float
β  = Float
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    r2 :: Float
r2 = Float
r1 forall a. Num a => a -> a -> a
* (Float
2forall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
cos(Float
βforall a. Fractional a => a -> a -> a
/Float
2) forall a. Num a => a -> a -> a
- Float
1forall a. Fractional a => a -> a -> a
/forall a. Floating a => a -> a
cos(Float
βforall a. Fractional a => a -> a -> a
/Float
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:

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_slim_5_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_slim_5_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_slim_5_strk.svg)

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_slim_6_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_slim_6_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/star_slim_6_strk.svg)
-}
starSlim :: 
  Int -> Float -> (Float, Float) -> Svg
starSlim :: Int -> Float -> (Float, Float) -> Svg
starSlim Int
n Float
r1 (Float
c1,Float
c2) =
   Int -> Float -> Float -> (Float, Float) -> Svg
starOutline Int
n Float
r1 Float
r2 (Float
c1,Float
c2)
  where
    β :: Float
β  = Float
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    r2 :: Float
r2 = Float
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Float
β


  
{- |
`asterisk` builds a regular asterisk.

Once again, it's a regular polygon but the stroke only joins
opposite vertices. To ensure that an asterisk is built, the Int
parameter gets multiplied by 2.

Examples:

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/asterisk_3_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/asterisk_3_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/asterisk_3_strk.svg)
-}
asterisk
  :: Int             -- ^ half the number of vertices 

  -> Float           -- ^ circumradius

  -> (Float , Float) -- ^ coordinates of the central point

  -> Svg             -- ^ resulting svg path

asterisk :: Int -> Float -> (Float, Float) -> Svg
asterisk Int
n Float
r (Float
c1,Float
c2) =
    Svg
S.path
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
directions
  where
    α :: Float
α  = forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    directions :: AttributeValue
directions = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ 
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Float -> Path
joinOpposites forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Int
0 .. (Int
nforall a. Num a => a -> a -> a
-Int
1)]
    joinOpposites :: Float -> Path
joinOpposites Float
k = do
      forall a. Show a => a -> a -> Path
m
        (Float
c1 forall a. Num a => a -> a -> a
+ Float
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Float
k forall a. Num a => a -> a -> a
* Float
α))
        (Float
c2 forall a. Num a => a -> a -> a
- Float
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
k forall a. Num a => a -> a -> a
* Float
α))
      forall a. Show a => a -> a -> Path
l 
        (Float
c1 forall a. Num a => a -> a -> a
+ Float
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Float
k forall a. Num a => a -> a -> a
* Float
α forall a. Num a => a -> a -> a
+ forall a. Floating a => a
pi))
        (Float
c2 forall a. Num a => a -> a -> a
- Float
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
k forall a. Num a => a -> a -> a
* Float
α forall a. Num a => a -> a -> a
+ forall a. Floating a => a
pi))

    

{- |
`asteriskStar` builds a regular asterisk star.

It's a regular star but the stroke only joins
opposite vertices. To ensure that an asterisk is built, the Int
parameter gets multiplied by 2.

Examples:

![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/asterisk_star_3_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/asterisk_star_3_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/examples/geometry/asterisk_star_3_strk.svg)
-}
asteriskStar
  :: Int             -- ^ half the number of vertices 

  -> Float           -- ^ circumradius

  -> (Float , Float) -- ^ coordinates of the central point

  -> Svg             -- ^ resulting svg path

asteriskStar :: Int -> Float -> (Float, Float) -> Svg
asteriskStar Int
n Float
r1 (Float
c1,Float
c2) =
    Svg
S.path
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
directions
  where
    α :: Float
α  = forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    r2 :: Float
r2 = Float
r1 forall a. Num a => a -> a -> a
* (Float
2forall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
cos(Float
αforall a. Fractional a => a -> a -> a
/Float
2) forall a. Num a => a -> a -> a
- Float
1forall a. Fractional a => a -> a -> a
/forall a. Floating a => a -> a
cos(Float
αforall a. Fractional a => a -> a -> a
/Float
2))
    directions :: AttributeValue
directions = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ 
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Float -> Path
joinOpposites forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Int
0 .. (Int
nforall a. Num a => a -> a -> a
-Int
1)]
    joinOpposites :: Float -> Path
joinOpposites Float
k = do
      forall a. Show a => a -> a -> Path
m
        (Float
c1 forall a. Num a => a -> a -> a
+ Float
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Float
k forall a. Num a => a -> a -> a
* Float
α))
        (Float
c2 forall a. Num a => a -> a -> a
- Float
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
k forall a. Num a => a -> a -> a
* Float
α))
      forall a. Show a => a -> a -> Path
l 
        (Float
c1 forall a. Num a => a -> a -> a
+ Float
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Float
k forall a. Num a => a -> a -> a
* Float
α forall a. Num a => a -> a -> a
+ forall a. Floating a => a
pi))
        (Float
c2 forall a. Num a => a -> a -> a
- Float
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
k forall a. Num a => a -> a -> a
* Float
α forall a. Num a => a -> a -> a
+ forall a. Floating a => a
pi))
      forall a. Show a => a -> a -> Path
m 
        (Float
c1 forall a. Num a => a -> a -> a
+ Float
r2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Float
0.5 forall a. Num a => a -> a -> a
* Float
α forall a. Num a => a -> a -> a
+ Float
k forall a. Num a => a -> a -> a
* Float
α))
        (Float
c2 forall a. Num a => a -> a -> a
- Float
r2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
0.5 forall a. Num a => a -> a -> a
* Float
α forall a. Num a => a -> a -> a
+ Float
k forall a. Num a => a -> a -> a
* Float
α))
      forall a. Show a => a -> a -> Path
l
        (Float
c1 forall a. Num a => a -> a -> a
+ Float
r2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin (Float
0.5 forall a. Num a => a -> a -> a
* Float
α forall a. Num a => a -> a -> a
+ Float
k forall a. Num a => a -> a -> a
* Float
α forall a. Num a => a -> a -> a
+ forall a. Floating a => a
pi))
        (Float
c2 forall a. Num a => a -> a -> a
- Float
r2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos (Float
0.5 forall a. Num a => a -> a -> a
* Float
α forall a. Num a => a -> a -> a
+ Float
k forall a. Num a => a -> a -> a
* Float
α forall a. Num a => a -> a -> a
+ forall a. Floating a => a
pi))