{-# LANGUAGE     OverloadedStrings       #-}


{- |
Module      : Core.Utils
Description : Utilities for svg coding
-}
module Core.Utils 
  ( evenOddSplit
  , addXmlns
  , (.:)
  , distance
  , horizontalMirrorMatrix
  , verticalMirrorMatrix
  , frame
  ) where

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



{- |
Splits a list into two lists:
* The first one contains all the elements in odd positions
* The second one contains all the elements in even positions
-}
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.

Takes the 4 numbers of the viewbox (x0, y0, width, height)
and returns a path with a very thin stroke which connects all 
consecutive corners of the viewbox and also connects opposite
middle points.
-}
frame :: Float -> Float -> Float -> Float -> S.Svg
frame :: Float -> Float -> Float -> Float -> Svg
frame 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 AttributeValue
"black"
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeWidth AttributeValue
"0.002"
      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)


-- Takes a number n and a string s, 

-- and returns a string equal to s except that every decimal

-- number inside s will have its decimal part capped at n digits

cleanDecimals :: Int -> String -> String
cleanDecimals :: Int -> String -> String
cleanDecimals Int
n String
s = 
    String -> String -> String -> String
f [] [] String
s
  where
    f :: String -> String -> String -> String
f String
_ String
acc [] = forall a. [a] -> [a]
reverse String
acc
    f String
aux String
acc (Char
c:String
cs) = 
      if Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'
        then String -> String -> String -> String
f String
"." String
acc String
cs
        else if String
aux forall a. Eq a => a -> a -> Bool
== []
          then String -> String -> String -> String
f [] (Char
c forall a. a -> [a] -> [a]
: String
acc) String
cs
          else if (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Char -> Bool
isDigit Char
c)
            then String -> String -> String -> String
f [] (Char
c forall a. a -> [a] -> [a]
: String
aux forall a. [a] -> [a] -> [a]
++ String
acc) String
cs
            else if (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
aux forall a. Ord a => a -> a -> Bool
< Int
n)
              then String -> String -> String -> String
f (Char
c forall a. a -> [a] -> [a]
: String
aux) String
acc String
cs
              else String -> String -> String -> String
f String
aux String
acc String
cs