{-# LANGUAGE     OverloadedStrings       #-}



module SvgIcons.Icons.Coding
  ( svgCoding
  , xmlCode
  , haskell
  , git
  ) 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 =
>  [ (,) "xmlCode" xmlCode
>  , (,) "haskell" haskell
>  , (,) "git"     git
>  ]
-}
svgCoding :: [ (String , S.Svg) ]
svgCoding :: [(String, Svg)]
svgCoding =
  [ (,) String
"xmlCode" Svg
xmlCode
  , (,) String
"haskell" Svg
haskell
  , (,) String
"git"     Svg
git
  ]



{- |
![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 
      (Svg -> Svg) -> Attribute -> Svg -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__xmlCode"
      (Svg -> Svg) -> Svg -> Svg
forall a b. (a -> b) -> a -> b
$ do
        Svg -> Svg
S.defs (Svg -> Svg) -> Svg -> Svg
forall a b. (a -> b) -> a -> b
$ 
          Svg
S.path
            Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id_ AttributeValue
"HaskellSvgIcons-xmlCode-triangle"
            Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
triangleDirs
            Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeLinejoin AttributeValue
"round"
        Svg
S.use
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.xlinkHref AttributeValue
"#HaskellSvgIcons-xmlCode-triangle"
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (Integer -> Integer -> Integer -> AttributeValue
forall a. Show a => a -> a -> a -> AttributeValue
rotateAround Integer
315 Integer
0 Integer
0)
        Svg
S.use
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.xlinkHref AttributeValue
"#HaskellSvgIcons-xmlCode-triangle"
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (Integer -> Integer -> Integer -> AttributeValue
forall a. Show a => a -> a -> a -> AttributeValue
rotateAround Integer
135 Integer
0 Integer
0)
        Svg
S.path
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
barDirs
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (Integer -> Integer -> Integer -> AttributeValue
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
k1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
    k3 :: Double
k3 = Double
0.55
    triangleDirs :: AttributeValue
triangleDirs = Path -> AttributeValue
mkPath (Path -> AttributeValue) -> Path -> AttributeValue
forall a b. (a -> b) -> a -> b
$ do
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
m   Double
k1   Double
k1
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
k0   Double
k1
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
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
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
k2   Double
k2
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
k2   Double
k0
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
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 (Path -> AttributeValue) -> Path -> AttributeValue
forall a b. (a -> b) -> a -> b
$ do
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
m  (-Double
r1)  Double
k3
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
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
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l    Double
r1 (-Double
k3)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
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



{- |
![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
      (Svg -> Svg) -> Attribute -> Svg -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__haskell"
      (Svg -> Svg) -> Svg -> Svg
forall a b. (a -> b) -> a -> b
$ do
        Svg
S.path
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"#453a62"
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
leftDirs
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id_ AttributeValue
"HaskellSvgIcons-haskellLogo-left"
        Svg
S.path
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"#5e5086"
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
midDirs
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id_ AttributeValue
"HaskellSvgIcons-haskellLogo-mid"
        Svg
S.path
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"#8f4e8b"
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
rightDirs
          Svg -> Attribute -> Svg
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ks Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
17
    ty :: Double
ty = -Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ks Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
12
    f :: Double -> Double
f Double
x = Double
ks Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
tx
    g :: Double -> Double
g Double
y = Double
ks Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y Double -> Double -> Double
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 (Path -> AttributeValue) -> Path -> AttributeValue
forall a b. (a -> b) -> a -> b
$ do
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
m   Double
x1   Double
y1
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x2   Double
y1
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x4   Double
y4
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x2   Double
y8
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x1   Double
y8
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x3   Double
y4
      Path
S.z
    midDirs :: AttributeValue
midDirs = Path -> AttributeValue
mkPath (Path -> AttributeValue) -> Path -> AttributeValue
forall a b. (a -> b) -> a -> b
$ do
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
m   Double
x3   Double
y1
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x4   Double
y1
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x12  Double
y8
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x9   Double
y8
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x6   Double
y6
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x4   Double
y8
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x3   Double
y8
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x5   Double
y4
      Path
S.z
    rightDirs :: AttributeValue
rightDirs = Path -> AttributeValue
mkPath (Path -> AttributeValue) -> Path -> AttributeValue
forall a b. (a -> b) -> a -> b
$ do
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
m   Double
x8   Double
y3
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x7   Double
y2
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x13  Double
y2
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x13  Double
y3
      Path
S.z
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
m   Double
x11  Double
y7
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x10  Double
y5
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x13  Double
y5
      Double -> Double -> Path
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/git_fill.svg)

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

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

Note: if you want to use a stroked version, you can embed this icon in a bigger viewbox such as @"-1.2 -1.2 2.4 2.4"@ or scale down:

> git
>   ! A.transform (S.scale 0.8 0.8)
-}
git :: Svg
git :: Svg
git = 
    Svg -> Svg
S.g 
      (Svg -> Svg) -> Attribute -> Svg -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__git"
      (Svg -> Svg) -> Svg -> Svg
forall a b. (a -> b) -> a -> b
$
        Svg
S.path
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
dirs
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"#F03C2E"
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (Integer -> Integer -> Integer -> AttributeValue
forall a. Show a => a -> a -> a -> AttributeValue
rotateAround Integer
45 Integer
0 Integer
0)
  where
    r0 :: Double
r0 =  Double
0.13
    r1 :: Double
r1 =  Double
0.153
    r2 :: Double
r2 =  Double
0.149
    m0 :: Double
m0 =  Double
0.745
    y1 :: Double
y1 = -Double
0.355
    y2 :: Double
y2 = -Double
0.23
    x1 :: Double
x1 = -Double
0.42
    x2 :: Double
x2 = -Double
0.145
    x3 :: Double
x3 =  Double
0.17
    k0 :: Double
k0 = (Double
y2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y1)
    k1 :: Double
k1 =  Double
0.38
    dirs :: AttributeValue
dirs = Path -> AttributeValue
mkPath (Path -> AttributeValue) -> Path -> AttributeValue
forall a b. (a -> b) -> a -> b
$ do
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
m  (-Double
m0)        Double
y2
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l  (-Double
m0)      ( Double
m0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r0)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r0   Double
r0    Double
0  Bool
False Bool
False (-Double
m0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r0)   Double
m0
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l  ( Double
m0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r0)   Double
m0
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r0   Double
r0    Double
0  Bool
False Bool
False   Double
m0       ( Double
m0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r0)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l    Double
m0       (-Double
m0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r0)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r0   Double
r0    Double
0  Bool
False Bool
False ( Double
m0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r0) (-Double
m0) 
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l  (-Double
m0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r0) (-Double
m0)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r0   Double
r0    Double
0  Bool
False Bool
False (-Double
m0)      (-Double
m0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r0)
      ---

      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l  (-Double
m0)  Double
y1
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l    Double
x1   Double
y1
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r2   Double
r2    Double
0  Bool
False Bool
True   Double
x2  Double
y1
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l    Double
x3   Double
y1
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r1   Double
r1    Double
0  Bool
True  Bool
True   Double
x3  Double
y2
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l  ( Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.02) Double
y2
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
lr   Double
k1   Double
k1
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
ar   Double
r1   Double
r1    Double
0  Bool
True  Bool
True  (-Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
k0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sqrt Double
2) ( Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
k0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sqrt Double
2)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
lr (-Double
k1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.01) (-Double
k1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.01)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r2   Double
r2    Double
0  Bool
False Bool
True   Double
x1  Double
y2
      Path
S.z