{-# LANGUAGE     OverloadedStrings       #-}



module SvgIcons.Core.Utils 
  ( evenOddSplit
  , addXmlns
  , (.:)
  , distance
  , horizontalMirrorMatrix
  , verticalMirrorMatrix
  , frame
  , rectangleWithRoundCorners
  ) where

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



{- |
Splits a list @xs@ into two lists:

* The first one contains all odd positioned elements of @xs@
* The second one contains all even positioned elements of @xs@
-}
evenOddSplit :: [a] -> ([a], [a])
evenOddSplit :: forall a. [a] -> ([a], [a])
evenOddSplit [] = ([], [])
evenOddSplit (a
x:[a]
xs) = (a
xforall a. a -> [a] -> [a]
:[a]
o, [a]
e)
  where ([a]
e,[a]
o) = forall a. [a] -> ([a], [a])
evenOddSplit [a]
xs



{- |
Takes some `Svg` entity and adds two attributes:

* @xmlns="http://www.w3.org/2000/svg"@
* @xmlns:xlink="http://www.w3.org/1999/xlink"@
-}
addXmlns :: Svg -> Svg
addXmlns :: Svg -> Svg
addXmlns Svg
svg =
  Svg
svg
    forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute Tag
"xmlns" AttributeValue
"http://www.w3.org/2000/svg"
    forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute Tag
"xmlns:xlink" AttributeValue
"http://www.w3.org/1999/xlink"



{- |
Handy operator that converts a `Float` number
into an `AttributeValue` and feeds it to the `Attribute` function.
Example:

>S.path 
>  ! (A.strokeWidth .: 0.1) 
-}
infixl 5 .:
(.:) :: (AttributeValue -> Attribute ) -> Float -> Attribute
AttributeValue -> Attribute
f .: :: (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
x = AttributeValue -> Attribute
f forall a b. (a -> b) -> a -> b
$ forall a. ToValue a => a -> AttributeValue
S.toValue Float
x



{- |
Euclidian distance between two points.
-}
distance :: (Float, Float) -> (Float, Float) -> Float
distance :: (Float, Float) -> (Float, Float) -> Float
distance (Float
ax,Float
ay) (Float
bx,Float
by) =
  forall a. Floating a => a -> a
sqrt forall a b. (a -> b) -> a -> b
$ (Float
bx forall a. Num a => a -> a -> a
- Float
ax)forall a. Floating a => a -> a -> a
**Float
2 forall a. Num a => a -> a -> a
+ (Float
by forall a. Num a => a -> a -> a
- Float
ay)forall a. Floating a => a -> a -> a
**Float
2



{- |
Matrix for the horizontal symmetry __respect to the axis @x=0@__.
Use it with the transform `Attribute`:

>S.path
>  ! A.transform horizontalMirrorMatrix
-}
horizontalMirrorMatrix :: AttributeValue
horizontalMirrorMatrix :: AttributeValue
horizontalMirrorMatrix =
  forall a. Show a => a -> a -> a -> a -> a -> a -> AttributeValue
matrix (-Integer
1) Integer
0 Integer
0 Integer
1 Integer
0 Integer
0



{- |
Matrix for the vertical symmetry __respect to the axis @y=0@__.
Use it with the transform `Attribute`:

>S.path
>  ! A.transform (verticalMirrorMatrix <> rotateAround 45 0 0)
-}
verticalMirrorMatrix :: AttributeValue
verticalMirrorMatrix :: AttributeValue
verticalMirrorMatrix =
  forall a. Show a => a -> a -> a -> a -> a -> a -> AttributeValue
matrix Integer
1 Integer
0 Integer
0 (-Integer
1) Integer
0 Integer
0



{- |
`frame` is mainly used for testing purposes. It draws coordinate axis.

Takes the 4 numbers of the viewbox @(x0, y0, width, height)@
and returns a path which connects all 
consecutive corners of the viewbox and also connects opposite
middle points of the sides of the viewbox.

![framed svg](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/test/test.svg)
-}
frame 
  :: Float    -- ^ stroke-width

  -> String   -- ^ stroke color

  -> Float    -- ^ x0

  -> Float    -- ^ y0

  -> Float    -- ^ width

  -> Float    -- ^ height

  -> S.Svg    -- ^ resulting svg

frame :: Float -> String -> Float -> Float -> Float -> Float -> Svg
frame Float
s String
color Float
x Float
y Float
w Float
h =
    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.stroke (forall a. ToValue a => a -> AttributeValue
S.toValue String
color)
      forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.strokeWidth (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
s)
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
frameDirs
  where
    frameDirs :: AttributeValue
frameDirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m   Float
x       Float
y
      forall a. Show a => a -> a -> Path
l   Float
x      (Float
y forall a. Num a => a -> a -> a
+ Float
h)    
      forall a. Show a => a -> a -> Path
l  (Float
x forall a. Num a => a -> a -> a
+ Float
w) (Float
y forall a. Num a => a -> a -> a
+ Float
h)
      forall a. Show a => a -> a -> Path
l  (Float
x forall a. Num a => a -> a -> a
+ Float
w)  Float
y
      Path
S.z
      forall a. Show a => a -> a -> Path
m  (Float
x forall a. Num a => a -> a -> a
+ Float
wforall a. Fractional a => a -> a -> a
/Float
2)  Float
y
      forall a. Show a => a -> a -> Path
l  (Float
x forall a. Num a => a -> a -> a
+ Float
wforall a. Fractional a => a -> a -> a
/Float
2) (Float
y forall a. Num a => a -> a -> a
+ Float
h)
      forall a. Show a => a -> a -> Path
m   Float
x        (Float
y forall a. Num a => a -> a -> a
+ Float
hforall a. Fractional a => a -> a -> a
/Float
2)
      forall a. Show a => a -> a -> Path
l  (Float
x forall a. Num a => a -> a -> a
+ Float
w)   (Float
y forall a. Num a => a -> a -> a
+ Float
hforall a. Fractional a => a -> a -> a
/Float
2)


{- |
Path of a rectangle with rounded corners.
-}
rectangleWithRoundCorners 
  :: Float              -- ^ corner radius

  -> (Float, Float)     -- ^ (semiwidth, semiheight)

  -> (Float, Float)     -- ^ central point (intersection of diagonals)

  -> S.Path             -- ^ resulting path

rectangleWithRoundCorners :: Float -> (Float, Float) -> (Float, Float) -> Path
rectangleWithRoundCorners Float
r0 (Float
w0,Float
h0) (Float
px,Float
py) =
  let
    x1 :: Float
x1 = Float
px forall a. Num a => a -> a -> a
- Float
w0
    x2 :: Float
x2 = Float
px forall a. Num a => a -> a -> a
+ Float
w0
    y1 :: Float
y1 = Float
py forall a. Num a => a -> a -> a
- Float
h0
    y2 :: Float
y2 = Float
py forall a. Num a => a -> a -> a
+ Float
h0
  in
    do
      forall a. Show a => a -> a -> Path
m   (Float
x1 forall a. Num a => a -> a -> a
+ Float
r0)  (Float
y1     )
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Float
r0   Float
r0   Float
0   Bool
False  Bool
False  (Float
x1     ) (Float
y1 forall a. Num a => a -> a -> a
+ Float
r0)
      forall a. Show a => a -> a -> Path
l   (Float
x1     )  (Float
y2 forall a. Num a => a -> a -> a
- Float
r0)
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Float
r0   Float
r0   Float
0   Bool
False  Bool
False  (Float
x1 forall a. Num a => a -> a -> a
+ Float
r0) (Float
y2     )
      forall a. Show a => a -> a -> Path
l   (Float
x2 forall a. Num a => a -> a -> a
- Float
r0)  (Float
y2     )
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Float
r0   Float
r0   Float
0   Bool
False  Bool
False  (Float
x2     ) (Float
y2 forall a. Num a => a -> a -> a
- Float
r0)
      forall a. Show a => a -> a -> Path
l   (Float
x2     )  (Float
y1 forall a. Num a => a -> a -> a
+ Float
r0)
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Float
r0   Float
r0   Float
0   Bool
False  Bool
False  (Float
x2 forall a. Num a => a -> a -> a
- Float
r0) (Float
y1     )
      Path
S.z