{-# LANGUAGE     OverloadedStrings       #-}



module SvgIcons.Icons.Arrows
  ( svgArrows
  , curvyArrowLeft
  , curvyArrowRight
  , bigArrowLeft
  , bigArrowRight
  ) where

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

import SvgIcons.Core.Utils


{- |
A list with all the icons of this module, 
together with appropriate names.
This module contains icons suitable for the 
tool bars of a text editor (bold, italic, etc.)

>svgArrows :: [ (String , S.Svg) ]
>svgArrows =
>  [ (,) "curvyArrowLeft" curvyArrowLeft
>  , (,) "curvyArrowRight" curvyArrowRight
>  , (,) "bigArrowLeft"    bigArrowLeft
>  , (,) "bigArrowRight"   bigArrowRight
>  ]
-}
svgArrows :: [ (String , S.Svg) ]
svgArrows :: [(String, Svg)]
svgArrows =
  [ (,) String
"curvyArrowLeft"  Svg
curvyArrowLeft
  , (,) String
"curvyArrowRight" Svg
curvyArrowRight
  , (,) String
"bigArrowLeft"    Svg
bigArrowLeft
  , (,) String
"bigArrowRight"   Svg
bigArrowRight
  ]


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



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/arrows/curvyArrowLeft_strk.svg)
-}
curvyArrowLeft :: S.Svg
curvyArrowLeft :: Svg
curvyArrowLeft =
    Svg
S.path
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
d AttributeValue
dirs
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
strokeLinejoin AttributeValue
"round"
  where
    r1 :: Double
r1 = Double
0.5
    r2 :: Double
r2 = Double
0.66
    rm :: Double
rm = (Double
r2 forall a. Num a => a -> a -> a
- Double
r1)
    k1 :: Double
k1 = Double
0.24
    k2 :: Double
k2 = Double
k1 forall a. Num a => a -> a -> a
+ Double
rmforall a. Fractional a => a -> a -> a
/Double
2
    dirs :: AttributeValue
dirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m   (-Double
r1) Double
0
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa  (Double
rmforall a. Fractional a => a -> a -> a
/Double
2) (Double
rmforall a. Fractional a => a -> a -> a
/Double
2)  Double
0 Bool
False Bool
False (-Double
r2)   Double
0
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r2     Double
r2     Double
0 Bool
True  Bool
False   Double
0   (-Double
r2)
      forall a. Show a => a -> a -> Path
lr    Double
k1  (-Double
k1)
      forall a. Show a => a -> a -> Path
lr  (-Double
rm)   Double
0
      forall a. Show a => a -> a -> Path
lr  (-Double
k2)   Double
k2
      forall a. Show a => a -> a -> Path
lr    Double
k2    Double
k2
      forall a. Show a => a -> a -> Path
lr    Double
rm    Double
0
      forall a. Show a => a -> a -> Path
lr  (-Double
k1) (-Double
k1)
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r1     Double
r1     Double
0 Bool
True  Bool
True  (-Double
r1)   Double
0
      Path
S.z
    


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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/arrows/curvyArrowRight_strk.svg)
-}
curvyArrowRight :: S.Svg
curvyArrowRight :: Svg
curvyArrowRight =
    Svg
S.path
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
d AttributeValue
dirs
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
strokeLinejoin AttributeValue
"round"
  where
    r1 :: Double
r1 = Double
0.5
    r2 :: Double
r2 = Double
0.66
    rm :: Double
rm = (Double
r2 forall a. Num a => a -> a -> a
- Double
r1)
    k1 :: Double
k1 = Double
0.24
    k2 :: Double
k2 = Double
k1 forall a. Num a => a -> a -> a
+ Double
rmforall a. Fractional a => a -> a -> a
/Double
2
    dirs :: AttributeValue
dirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m   ( Double
r1) Double
0
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa  (Double
rmforall a. Fractional a => a -> a -> a
/Double
2) (Double
rmforall a. Fractional a => a -> a -> a
/Double
2)  Double
0 Bool
False Bool
True  ( Double
r2)   Double
0
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r2     Double
r2     Double
0 Bool
True  Bool
True    Double
0   (-Double
r2)
      forall a. Show a => a -> a -> Path
lr  (-Double
k1)  (-Double
k1)
      forall a. Show a => a -> a -> Path
lr  ( Double
rm)   Double
0
      forall a. Show a => a -> a -> Path
lr  ( Double
k2)   Double
k2
      forall a. Show a => a -> a -> Path
lr  (-Double
k2)   Double
k2
      forall a. Show a => a -> a -> Path
lr  (-Double
rm)   Double
0
      forall a. Show a => a -> a -> Path
lr  ( Double
k1) (-Double
k1)
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r1     Double
r1     Double
0 Bool
True  Bool
False ( Double
r1)   Double
0
      Path
S.z
    


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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/arrows/bigArrowLeft_strk.svg)
-}
bigArrowLeft :: S.Svg
bigArrowLeft :: Svg
bigArrowLeft =
    Svg
S.path
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
d AttributeValue
dirs
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
strokeLinejoin AttributeValue
"round"
  where
    k0 :: Double
k0 = Double
0.2
    y0 :: Double
y0 = Double
0.6
    x0 :: Double
x0 = Double
0.9
    x1 :: Double
x1 = Double
0.5
    x2 :: Double
x2 = Double
0.4
    x3 :: Double
x3 = Double
x1 forall a. Num a => a -> a -> a
- Double
2forall a. Num a => a -> a -> a
*Double
k0
    dirs :: AttributeValue
dirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m  ( Double
x0) (-Double
k0)
      forall a. Show a => a -> a -> Path
l  (-Double
x2) (-Double
k0)
      forall a. Show a => a -> a -> Path
l  (-Double
x3) (-Double
y0)
      forall a. Show a => a -> a -> Path
l  (-Double
x1) (-Double
y0)
      forall a. Show a => a -> a -> Path
l  (-Double
x0)   Double
0
      forall a. Show a => a -> a -> Path
l  (-Double
x1) ( Double
y0)
      forall a. Show a => a -> a -> Path
l  (-Double
x3) ( Double
y0)
      forall a. Show a => a -> a -> Path
l  (-Double
x2) ( Double
k0)
      forall a. Show a => a -> a -> Path
l  ( Double
x0) ( Double
k0)
      Path
S.z



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/arrows/bigArrowRight_strk.svg)
-}
bigArrowRight :: S.Svg
bigArrowRight :: Svg
bigArrowRight =
    Svg
S.path
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
d AttributeValue
dirs
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
strokeLinejoin AttributeValue
"round"
  where
    k0 :: Double
k0 = Double
0.2
    y0 :: Double
y0 = Double
0.6
    x0 :: Double
x0 = Double
0.9
    x1 :: Double
x1 = Double
0.5
    x2 :: Double
x2 = Double
0.4
    x3 :: Double
x3 = Double
x1 forall a. Num a => a -> a -> a
- Double
2forall a. Num a => a -> a -> a
*Double
k0
    dirs :: AttributeValue
dirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m  (-Double
x0) (-Double
k0)
      forall a. Show a => a -> a -> Path
l  ( Double
x2) (-Double
k0)
      forall a. Show a => a -> a -> Path
l  ( Double
x3) (-Double
y0)
      forall a. Show a => a -> a -> Path
l  ( Double
x1) (-Double
y0)
      forall a. Show a => a -> a -> Path
l    Double
x0    Double
0
      forall a. Show a => a -> a -> Path
l  ( Double
x1) ( Double
y0)
      forall a. Show a => a -> a -> Path
l  ( Double
x3) ( Double
y0)
      forall a. Show a => a -> a -> Path
l  ( Double
x2) ( Double
k0)
      forall a. Show a => a -> a -> Path
l  (-Double
x0) ( Double
k0)
      Path
S.z