{-# LANGUAGE     OverloadedStrings       #-}



module SvgIcons.Icons.Business 
  ( svgBusiness
  , analytics
  , bullseye
  , company
  , connections
  , creditCard
  , creditIn
  , creditOut
  , coinColumn
  , coinPile
  ) where

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

import SvgIcons.Core.Utils
import SvgIcons.Icons.Arrows (bigArrowLeft, bigArrowRight)



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

>svgBusiness :: [ (String , S.Svg) ]
>svgBusiness =
>  [ (,) "analytics"   analytics
>  , (,) "bullseye"    bullseye
>  , (,) "company"     company
>  , (,) "connections" connections
>  , (,) "creditCard"  creditCard
>  , (,) "creditIn"    creditIn
>  , (,) "creditOut"   creditOut
>  , (,) "coinPile"    coinPile
>  ]
-}
svgBusiness :: [ (String , S.Svg) ]
svgBusiness :: [(String, MarkupM ())]
svgBusiness =
  [ (,) String
"analytics"   MarkupM ()
analytics
  , (,) String
"bullseye"    MarkupM ()
bullseye
  , (,) String
"company"     MarkupM ()
company
  , (,) String
"connections" MarkupM ()
connections
  , (,) String
"creditCard"  MarkupM ()
creditCard
  , (,) String
"creditIn"    MarkupM ()
creditIn
  , (,) String
"creditOut"   MarkupM ()
creditOut
  , (,) String
"coinPile"    MarkupM ()
coinPile
  ]


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


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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/business/company_strk.svg)
-}
company :: S.Svg
company :: MarkupM ()
company =
  MarkupM () -> MarkupM ()
S.g 
    forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__company"
    forall a b. (a -> b) -> a -> b
$ do
      MarkupM ()
S.path
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
d AttributeValue
leftBuildingPath
      MarkupM ()
S.path
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
d AttributeValue
leftWindowsPath
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
strokeDasharray AttributeValue
"0.12 0.06"
      MarkupM ()
S.path
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
d AttributeValue
rightBuildingPath
      MarkupM ()
S.path
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
d AttributeValue
rightWindowsPath
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
strokeDasharray AttributeValue
"0.05"
  where
    x1 :: Double
x1 = -Double
0.92
    x2 :: Double
x2 = -Double
0.72
    x3 :: Double
x3 =  Double
0
    x4 :: Double
x4 =  Double
0.22
    x5 :: Double
x5 =  Double
0.92
    y1 :: Double
y1 = -Double
0.9
    y2 :: Double
y2 = -Double
0.75
    y3 :: Double
y3 = (Double
y1 forall a. Num a => a -> a -> a
+ Double
y4) forall a. Fractional a => a -> a -> a
/ Double
2
    y4 :: Double
y4 = -Double
0.3
    y5 :: Double
y5 = -Double
0.2
    y6 :: Double
y6 =  Double
0.8
    y7 :: Double
y7 =  Double
0.9
    k1 :: Double
k1 = (Double
x3 forall a. Num a => a -> a -> a
- Double
x2) forall a. Fractional a => a -> a -> a
/ Double
3
    k2 :: Double
k2 = (Double
x5 forall a. Num a => a -> a -> a
- Double
x4) forall a. Fractional a => a -> a -> a
/ Double
4
    doorH :: Double
doorH = Double
0.24
    ----------------------------------------

    leftBuildingPath :: AttributeValue
leftBuildingPath =
      Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
        forall a. Show a => a -> a -> Path
m   Double
x1  Double
y7
        forall a. Show a => a -> a -> Path
l   Double
x1  Double
y2
        forall a. Show a => a -> a -> Path
l   Double
x2  Double
y2
        forall a. Show a => a -> a -> Path
l   Double
x2  Double
y1
        forall a. Show a => a -> a -> Path
l   Double
x3  Double
y1
        forall a. Show a => a -> a -> Path
l   Double
x3  Double
y2
        forall a. Show a => a -> a -> Path
l   Double
x4  Double
y2
        forall a. Show a => a -> a -> Path
l   Double
x4  Double
y7
        Path
doorPath
        Path
S.z
    rightBuildingPath :: AttributeValue
rightBuildingPath =
      Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
        forall a. Show a => a -> a -> Path
m   Double
x4  Double
y4
        forall a. Show a => a -> a -> Path
l   Double
x5  Double
y4
        forall a. Show a => a -> a -> Path
l   Double
x5  Double
y7
        forall a. Show a => a -> a -> Path
l   Double
x4  Double
y7
        Path
S.z
    doorPath :: Path
doorPath = 
      do
        forall a. Show a => a -> a -> Path
l (Double
x2 forall a. Num a => a -> a -> a
+ Double
2forall a. Num a => a -> a -> a
*Double
k1)  Double
y7
        forall a. Show a => a -> a -> Path
l (Double
x2 forall a. Num a => a -> a -> a
+ Double
2forall a. Num a => a -> a -> a
*Double
k1) (Double
y7 forall a. Num a => a -> a -> a
- Double
doorH)
        forall a. Show a => a -> a -> Path
l (Double
x2 forall a. Num a => a -> a -> a
+   Double
k1) (Double
y7 forall a. Num a => a -> a -> a
- Double
doorH)
        forall a. Show a => a -> a -> Path
l (Double
x2 forall a. Num a => a -> a -> a
+   Double
k1)  Double
y7
    leftWindowsPath :: AttributeValue
leftWindowsPath =
      Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
        forall a. Show a => a -> a -> Path
m   (Double
x2 forall a. Num a => a -> a -> a
+ Double
0forall a. Num a => a -> a -> a
*Double
k1)  Double
y3
        forall a. Show a => a -> a -> Path
l   (Double
x2 forall a. Num a => a -> a -> a
+ Double
0forall a. Num a => a -> a -> a
*Double
k1)  Double
y6
        forall a. Show a => a -> a -> Path
m   (Double
x2 forall a. Num a => a -> a -> a
+ Double
1forall a. Num a => a -> a -> a
*Double
k1)  Double
y3
        forall a. Show a => a -> a -> Path
l   (Double
x2 forall a. Num a => a -> a -> a
+ Double
1forall a. Num a => a -> a -> a
*Double
k1)  (Double
y7 forall a. Num a => a -> a -> a
- Double
1.5 forall a. Num a => a -> a -> a
* Double
doorH)
        forall a. Show a => a -> a -> Path
m   (Double
x2 forall a. Num a => a -> a -> a
+ Double
2forall a. Num a => a -> a -> a
*Double
k1)  Double
y3
        forall a. Show a => a -> a -> Path
l   (Double
x2 forall a. Num a => a -> a -> a
+ Double
2forall a. Num a => a -> a -> a
*Double
k1)  (Double
y7 forall a. Num a => a -> a -> a
- Double
1.5 forall a. Num a => a -> a -> a
* Double
doorH)
        forall a. Show a => a -> a -> Path
m   (Double
x2 forall a. Num a => a -> a -> a
+ Double
3forall a. Num a => a -> a -> a
*Double
k1)  Double
y3
        forall a. Show a => a -> a -> Path
l   (Double
x2 forall a. Num a => a -> a -> a
+ Double
3forall a. Num a => a -> a -> a
*Double
k1)  Double
y6
    rightWindowsPath :: AttributeValue
rightWindowsPath =
      Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
        forall a. Show a => a -> a -> Path
m   (Double
x4 forall a. Num a => a -> a -> a
+ Double
1forall a. Num a => a -> a -> a
*Double
k2)  Double
y5
        forall a. Show a => a -> a -> Path
l   (Double
x4 forall a. Num a => a -> a -> a
+ Double
1forall a. Num a => a -> a -> a
*Double
k2)  Double
y6
        forall a. Show a => a -> a -> Path
m   (Double
x4 forall a. Num a => a -> a -> a
+ Double
2forall a. Num a => a -> a -> a
*Double
k2)  Double
y5
        forall a. Show a => a -> a -> Path
l   (Double
x4 forall a. Num a => a -> a -> a
+ Double
2forall a. Num a => a -> a -> a
*Double
k2)  Double
y6
        forall a. Show a => a -> a -> Path
m   (Double
x4 forall a. Num a => a -> a -> a
+ Double
3forall a. Num a => a -> a -> a
*Double
k2)  Double
y5
        forall a. Show a => a -> a -> Path
l   (Double
x4 forall a. Num a => a -> a -> a
+ Double
3forall a. Num a => a -> a -> a
*Double
k2)  Double
y6



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/business/connections_strk.svg)
-}
connections :: Svg
connections :: MarkupM ()
connections = 
    MarkupM () -> MarkupM ()
S.g 
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__connections"
      forall a b. (a -> b) -> a -> b
$ do
        Float -> Float -> Float -> MarkupM ()
circ Float
x0 Float
y0 Float
r0
        Float -> Float -> Float -> MarkupM ()
circ Float
x1 Float
y1 Float
r1
        Float -> Float -> Float -> MarkupM ()
circ Float
x2 Float
y2 Float
r2
        Float -> Float -> Float -> MarkupM ()
circ Float
x3 Float
y3 Float
r3
        Float -> Float -> Float -> MarkupM ()
circ Float
x4 Float
y4 Float
r4
        Float -> Float -> Float -> MarkupM ()
circ Float
x5 Float
y5 Float
r5
        Float -> Float -> Float -> MarkupM ()
circ Float
x6 Float
y6 Float
r6
        Float -> Float -> Float -> MarkupM ()
circ Float
x7 Float
y7 Float
r7
        Float -> Float -> Float -> MarkupM ()
circ Float
x8 Float
y8 Float
r8
        Float -> Float -> Float -> MarkupM ()
circ Float
x9 Float
y9 Float
r9
        MarkupM ()
S.path
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"none"
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
d (Path -> AttributeValue
mkPath Path
connectingLines)
  where
    rad1 :: Float
rad1 = Float
0.2
    rad2 :: Float
rad2 = Float
0.12
    (Float
x0,Float
y0,Float
r0) = (,,)  ( Float
0   )  ( Float
0   )  Float
0.3
    (Float
x1,Float
y1,Float
r1) = (,,)  (-Float
0.64)  ( Float
0   )  Float
rad1
    (Float
x2,Float
y2,Float
r2) = (,,)  ( Float
0.56)  (-Float
0.4 )  Float
rad1
    (Float
x3,Float
y3,Float
r3) = (,,)  ( Float
0.56)  ( Float
0.4 )  Float
rad1
    (Float
x4,Float
y4,Float
r4) = (,,)  (-Float
0.64)  (-Float
0.6 )  Float
rad2
    (Float
x5,Float
y5,Float
r5) = (,,)  (-Float
0.82)  ( Float
0.4 )  Float
rad2
    (Float
x6,Float
y6,Float
r6) = (,,)  (-Float
0.4 )  ( Float
0.7 )  Float
rad2
    (Float
x7,Float
y7,Float
r7) = (,,)  ( Float
0.1 )  (-Float
0.74)  Float
rad2
    (Float
x8,Float
y8,Float
r8) = (,,)  ( Float
0.80)  (-Float
0.8 )  Float
rad2
    (Float
x9,Float
y9,Float
r9) = (,,)  ( Float
0.56)  ( Float
0.8 )  Float
rad2
    circ :: Float -> Float -> Float -> MarkupM ()
circ Float
c1 Float
c2 Float
radius =
      MarkupM ()
circle
        forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
cx (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
c1) 
        forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
cy (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
c2) 
        forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
r (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
radius)
    connect :: (Float, Float, Float) -> (Float, Float, Float) -> Path
connect (Float
p1,Float
p2,Float
radius1) (Float
q1,Float
q2,Float
radius2) =
      let
        d :: Float
d = (Float, Float) -> (Float, Float) -> Float
distance (Float
p1,Float
p2) (Float
q1,Float
q2)
        k1 :: Float
k1 = Float
radius1 forall a. Fractional a => a -> a -> a
/ Float
d
        k2 :: Float
k2 = Float
radius2 forall a. Fractional a => a -> a -> a
/ Float
d
      in do
        forall a. Show a => a -> a -> Path
m  (Float
k2forall a. Num a => a -> a -> a
*Float
p1 forall a. Num a => a -> a -> a
+ Float
q1 forall a. Num a => a -> a -> a
- Float
k2forall a. Num a => a -> a -> a
*Float
q1)  (Float
k2forall a. Num a => a -> a -> a
*Float
p2 forall a. Num a => a -> a -> a
+ Float
q2 forall a. Num a => a -> a -> a
- Float
k2forall a. Num a => a -> a -> a
*Float
q2)
        forall a. Show a => a -> a -> Path
l  (Float
p1 forall a. Num a => a -> a -> a
- Float
k1forall a. Num a => a -> a -> a
*Float
p1 forall a. Num a => a -> a -> a
+ Float
k1forall a. Num a => a -> a -> a
*Float
q1)  (Float
p2 forall a. Num a => a -> a -> a
- Float
k1forall a. Num a => a -> a -> a
*Float
p2 forall a. Num a => a -> a -> a
+ Float
k1forall a. Num a => a -> a -> a
*Float
q2)
    connectingLines :: Path
connectingLines = do
      (Float, Float, Float) -> (Float, Float, Float) -> Path
connect (Float
x0,Float
y0,Float
r0) (Float
x1,Float
y1,Float
r1)
      (Float, Float, Float) -> (Float, Float, Float) -> Path
connect (Float
x0,Float
y0,Float
r0) (Float
x2,Float
y2,Float
r2)
      (Float, Float, Float) -> (Float, Float, Float) -> Path
connect (Float
x0,Float
y0,Float
r0) (Float
x3,Float
y3,Float
r3)
      (Float, Float, Float) -> (Float, Float, Float) -> Path
connect (Float
x1,Float
y1,Float
r1) (Float
x4,Float
y4,Float
r4)
      (Float, Float, Float) -> (Float, Float, Float) -> Path
connect (Float
x1,Float
y1,Float
r1) (Float
x5,Float
y5,Float
r5)
      (Float, Float, Float) -> (Float, Float, Float) -> Path
connect (Float
x1,Float
y1,Float
r1) (Float
x6,Float
y6,Float
r6)
      (Float, Float, Float) -> (Float, Float, Float) -> Path
connect (Float
x2,Float
y2,Float
r2) (Float
x7,Float
y7,Float
r7)
      (Float, Float, Float) -> (Float, Float, Float) -> Path
connect (Float
x2,Float
y2,Float
r2) (Float
x8,Float
y8,Float
r8)
      (Float, Float, Float) -> (Float, Float, Float) -> Path
connect (Float
x3,Float
y3,Float
r3) (Float
x9,Float
y9,Float
r9)



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/business/analytics_strk.svg)
-}
analytics :: Svg
analytics :: MarkupM ()
analytics = 
    MarkupM () -> MarkupM ()
S.g 
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__analytics"
      forall a b. (a -> b) -> a -> b
$ do
        MarkupM ()
S.path
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"none"
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
axesPath
        MarkupM ()
S.path forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d (Double -> Double -> AttributeValue
bar Double
x1 Double
y1)
        MarkupM ()
S.path forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d (Double -> Double -> AttributeValue
bar Double
x2 Double
y2)
        MarkupM ()
S.path forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d (Double -> Double -> AttributeValue
bar Double
x3 Double
y3)
  where
    ax :: Double
ax =  Double
0.96
    ay :: Double
ay =  Double
0.96
    w :: Double
w  =  Double
0.14
    x1 :: Double
x1 = -Double
0.5
    x2 :: Double
x2 =  Double
0
    x3 :: Double
x3 =  Double
0.5
    y1 :: Double
y1 = -Double
0.1
    y2 :: Double
y2 = -Double
0.4
    y3 :: Double
y3 = -Double
0.7
    axesPath :: AttributeValue
axesPath = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m  (-Double
ax)  (-Double
ay)
      forall a. Show a => a -> a -> Path
l  (-Double
ax)  ( Double
ay)
      forall a. Show a => a -> a -> Path
l  ( Double
ax)  ( Double
ay)
    bar :: Double -> Double -> AttributeValue
bar Double
px Double
py = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m  (Double
px forall a. Num a => a -> a -> a
- Double
w)  Double
ay
      forall a. Show a => a -> a -> Path
l  (Double
px forall a. Num a => a -> a -> a
- Double
w)  Double
py
      forall a. Show a => a -> a -> Path
l  (Double
px forall a. Num a => a -> a -> a
+ Double
w)  Double
py
      forall a. Show a => a -> a -> Path
l  (Double
px forall a. Num a => a -> a -> a
+ Double
w)  Double
ay
      Path
S.z



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/business/bullseye_strk.svg)
-}
bullseye :: Svg
bullseye :: MarkupM ()
bullseye = 
    MarkupM () -> MarkupM ()
S.g 
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__bullseye"
      forall a b. (a -> b) -> a -> b
$ do
        MarkupM ()
S.path
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeLinecap AttributeValue
"round"
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
circles
        MarkupM ()
S.path
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
strokeLinecap AttributeValue
"round"
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
fill AttributeValue
"none"
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d (Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ Path
stick forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Path
feathers)
  where
    distanceToCenter :: Float -> Float -> Float
distanceToCenter Float
x Float
y = (Float, Float) -> (Float, Float) -> Float
distance (Float
x,Float
y) (Float
0,Float
0)
    (Float
p1,Float
k1) = (,) (-Float
0.6 )  Float
0.1
    (Float
p2,Float
k2) = (,) (-Float
0.44)  Float
0.07
    (Float
p3,Float
k3) = (,) (-Float
0.28)  Float
0.07
    (Float
p4,Float
k4) = (,) (-Float
0.12)  Float
0.05
    d1 :: Float
d1 = Float -> Float -> Float
distanceToCenter (Float
p1 forall a. Num a => a -> a -> a
+ Float
k1) (Float
p1 forall a. Num a => a -> a -> a
- Float
k1)
    d2 :: Float
d2 = Float -> Float -> Float
distanceToCenter (Float
p2 forall a. Num a => a -> a -> a
+ Float
k2) (Float
p2 forall a. Num a => a -> a -> a
- Float
k2)
    d3 :: Float
d3 = Float -> Float -> Float
distanceToCenter (Float
p3 forall a. Num a => a -> a -> a
+ Float
k3) (Float
p3 forall a. Num a => a -> a -> a
- Float
k3)
    d4 :: Float
d4 = Float -> Float -> Float
distanceToCenter (Float
p4 forall a. Num a => a -> a -> a
+ Float
k4) (Float
p4 forall a. Num a => a -> a -> a
- Float
k4)
    circles :: AttributeValue
circles = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m                         (Float
p1 forall a. Num a => a -> a -> a
+ Float
k1) (Float
p1 forall a. Num a => a -> a -> a
- Float
k1)
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa  Float
d1 Float
d1  Float
0  Bool
True  Bool
True  (Float
p1 forall a. Num a => a -> a -> a
- Float
k1) (Float
p1 forall a. Num a => a -> a -> a
+ Float
k1)
      forall a. Show a => a -> a -> Path
m                         (Float
p2 forall a. Num a => a -> a -> a
+ Float
k2) (Float
p2 forall a. Num a => a -> a -> a
- Float
k2)
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa  Float
d2 Float
d2  Float
0  Bool
True  Bool
True  (Float
p2 forall a. Num a => a -> a -> a
- Float
k2) (Float
p2 forall a. Num a => a -> a -> a
+ Float
k2)
      forall a. Show a => a -> a -> Path
m                         (Float
p3 forall a. Num a => a -> a -> a
+ Float
k3) (Float
p3 forall a. Num a => a -> a -> a
- Float
k3)
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa  Float
d3 Float
d3  Float
0  Bool
True  Bool
True  (Float
p3 forall a. Num a => a -> a -> a
- Float
k3) (Float
p3 forall a. Num a => a -> a -> a
+ Float
k3)
      forall a. Show a => a -> a -> Path
m                         (Float
p4 forall a. Num a => a -> a -> a
+ Float
k4) (Float
p4 forall a. Num a => a -> a -> a
- Float
k4)
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa  Float
d4 Float
d4  Float
0  Bool
True  Bool
True  (Float
p4 forall a. Num a => a -> a -> a
- Float
k4) (Float
p4 forall a. Num a => a -> a -> a
+ Float
k4)
    fl :: Double
fl = Double
0.2   -- feather length

    q1 :: Double
q1 = -Double
0.76
    q2 :: Double
q2 = -Double
0.68
    q3 :: Double
q3 = -Double
0.6
    stick :: Path
stick = do
      forall a. Show a => a -> a -> Path
m    Double
q1      Double
q1
      forall a. Show a => a -> a -> Path
l  (-Double
0.01) (-Double
0.01)
    feathers :: Path
feathers = do
      forall a. Show a => a -> a -> Path
m   Double
q1         Double
q1
      forall a. Show a => a -> a -> Path
l   Double
q1         (Double
q1 forall a. Num a => a -> a -> a
- Double
fl)
      forall a. Show a => a -> a -> Path
m   Double
q1         Double
q1
      forall a. Show a => a -> a -> Path
l   (Double
q1 forall a. Num a => a -> a -> a
- Double
fl)  Double
q1
      forall a. Show a => a -> a -> Path
m   Double
q2         Double
q2
      forall a. Show a => a -> a -> Path
l   Double
q2         (Double
q2 forall a. Num a => a -> a -> a
- Double
fl)
      forall a. Show a => a -> a -> Path
m   Double
q2         Double
q2
      forall a. Show a => a -> a -> Path
l   (Double
q2 forall a. Num a => a -> a -> a
- Double
fl)  Double
q2
      forall a. Show a => a -> a -> Path
m   Double
q3         Double
q3
      forall a. Show a => a -> a -> Path
l   Double
q3         (Double
q3 forall a. Num a => a -> a -> a
- Double
fl)
      forall a. Show a => a -> a -> Path
m   Double
q3         Double
q3
      forall a. Show a => a -> a -> Path
l   (Double
q3 forall a. Num a => a -> a -> a
- Double
fl)  Double
q3



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/business/creditCard_strk.svg)
-}
creditCard :: Svg
creditCard :: MarkupM ()
creditCard =
    MarkupM () -> MarkupM ()
S.g 
      forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__creditCard"
      forall a b. (a -> b) -> a -> b
$ do
        MarkupM ()
S.path
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"none"
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
cardPath
        MarkupM ()
S.path
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
cardBand
        MarkupM ()
S.path
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"none"
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeLinejoin AttributeValue
"round"
          forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
chip
  where
    x0 :: Double
x0 = Double
0.93
    y0 :: Double
y0 = Double
x0 forall a. Num a => a -> a -> a
* Double
0.618
    r0 :: Double
r0 = Double
0.1
    y1 :: Double
y1 = -Double
0.4
    y2 :: Double
y2 = -Double
0.15
    cw :: Double
cw = Double
1.618 forall a. Num a => a -> a -> a
* Double
ch
    ch :: Double
ch = Double
0.3
    cx :: Double
cx = -Double
0.7
    cy :: Double
cy = Double
0.5 forall a. Num a => a -> a -> a
* (Double
y0 forall a. Num a => a -> a -> a
+ Double
y2) forall a. Num a => a -> a -> a
- Double
0.5 forall a. Num a => a -> a -> a
* Double
ch
    cardPath :: AttributeValue
cardPath = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m    Double
0          Double
y0
      forall a. Show a => a -> a -> Path
l  ( Double
x0 forall a. Num a => a -> a -> a
- Double
r0)   Double
y0
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r0   Double
r0    Double
0   Bool
False  Bool
False    Double
x0        ( Double
y0 forall a. Num a => a -> a -> a
- Double
r0)
      forall a. Show a => a -> a -> Path
l    Double
x0       (-Double
y0 forall a. Num a => a -> a -> a
+ Double
r0)
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r0   Double
r0    Double
0   Bool
False  Bool
False  ( Double
x0 forall a. Num a => a -> a -> a
- Double
r0)  (-Double
y0)
      forall a. Show a => a -> a -> Path
l  (-Double
x0 forall a. Num a => a -> a -> a
+ Double
r0) (-Double
y0)
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r0   Double
r0    Double
0   Bool
False  Bool
False  (-Double
x0)       (-Double
y0 forall a. Num a => a -> a -> a
+ Double
r0)
      forall a. Show a => a -> a -> Path
l  (-Double
x0)      ( Double
y0 forall a. Num a => a -> a -> a
- Double
r0)
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r0   Double
r0    Double
0   Bool
False  Bool
False  (-Double
x0 forall a. Num a => a -> a -> a
+ Double
r0)    Double
y0
      Path
S.z
    cardBand :: AttributeValue
cardBand = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m   (-Double
x0)  Double
y1
      forall a. Show a => a -> a -> Path
l   ( Double
x0)  Double
y1
      forall a. Show a => a -> a -> Path
l   ( Double
x0)  Double
y2
      forall a. Show a => a -> a -> Path
l   (-Double
x0)  Double
y2
      Path
S.z
    chip :: AttributeValue
chip = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall a. Show a => a -> a -> Path
m     Double
cx      Double
cy
      forall a. Show a => a -> a -> Path
lr    Double
cw      Double
0
      forall a. Show a => a -> a -> Path
lr    Double
0       Double
ch
      forall a. Show a => a -> a -> Path
lr  (-Double
cw)     Double
0
      Path
S.z
      ---

      forall a. Show a => a -> a -> Path
mr  ( Double
cwforall a. Fractional a => a -> a -> a
/Double
3)   Double
0
      forall a. Show a => a -> a -> Path
lr    Double
0       Double
ch
      forall a. Show a => a -> a -> Path
mr    Double
0     (-Double
chforall a. Fractional a => a -> a -> a
/Double
3)
      forall a. Show a => a -> a -> Path
lr  (-Double
cwforall a. Fractional a => a -> a -> a
/Double
3)   Double
0
      forall a. Show a => a -> a -> Path
mr    Double
0     (-Double
chforall a. Fractional a => a -> a -> a
/Double
3)
      forall a. Show a => a -> a -> Path
lr  ( Double
cwforall a. Fractional a => a -> a -> a
/Double
3)   Double
0
      ---

      forall a. Show a => a -> a -> Path
mr  ( Double
cwforall a. Fractional a => a -> a -> a
/Double
3) (-Double
chforall a. Fractional a => a -> a -> a
/Double
3)
      forall a. Show a => a -> a -> Path
lr    Double
0       Double
ch
      forall a. Show a => a -> a -> Path
mr    Double
0     (-Double
chforall a. Fractional a => a -> a -> a
/Double
3)
      forall a. Show a => a -> a -> Path
lr  ( Double
cwforall a. Fractional a => a -> a -> a
/Double
3)   Double
0
      forall a. Show a => a -> a -> Path
mr    Double
0     (-Double
chforall a. Fractional a => a -> a -> a
/Double
3)
      forall a. Show a => a -> a -> Path
lr  (-Double
cwforall a. Fractional a => a -> a -> a
/Double
3)   Double
0
    
  

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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/business/creditIn_strk.svg)
-}
creditIn :: Svg
creditIn :: MarkupM ()
creditIn =
  MarkupM () -> MarkupM ()
S.g 
    forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__creditIn"
    forall a b. (a -> b) -> a -> b
$ do
      MarkupM ()
creditCard
      MarkupM ()
bigArrowLeft 
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (forall a. Show a => a -> a -> AttributeValue
translate Double
0.45 Double
0.22 forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> a -> AttributeValue
S.scale Double
0.25 Double
0.25)



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/business/creditOut_strk.svg)
-}
creditOut :: Svg
creditOut :: MarkupM ()
creditOut =
  MarkupM () -> MarkupM ()
S.g 
    forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__creditOut"
    forall a b. (a -> b) -> a -> b
$ do
      MarkupM ()
creditCard
      MarkupM ()
bigArrowRight 
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (forall a. Show a => a -> a -> AttributeValue
translate Double
0.45 Double
0.22 forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> a -> AttributeValue
S.scale Double
0.25 Double
0.25)


{- |
Helper for `coinPile` icon.

Draws a column of (n+1) coins.
-}
coinColumn 
  :: Int    -- ^ n

  -> Float  -- ^ coordinate x of the center of the column

  -> Float  -- ^ coordinate y of the lowest coin

  -> Svg    -- ^ resulting svg

coinColumn :: Int -> Float -> Float -> MarkupM ()
coinColumn Int
n0 Float
x0 Float
y0 =
    MarkupM () -> MarkupM ()
S.g forall a b. (a -> b) -> a -> b
$ do
      MarkupM ()
S.path
        forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d (Float -> Float -> Float -> AttributeValue
coinColumnDirs Float
n Float
x0 Float
y0)
      MarkupM ()
S.ellipse
        forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.cx (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
x0)
        forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.cy (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
y0 forall a. Num a => a -> a -> a
- (Float
nforall a. Num a => a -> a -> a
+Float
1)forall a. Num a => a -> a -> a
*Float
ch)
        forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.rx (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
cw)
        forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.ry (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
ry)
  where
    n :: Float
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n0
    cw :: Float
cw = Float
0.3  -- half width  of the coin 

    ch :: Float
ch = Float
0.15 -- full height of the coin

    ry :: Float
ry = Float
0.18
    coin :: Float -> Float -> Path
coin Float
x0 Float
y0 = do
      forall a. Show a => a -> a -> Path
m   (Float
x0 forall a. Num a => a -> a -> a
- Float
cw)  (Float
y0 forall a. Num a => a -> a -> a
- Float
ch)
      forall a. Show a => a -> a -> Path
l   (Float
x0 forall a. Num a => a -> a -> a
- Float
cw)   Float
y0
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Float
cw   Float
ry  Float
0  Bool
False Bool
False (Float
x0 forall a. Num a => a -> a -> a
+ Float
cw) Float
y0
      forall a. Show a => a -> a -> Path
l   (Float
x0 forall a. Num a => a -> a -> a
+ Float
cw)  (Float
y0 forall a. Num a => a -> a -> a
- Float
ch)
    coinColumnDirs :: Float -> Float -> Float -> AttributeValue
coinColumnDirs Float
n Float
x0 Float
y0 = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Float -> Float -> Path
coin Float
x0) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Float
k -> Float
y0 forall a. Num a => a -> a -> a
- Float
kforall a. Num a => a -> a -> a
*Float
ch) [Float
0..Float
n]
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Float
cw   Float
ry  Float
0  Bool
False Bool
True  (Float
x0 forall a. Num a => a -> a -> a
- Float
cw) (Float
y0 forall a. Num a => a -> a -> a
- (Float
nforall a. Num a => a -> a -> a
+Float
1) forall a. Num a => a -> a -> a
* Float
ch)
      forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Float
cw   Float
ry  Float
0  Bool
False Bool
True  (Float
x0 forall a. Num a => a -> a -> a
+ Float
cw) (Float
y0 forall a. Num a => a -> a -> a
- (Float
nforall a. Num a => a -> a -> a
+Float
1) forall a. Num a => a -> a -> a
* Float
ch)



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/business/coinPile_strk.svg)
-}
coinPile :: Svg
coinPile :: MarkupM ()
coinPile =
  MarkupM () -> MarkupM ()
S.g forall a b. (a -> b) -> a -> b
$ do
    (Int -> Float -> Float -> MarkupM ()
coinColumn Int
7   Float
0    Float
0.5 )
    (Int -> Float -> Float -> MarkupM ()
coinColumn Int
5 (-Float
0.6) Float
0.55)
    (Int -> Float -> Float -> MarkupM ()
coinColumn Int
3 ( Float
0.6) Float
0.55)
    (Int -> Float -> Float -> MarkupM ()
coinColumn Int
1 (-Float
0.3) Float
0.75)
    (Int -> Float -> Float -> MarkupM ()
coinColumn Int
5 ( Float
0.3) Float
0.75)