{-# LANGUAGE     OverloadedStrings       #-}



module SvgIcons.Icons.Computer 
  ( svgComputer
  , ring
  , accept
  , cancel
  , plus
  , maximize
  , minimize
  , menuDots
  , menuLines
  , powerButton 
  , warning
  , diskette
  , save
  , dustBin
  ) 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.

>svgComputer :: [ (String , S.Svg) ]
>svgComputer =
>  [ (,) "ring"        ring
>  , (,) "accept"      accept
>  , (,) "cancel"      cancel
>  , (,) "plus"        plus
>  , (,) "maximize"    maximize
>  , (,) "minimize"    minimize
>  , (,) "menuDots"    menuDots
>  , (,) "menuLines"   menuLines
>  , (,) "powerButton" powerButton 
>  , (,) "warning"     warning
>  , (,) "diskette"    diskette
>  , (,) "save"        save
>  , (,) "dustBin"     dustBin
>  ]
-}
svgComputer :: [ (String , S.Svg) ]
svgComputer :: [(String, Svg)]
svgComputer =
  [ (,) String
"ring"        Svg
ring
  , (,) String
"accept"      Svg
accept
  , (,) String
"cancel"      Svg
cancel
  , (,) String
"plus"        Svg
plus
  , (,) String
"maximize"    Svg
maximize
  , (,) String
"minimize"    Svg
minimize
  , (,) String
"menuDots"    Svg
menuDots
  , (,) String
"menuLines"   Svg
menuLines
  , (,) String
"powerButton" Svg
powerButton 
  , (,) String
"warning"     Svg
warning
  , (,) String
"diskette"    Svg
diskette
  , (,) String
"save"        Svg
save
  , (,) String
"dustBin"     Svg
dustBin
  ]


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



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/computer/ring_strk.svg)
-}
ring :: Svg
ring :: Svg
ring =
  Svg -> Svg
S.g 
    (Svg -> Svg) -> Attribute -> Svg -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__ring"
    (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.d AttributeValue
dirs
  where
    r1 :: Double
r1 = Double
0.65
    r2 :: Double
r2 = Double
0.85
    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
r1  Double
0
      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
0.0001
      Path
S.z
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
m   Double
r2  Double
0
      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
True  Bool
True   Double
r2  (-Double
0.0001)
      Path
S.z





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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/computer/accept_strk.svg)
-}
accept :: Svg
accept :: Svg
accept =
  Svg -> Svg
S.g 
    (Svg -> Svg) -> Attribute -> Svg -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__accept"
    (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.strokeLinejoin AttributeValue
"round"
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
d AttributeValue
dirs
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (Double -> Double -> AttributeValue
forall a. Show a => a -> a -> AttributeValue
translate (-Double
0.3) Double
0.3 AttributeValue -> AttributeValue -> AttributeValue
forall a. Semigroup a => a -> a -> a
<> Integer -> Integer -> Integer -> AttributeValue
forall a. Show a => a -> a -> a -> AttributeValue
rotateAround Integer
45 Integer
0 Integer
0)
  where
    k1 :: Double
k1 = Double
0.1
    k2 :: Double
k2 = Double
0.5
    k3 :: Double
k3 = Double
1.3
    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
k1) (-Double
k1)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   (-Double
k2) (-Double
k1)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa    Double
k1    Double
k1   Double
0  Bool
True  Bool
False (-Double
k2) ( Double
k1)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   ( Double
k1) ( Double
k1)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   ( Double
k1) (-Double
k3)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa    Double
k1    Double
k1   Double
0  Bool
True  Bool
False (-Double
k1) (-Double
k3)
      Path
S.z



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/computer/plus_strk.svg)
-}
plus :: Svg
plus :: Svg
plus =
    Svg
S.path 
      Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__plus"
      Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
dirs
  where
    k1 :: Double
k1 = Double
0.1
    k2 :: Double
k2 = Double
0.8
    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
k1) (-Double
k1)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   ( Double
k1) (-Double
k2)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa    Double
k1    Double
k1   Double
0  Bool
True  Bool
False (-Double
k1) (-Double
k2)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   (-Double
k1) (-Double
k1)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   (-Double
k2) (-Double
k1)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa    Double
k1    Double
k1   Double
0  Bool
True  Bool
False (-Double
k2) ( Double
k1)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   (-Double
k1) ( Double
k1)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   (-Double
k1) ( Double
k2)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa    Double
k1    Double
k1   Double
0  Bool
True  Bool
False ( Double
k1) ( Double
k2)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   ( Double
k1) ( Double
k1)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   ( Double
k2) ( Double
k1)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa    Double
k1    Double
k1   Double
0  Bool
True  Bool
False ( Double
k2) (-Double
k1)
      Path
S.z



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/computer/cancel_strk.svg)
-}
cancel :: Svg
cancel :: Svg
cancel =
  Svg -> Svg
S.g 
    (Svg -> Svg) -> Attribute -> Svg -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__cancel"
    (Svg -> Svg) -> Svg -> Svg
forall a b. (a -> b) -> a -> b
$ Svg
plus 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)



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/computer/warning_strk.svg)
-}
warning :: Svg
warning :: Svg
warning = 
  Svg -> Svg
S.g 
    (Svg -> Svg) -> Attribute -> Svg -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__warning"
    (Svg -> Svg) -> Svg -> Svg
forall a b. (a -> b) -> a -> b
$ 
    Svg -> Svg
S.g 
      (Svg -> Svg) -> Attribute -> Svg -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (Double -> Double -> AttributeValue
forall a. Show a => a -> a -> AttributeValue
translate Double
0 Double
0.2)
      (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
d AttributeValue
triangleDirs
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
strokeLinejoin AttributeValue
"round"
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
fillRule AttributeValue
"evenodd"
        Svg
S.path
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
d AttributeValue
stickPath
        Svg
S.circle
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
cx (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
0)
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
cy (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
0.15)
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
r  (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
w)
  where
    w :: Float
w  = Float
0.1
    ap1 :: Float
ap1 = Float
0.42
    ap2 :: Float
ap2 = Float
ap1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w
    lm1 :: Float
lm1 = (Float -> Float
forall a. Floating a => a -> a
sqrt Float
3) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
ap1
    lm2 :: Float
lm2 = (Float -> Float
forall a. Floating a => a -> a
sqrt Float
3) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
ap2
    y1 :: Float
y1 = -Float
0.3
    y2 :: Float
y2 = -Float
0.05
    triangleDirs :: AttributeValue
triangleDirs = Path -> AttributeValue
mkPath (Path -> AttributeValue) -> Path -> AttributeValue
forall a b. (a -> b) -> a -> b
$ do
      Float -> Float -> Path
forall a. Show a => a -> a -> Path
m    Float
0    (-Float
2Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
ap2)
      Float -> Float -> Path
forall a. Show a => a -> a -> Path
l  (-Float
lm2) (   Float
ap2)
      Float -> Float -> Path
forall a. Show a => a -> a -> Path
l  ( Float
lm2) (   Float
ap2)
      Path
S.z
      Float -> Float -> Path
forall a. Show a => a -> a -> Path
m    Float
0    (-Float
2Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
ap1)
      Float -> Float -> Path
forall a. Show a => a -> a -> Path
l  (-Float
lm1) (   Float
ap1)
      Float -> Float -> Path
forall a. Show a => a -> a -> Path
l  ( Float
lm1) (   Float
ap1)
      Path
S.z
    stickPath :: AttributeValue
stickPath = Path -> AttributeValue
mkPath (Path -> AttributeValue) -> Path -> AttributeValue
forall a b. (a -> b) -> a -> b
$ do
      Float -> Float -> Path
forall a. Show a => a -> a -> Path
m   (-Float
w)    Float
y1
      Float -> Float -> Path
forall a. Show a => a -> a -> Path
l   (-Float
wFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
2)  Float
y2
      Float -> Float -> Float -> Bool -> Bool -> Float -> Float -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa  ( Float
wFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
2) (Float
wFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
2)  Float
0  Bool
True  Bool
False (Float
wFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
2) Float
y2
      Float -> Float -> Path
forall a. Show a => a -> a -> Path
l   ( Float
w)    Float
y1
      Float -> Float -> Float -> Bool -> Bool -> Float -> Float -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa    Float
w     Float
w     Float
0  Bool
True  Bool
False (-Float
w)  Float
y1
      Path
S.z
      


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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/computer/minimize_strk.svg)
-}
minimize :: Svg
minimize :: Svg
minimize =
  Svg
S.path
    Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__minimize"
    Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
dirs
  where
    w :: Double
w = Double
0.1
    k :: Double
k = Double
0.7
    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
k)  (-Double
w)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa  ( Double
w)  ( Double
w)  Double
0  Bool
True  Bool
False  (-Double
k) ( Double
w)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   ( Double
k)  ( Double
w)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa  ( Double
w)  ( Double
w)  Double
0  Bool
True  Bool
False  ( Double
k) (-Double
w)
      Path
S.z



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/computer/maximize_strk.svg)
-}
maximize :: Svg
maximize :: Svg
maximize =
  Svg -> Svg
S.g 
    (Svg -> Svg) -> Attribute -> Svg -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__maximize"
    (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.d AttributeValue
dirs1
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (Double -> Double -> AttributeValue
forall a. Show a => a -> a -> AttributeValue
translate (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.15) (Double
0.15 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
k))
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.stroke AttributeValue
"none"
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.opacity AttributeValue
"0.5"
      Svg
S.path
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
dirs2
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (Double -> Double -> AttributeValue
forall a. Show a => a -> a -> AttributeValue
translate (  - Double
0.15)  Double
0.15)
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"none"
      Svg
S.path
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
dirs1
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (Double -> Double -> AttributeValue
forall a. Show a => a -> a -> AttributeValue
translate (-Double
0.1 ) Double
0.1)
  where
    w :: Double
w = Double
1.4
    k :: Double
k = Double
0.25
    dirs1 :: AttributeValue
dirs1 = 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
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
w)  (-Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
w)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   ( Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
w)  (-Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
w)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   ( Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
w)  ( Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
w)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   (-Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
w)  ( Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
w)
      Path
S.z
    dirs2 :: AttributeValue
dirs2 = 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
0.5Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
k)  (-Double
0.5Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
k)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   ( Double
0.5Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
k)  (-Double
0.5Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
k)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   ( Double
0.5Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
k)  ( Double
0.5Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
k)



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/computer/menuDots_strk.svg)
-}
menuDots :: Svg
menuDots :: Svg
menuDots =
    Svg -> Svg
S.g 
      (Svg -> Svg) -> Attribute -> Svg -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__menuDots"
      (Svg -> Svg) -> Svg -> Svg
forall a b. (a -> b) -> a -> b
$ do
        Float -> Svg
dot (-Float
0.7)
        Float -> Svg
dot ( Float
0  )
        Float -> Svg
dot ( Float
0.7)
  where
    dot :: Float -> Svg
dot Float
y =
      Svg
circle 
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.cy (AttributeValue -> Attribute) -> Float -> Attribute
.: Float
y)
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.cx AttributeValue
"0"
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.r  AttributeValue
"0.2"



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/computer/menuLines_strk.svg)
-}
menuLines :: Svg
menuLines :: Svg
menuLines =
    Svg -> Svg
S.g 
      (Svg -> Svg) -> Attribute -> Svg -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__menuLines"
      (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.d (Double -> AttributeValue
line (-Double
0.5))
        Svg
S.path Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d (Double -> AttributeValue
line ( Double
0  ))
        Svg
S.path Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d (Double -> AttributeValue
line ( Double
0.5))
  where
    kx :: Double
kx = Double
0.7
    r :: Double
r  = Double
0.12
    line :: Double -> AttributeValue
line Double
y = 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
kx)  (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r   Double
r   Double
0   Bool
True  Bool
False (-Double
kx) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l  ( Double
kx)  (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r)
      Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
r   Double
r   Double
0   Bool
True  Bool
False ( Double
kx) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r)
      Path
S.z



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/computer/powerButton_strk.svg)
-}
powerButton :: S.Svg
powerButton :: Svg
powerButton =
  Svg -> Svg
S.g 
    (Svg -> Svg) -> Attribute -> Svg -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__powerButton"
    (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
d AttributeValue
innerCircle
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (Double -> Double -> AttributeValue
forall a. Show a => a -> a -> AttributeValue
translate Double
0 Double
0.1)
      Svg
S.path
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
d AttributeValue
littleStickPath
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (Double -> Double -> AttributeValue
forall a. Show a => a -> a -> AttributeValue
translate Double
0 (-Double
0.42))
  where
    w :: Double
w  = Double
0.08
    r1 :: Double
r1 = Double
0.7
    r2 :: Double
r2 = Double
r1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
w
    α :: Double
α  = Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
8
    y1 :: Double
y1 = Double
0.4
    innerCircle :: AttributeValue
innerCircle =
      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 -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
α)  (-Double
r1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
α)
        Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
w   Double
w   Double
0   Bool
True  Bool
True  ( Double
r2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
α) (-Double
r2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
α)
        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
True  Bool
True  (-Double
r2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
α) (-Double
r2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
α)
        Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa   Double
w   Double
w   Double
0   Bool
True  Bool
True  (-Double
r1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
α) (-Double
r1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
α)
        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 -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
α) (-Double
r1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
α)
        Path
S.z
    littleStickPath :: AttributeValue
littleStickPath =
      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
w  (-Double
y1)
        Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa    Double
w    Double
w   Double
0   Bool
True  Bool
False (-Double
w) (-Double
y1)
        Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   (-Double
w) ( Double
y1)
        Double
-> Double -> Double -> Bool -> Bool -> Double -> Double -> Path
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa    Double
w    Double
w   Double
0   Bool
True  Bool
False ( Double
w) ( Double
y1)
        Path
S.z
      
    
  
{- |
![fill style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/computer/diskette_fill.svg)

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/computer/diskette_strk.svg)
-}
diskette :: Svg
diskette :: Svg
diskette =
    Svg
S.path
      Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__diskette"
      Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
shell
      Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fillRule AttributeValue
"evenodd"
  where
    k0 :: Double
k0 = Double
0.9
    r0 :: Double
r0 = Double
0.06
    r1 :: Double
r1 = Double
3Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
r0
    (Float
px,Float
py) = (Float
0    ,-Float
0.55)
    (Float
pw,Float
ph) = (Float
0.5  , Float
0.29)
    (Float
qx,Float
qy) = (Float
0    , Float
0.35)
    (Float
qw,Float
qh) = (Float
0.65 , Float
0.45)
    (Float
tx,Float
ty) = (Float
0.2  ,-Float
0.54)
    (Float
tw,Float
th) = (Float
0.1  , Float
0.23)
    rq :: Float
rq = Float
0.05
    shell :: AttributeValue
shell = 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
0     (-Double
k0     )
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l  (-Double
k0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r0) (-Double
k0     )
      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
k0     ) (-Double
k0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r0)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l  (-Double
k0     ) ( Double
k0 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
k0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r0) ( Double
k0     )
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l  ( Double
k0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r0) ( Double
k0     )
      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
k0     ) ( Double
k0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r0)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l  ( Double
k0     ) (-Double
k0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r1)
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l  ( Double
k0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r1) (-Double
k0     )
      Path
S.z
      Float -> (Float, Float) -> (Float, Float) -> Path
rectangleWithRoundCorners Float
rq   (Float
qw,Float
qh) (Float
qx,Float
qy)
      Float -> (Float, Float) -> (Float, Float) -> Path
rectangleWithRoundCorners Float
rq   (Float
pw,Float
ph) (Float
px,Float
py)
      Float -> (Float, Float) -> (Float, Float) -> Path
rectangleWithRoundCorners Float
0.01 (Float
tw,Float
th) (Float
tx,Float
ty)



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/computer/save_strk.svg)
-}
save :: Svg
save :: Svg
save =
  Svg -> Svg
S.g 
    (Svg -> Svg) -> Attribute -> Svg -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__save"
    (Svg -> Svg) -> Svg -> Svg
forall a b. (a -> b) -> a -> b
$ do
      Svg
diskette
      Svg
accept 
        Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (Double -> Double -> AttributeValue
forall a. Show a => a -> a -> AttributeValue
translate Double
0 Double
0.4 AttributeValue -> AttributeValue -> AttributeValue
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> AttributeValue
forall a. Show a => a -> a -> AttributeValue
S.scale Double
0.5 Double
0.5)



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

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

![stroke style](https://raw.githubusercontent.com/RamiroPastor/SvgIcons/main/svg/icons/computer/dustBin_strk.svg)
-}
dustBin :: Svg
dustBin :: Svg
dustBin =
    Svg -> Svg
S.g 
      (Svg -> Svg) -> Attribute -> Svg -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"HaskellSvgIcons__dustBin"
      (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.d AttributeValue
binDirs
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeLinecap AttributeValue
"round"
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeLinejoin AttributeValue
"round"
        Svg
S.path
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
handleDirs
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeLinejoin AttributeValue
"round"
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.fill AttributeValue
"none"
        Svg
S.path
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
linesDirs
          Svg -> Attribute -> Svg
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.strokeLinecap AttributeValue
"round"
  where
    x0 :: Double
x0 = Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.15
    x8 :: Double
x8 = Double
x7 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.15
    x1 :: Double
x1 = (Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y4) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.618 
    x7 :: Double
x7 = -Double
x1
    x2 :: Double
x2 = Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
x7 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
4
    x4 :: Double
x4 = Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
x7 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
4
    x6 :: Double
x6 = Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
3 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
x7 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
4
    x3 :: Double
x3 = Double
x4 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
x7 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
8
    x5 :: Double
x5 = Double
x4 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
x7 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
8
    y0 :: Double
y0 = -Double
0.9
    y1 :: Double
y1 = -Double
0.7
    y2 :: Double
y2 = -Double
0.5
    y3 :: Double
y3 =  Double
0.6
    y4 :: Double
y4 =  Double
0.85
    binDirs :: AttributeValue
binDirs = 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
x0  Double
y1
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x1  Double
y1
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x1  Double
y4
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x7  Double
y4
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x7  Double
y1
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x8  Double
y1
      Path
S.z
    handleDirs :: AttributeValue
handleDirs = 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
x3  Double
y0
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x5  Double
y0
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x5  Double
y1
    linesDirs :: AttributeValue
linesDirs = 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
x2  Double
y2
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x2  Double
y3
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
m   Double
x4  Double
y2
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x4  Double
y3
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
m   Double
x6  Double
y2
      Double -> Double -> Path
forall a. Show a => a -> a -> Path
l   Double
x6  Double
y3