{-# LANGUAGE     OverloadedStrings       #-}



{-
Module for geometrical shapes.
-}

module Core.Geometry 
  ( regularPolygon
  , starPolygonFirstSpecies
  , starOutline
  , starFat
  , starRegular
  ) where

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

import Core.Utils



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


{- |
`regularPolygon` builds a regular polygon.

You can customize fill and stroke using the
usual `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.
-}
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` functions.
-}
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



{- |
`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 
(so it would draw a pentagram), while this funtion'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.strokeMiterlimit AttributeValue
"100"
      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.
-}
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.
-}
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))