{-# LANGUAGE     OverloadedStrings       #-}



module SvgIcons.Icons.Coding
  ( svgCoding
  , haskell
  , xmlCode
  ) where

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

import SvgIcons.Core.Geometry
import SvgIcons.Core.Utils


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

>svgCoding :: [ (String , S.Svg) ]
>svgCoding =
>  [ (,) "haskell" haskell
<  , (,) "xmlCode" xmlCode
>  ]
-}
svgCoding :: [ (String , S.Svg) ]
svgCoding :: [(String, Svg)]
svgCoding =
  [ (,) String
"haskell" Svg
haskell
  , (,) String
"xmlCode" Svg
xmlCode
  ]


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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/coding/haskell_strk.svg)

Note: you can remove fill colors with CSS:

>path {
>  fill: none;
>}
-}
haskell :: Svg
haskell :: Svg
haskell =
    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.fill AttributeValue
"#453a62"
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
leftDirs
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id_ AttributeValue
"HaskellSvgIcons-haskellLogo-left"
        Svg
S.path
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"#5e5086"
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
midDirs
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id_ AttributeValue
"HaskellSvgIcons-haskellLogo-mid"
        Svg
S.path
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"#8f4e8b"
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
rightDirs
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id_ AttributeValue
"HaskellSvgIcons-haskellLogo-right"
  where
    ks :: Double
ks = Double
0.112
    tx :: Double
tx = -Double
0.5 forall a. Num a => a -> a -> a
* Double
ks forall a. Num a => a -> a -> a
* Double
17
    ty :: Double
ty = -Double
0.5 forall a. Num a => a -> a -> a
* Double
ks forall a. Num a => a -> a -> a
* Double
12
    f :: Double -> Double
f Double
x = Double
ks forall a. Num a => a -> a -> a
* Double
x forall a. Num a => a -> a -> a
+ Double
tx
    g :: Double -> Double
g Double
y = Double
ks forall a. Num a => a -> a -> a
* Double
y forall a. Num a => a -> a -> a
+ Double
ty
    x1 :: Double
x1  = Double -> Double
f Double
0
    x2 :: Double
x2  = Double -> Double
f Double
3
    x3 :: Double
x3  = Double -> Double
f Double
4
    x4 :: Double
x4  = Double -> Double
f Double
7
    x5 :: Double
x5  = Double -> Double
f Double
8
    x6 :: Double
x6  = Double -> Double
f Double
9.5
    x7 :: Double
x7  = Double -> Double
f Double
10.33
    x8 :: Double
x8  = Double -> Double
f Double
11.66
    x9 :: Double
x9  = Double -> Double
f Double
12
    x10 :: Double
x10 = Double -> Double
f Double
12.33
    x11 :: Double
x11 = Double -> Double
f Double
13.66
    x12 :: Double
x12 = Double -> Double
f Double
15
    x13 :: Double
x13 = Double -> Double
f Double
17
    y1 :: Double
y1  = Double -> Double
g Double
0
    y2 :: Double
y2  = Double -> Double
g Double
3.5
    y3 :: Double
y3  = Double -> Double
g Double
5.5
    y4 :: Double
y4  = Double -> Double
g Double
6
    y5 :: Double
y5  = Double -> Double
g Double
6.5
    y6 :: Double
y6  = Double -> Double
g Double
8.25
    y7 :: Double
y7  = Double -> Double
g Double
8.5
    y8 :: Double
y8  = Double -> Double
g Double
12
    leftDirs :: AttributeValue
leftDirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m   Double
x1   Double
y1
      forall a. Show a => a -> a -> Path
l   Double
x2   Double
y1
      forall a. Show a => a -> a -> Path
l   Double
x4   Double
y4
      forall a. Show a => a -> a -> Path
l   Double
x2   Double
y8
      forall a. Show a => a -> a -> Path
l   Double
x1   Double
y8
      forall a. Show a => a -> a -> Path
l   Double
x3   Double
y4
      Path
S.z
    midDirs :: AttributeValue
midDirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m   Double
x3   Double
y1
      forall a. Show a => a -> a -> Path
l   Double
x4   Double
y1
      forall a. Show a => a -> a -> Path
l   Double
x12  Double
y8
      forall a. Show a => a -> a -> Path
l   Double
x9   Double
y8
      forall a. Show a => a -> a -> Path
l   Double
x6   Double
y6
      forall a. Show a => a -> a -> Path
l   Double
x4   Double
y8
      forall a. Show a => a -> a -> Path
l   Double
x3   Double
y8
      forall a. Show a => a -> a -> Path
l   Double
x5   Double
y4
      Path
S.z
    rightDirs :: AttributeValue
rightDirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m   Double
x8   Double
y3
      forall a. Show a => a -> a -> Path
l   Double
x7   Double
y2
      forall a. Show a => a -> a -> Path
l   Double
x13  Double
y2
      forall a. Show a => a -> a -> Path
l   Double
x13  Double
y3
      Path
S.z
      forall a. Show a => a -> a -> Path
m   Double
x11  Double
y7
      forall a. Show a => a -> a -> Path
l   Double
x10  Double
y5
      forall a. Show a => a -> a -> Path
l   Double
x13  Double
y5
      forall a. Show a => a -> a -> Path
l   Double
x13  Double
y7
      Path
S.z

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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/coding/xmlCode_strk.svg)
-}
xmlCode :: Svg
xmlCode :: Svg
xmlCode =
    Svg -> Svg
S.g forall a b. (a -> b) -> a -> b
$ do
      Svg -> Svg
S.defs forall a b. (a -> b) -> a -> b
$ 
        Svg
S.path
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id_ AttributeValue
"HaskellSvgIcons-xmlCode-triangle"
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
triangleDirs
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeLinejoin AttributeValue
"round"
      Svg
S.use
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.xlinkHref AttributeValue
"#HaskellSvgIcons-xmlCode-triangle"
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (forall a. Show a => a -> a -> a -> AttributeValue
rotateAround Integer
315 Integer
0 Integer
0)
      Svg
S.use
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.xlinkHref AttributeValue
"#HaskellSvgIcons-xmlCode-triangle"
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (forall a. Show a => a -> a -> a -> AttributeValue
rotateAround Integer
135 Integer
0 Integer
0)
      Svg
S.path
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
barDirs
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (forall a. Show a => a -> a -> a -> AttributeValue
rotateAround  Integer
11 Integer
0 Integer
0)
  where
    k0 :: Double
k0 = Double
0.1
    k1 :: Double
k1 = Double
0.5
    k2 :: Double
k2 = Double
0.7
    r1 :: Double
r1 = (Double
k2 forall a. Num a => a -> a -> a
- Double
k1) forall a. Fractional a => a -> a -> a
/ Double
2
    k3 :: Double
k3 = Double
0.55
    triangleDirs :: AttributeValue
triangleDirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m   Double
k1   Double
k1
      forall a. Show a => a -> a -> Path
l   Double
k0   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
k0  Double
k2
      forall a. Show a => a -> a -> Path
l   Double
k2   Double
k2
      forall a. Show a => a -> a -> Path
l   Double
k2   Double
k0
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa  Double
r1   Double
r1  Double
0  Bool
True  Bool
False Double
k1  Double
k0
      Path
S.z
    barDirs :: AttributeValue
barDirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m  (-Double
r1)  Double
k3
      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
k3
      forall a. Show a => a -> a -> Path
l    Double
r1 (-Double
k3)
      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
k3)
      Path
S.z