{-# LANGUAGE     OverloadedStrings       #-}


{- |
Module for logos.
-}
module SvgIcons.Images.Logos 
  ( logos
  , haskell
  ) 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 logos from this module,
together with appropriate names.

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


{- |
Haskell logo

viewbox is "0 0 17 12"

![Haskell logo](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/images/logos/haskell.svg)
-}
haskell :: Svg
haskell :: Svg
haskell =
    Svg -> Svg
svg
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.viewbox AttributeValue
"0 0 17 12"
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.height AttributeValue
"120px"
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.width  AttributeValue
"170px"
      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
    x1 :: Integer
x1  = Integer
0
    x2 :: Integer
x2  = Integer
3
    x3 :: Integer
x3  = Integer
4
    x4 :: Integer
x4  = Integer
7
    x5 :: Integer
x5  = Integer
8
    x6 :: Double
x6  = Double
9.5
    x7 :: Double
x7  = Double
10.33
    x8 :: Double
x8  = Double
11.66
    x9 :: Integer
x9  = Integer
12
    x10 :: Double
x10 = Double
12.33
    x11 :: Double
x11 = Double
13.66
    x12 :: Integer
x12 = Integer
15
    x13 :: Double
x13 = Double
17
    y1 :: Integer
y1  = Integer
0
    y2 :: Double
y2  = Double
3.5
    y3 :: Double
y3  = Double
5.5
    y4 :: Integer
y4  = Integer
6
    y5 :: Double
y5  = Double
6.5
    y6 :: Double
y6  = Double
8.25
    y7 :: Double
y7  = Double
8.5
    y8 :: Integer
y8  = Integer
12
    leftDirs :: AttributeValue
leftDirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m   Integer
x1   Integer
y1
      forall a. Show a => a -> a -> Path
l   Integer
x2   Integer
y1
      forall a. Show a => a -> a -> Path
l   Integer
x4   Integer
y4
      forall a. Show a => a -> a -> Path
l   Integer
x2   Integer
y8
      forall a. Show a => a -> a -> Path
l   Integer
x1   Integer
y8
      forall a. Show a => a -> a -> Path
l   Integer
x3   Integer
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   Integer
x3   Integer
y1
      forall a. Show a => a -> a -> Path
l   Integer
x4   Integer
y1
      forall a. Show a => a -> a -> Path
l   Integer
x12  Integer
y8
      forall a. Show a => a -> a -> Path
l   Integer
x9   Integer
y8
      forall a. Show a => a -> a -> Path
l   Double
x6   Double
y6
      forall a. Show a => a -> a -> Path
l   Integer
x4   Integer
y8
      forall a. Show a => a -> a -> Path
l   Integer
x3   Integer
y8
      forall a. Show a => a -> a -> Path
l   Integer
x5   Integer
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