{-# LANGUAGE     OverloadedStrings       #-}



module Icons.Math 
  ( svgMath
  , lambda
  , lemniscate
  ) where

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

import Core.Utils



{- |
A list with all the icons of this module, 
together with appropriate names.

>svgMath :: [ (String , S.Svg) ]
>svgMath =
>  [ (,) "lambda"     lambda
>  , (,) "lemniscate" lemniscate
>  ]
-}
svgMath :: [ (String , S.Svg) ]
svgMath :: [(String, Svg)]
svgMath =
  [ (,) String
"lambda"     Svg
lambda
  , (,) String
"lemniscate" Svg
lemniscate
  ]


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




{- |
![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/math/lambda_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/math/lambda_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/math/lambda_strk.svg)
-}
lambda :: S.Svg
lambda :: Svg
lambda = 
    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.strokeLinejoin AttributeValue
"round"
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d (Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ Path
rightLeg forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Path
leftLeg forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Path
arm)
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (forall a. Show a => a -> a -> AttributeValue
translate Double
0 (-Double
0.02))
  where
    (Integer
c1,Integer
c2) = (,) ( Integer
0    ) ( Integer
0    )
    (Double
a1,Double
a2) = (,) (-Double
0.376) ( Double
0.962)
    (Double
b1,Double
b2) = (,) (-Double
0.548) ( Double
a2   )
    (Double
d1,Double
d2) = (,) ( Double
0.088) (-Double
0.098)
    leftLeg :: Path
leftLeg = do
      forall a. Show a => a -> a -> Path
S.l Integer
c1 Integer
c2
      forall a. Show a => a -> a -> Path
S.l Double
a1 Double
a2
      forall a. Show a => a -> a -> Path
S.l Double
b1 Double
b2
      forall a. Show a => a -> a -> Path
S.l Double
m1 Double
m2
    (Double
e1,Double
e2) = (,) ( Double
0.226) ( Double
0.54 )
    (Double
f1,Double
f2) = (,) ( Double
0.326) ( Double
0.864)
    (Double
g1,Double
g2) = (,) ( Double
0.610) ( Double
0.890)
    (Double
h1,Double
h2) = (,) ( Double
0.652) ( Double
0.576)
    (Double
j1,Double
j2) = (,) ( Double
0.710) ( Double
1.10 )
    (Double
k1,Double
k2) = (,) ( Double
0.234) ( Double
j2   )
    (Double
l1,Double
l2) = (,) ( Double
0.142) ( Double
0.60 )
    (Double
m1,Double
m2) = (,) (-Double
0.054) (-Double
0.274)
    rightLeg :: Path
rightLeg = do
      forall a. Show a => a -> a -> Path
S.m Double
d1 Double
d2
      forall a. Show a => a -> a -> Path
S.l Double
e1 Double
e2
      forall a. Show a => a -> a -> a -> a -> a -> a -> Path
S.c Double
f1 Double
f2 Double
g1 Double
g2 Double
h1 Double
h2
      forall a. Show a => a -> a -> a -> a -> a -> a -> Path
S.c Double
j1 Double
j2 Double
k1 Double
k2 Double
l1 Double
l2
    (Double
n1,Double
n2) = (,) (-Double
0.12 ) (-Double
0.86 )
    (Double
o1,Double
o2) = (,) (-Double
0.470) ( Double
n2   )
    (Double
p1,Double
p2) = (,) (-Double
0.550) (-Double
0.502)
    (Double
r1,Double
r2) = (,) (-Double
0.570) (-Double
1.06 )
    (Double
s1,Double
s2) = (,) (-Double
0.142) ( Double
r2 )
    (Double
t1,Double
t2) = (,) (-Double
0.04 ) (-Double
0.66 )
    arm :: Path
arm = do
      forall a. Show a => a -> a -> a -> a -> a -> a -> Path
S.c Double
n1 Double
n2 Double
o1 Double
o2 Double
p1 Double
p2
      forall a. Show a => a -> a -> a -> a -> a -> a -> Path
S.c Double
r1 Double
r2 Double
s1 Double
s2 Double
t1 Double
t2
      forall a. Show a => a -> a -> Path
S.l Double
d1 Double
d2



{- |
![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/math/lemniscate_fill.svg)

![fill and stroke](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/math/lemniscate_full.svg)

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/math/lemniscate_strk.svg)
-}
lemniscate :: Svg
lemniscate :: Svg
lemniscate = 
    Svg
S.path
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
dirs
  where
    k :: Double
k = Double
0.5
    r :: Double
r = Double
0.4
    dirs :: AttributeValue
dirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m  (-Double
k) (-Double
r)
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r    Double
r    Double
0    Bool
True  Bool
False  (-Double
k) ( Double
r)
      forall a. Show a => a -> a -> a -> a -> a -> a -> Path
c    Double
0    Double
r    Double
0    (-Double
r)         ( Double
k) (-Double
r)
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r    Double
r    Double
0    Bool
True  Bool
True   ( Double
k) ( Double
r)
      forall a. Show a => a -> a -> a -> a -> a -> a -> Path
c    Double
0    Double
r    Double
0    (-Double
r)         (-Double
k) (-Double
r)
      Path
S.z