{-# LANGUAGE OverloadedStrings #-}
module Icons.Tools where
import Text.Blaze.Svg11 ((!))
import Text.Blaze.Svg11 as S
import Text.Blaze.Svg11.Attributes as A
import Core.Utils
svgTools :: [ (String , S.Svg) ]
svgTools :: [(String, Svg)]
svgTools =
[ (,) String
"lock" Svg
lock
, (,) String
"key" Svg
key
, (,) String
"keyWithArc" Svg
keyWithArc
, (,) String
"cog6" Svg
cog6
, (,) String
"cog9" Svg
cog9
]
lock :: S.Svg
lock :: Svg
lock =
Svg -> Svg
S.g forall a b. (a -> b) -> a -> b
$ do
Svg
S.path
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
arm
Svg
S.path
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
fillRule AttributeValue
"evenodd"
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
body
where
aw :: Double
aw = Double
0.07
ax :: Double
ax = Double
0.4
ay1 :: Double
ay1 = -Double
0.1
ay2 :: Double
ay2 = -Double
0.48
arm :: AttributeValue
arm =
Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
forall a. Show a => a -> a -> Path
m (-Double
ax forall a. Num a => a -> a -> a
- Double
aw) Double
ay1
forall a. Show a => a -> a -> Path
l (-Double
ax forall a. Num a => a -> a -> a
- Double
aw) Double
ay2
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa ( Double
ax forall a. Num a => a -> a -> a
+ Double
aw) (Double
ax forall a. Num a => a -> a -> a
+ Double
aw) Double
0 Bool
True Bool
True ( Double
ax forall a. Num a => a -> a -> a
+ Double
aw) Double
ay2
forall a. Show a => a -> a -> Path
l ( Double
ax forall a. Num a => a -> a -> a
+ Double
aw) Double
ay1
forall a. Show a => a -> a -> Path
l ( Double
ax forall a. Num a => a -> a -> a
- Double
aw) Double
ay1
forall a. Show a => a -> a -> Path
l ( Double
ax forall a. Num a => a -> a -> a
- Double
aw) Double
ay2
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa ( Double
ax forall a. Num a => a -> a -> a
- Double
aw) (Double
ax forall a. Num a => a -> a -> a
- Double
aw) Double
0 Bool
True Bool
False (-Double
ax forall a. Num a => a -> a -> a
+ Double
aw) Double
ay2
forall a. Show a => a -> a -> Path
l (-Double
ax forall a. Num a => a -> a -> a
+ Double
aw) Double
ay1
Path
S.z
bx :: Double
bx = Double
0.7
by1 :: Double
by1 = Double
ay1
by2 :: Double
by2 = Double
0.95
kr :: Double
kr = Double
0.14
kw :: Double
kw = Double
0.076
ky1 :: Double
ky1 = Double
0.4
ky2 :: Double
ky2 = Double
0.68
body :: AttributeValue
body = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
forall a. Show a => a -> a -> Path
m (-Double
bx) Double
by1
forall a. Show a => a -> a -> Path
l (-Double
bx) Double
by2
forall a. Show a => a -> a -> Path
l ( Double
bx) Double
by2
forall a. Show a => a -> a -> Path
l ( Double
bx) Double
by1
Path
S.z
forall a. Show a => a -> a -> Path
m (-Double
kw) Double
ky1
forall a. Show a => a -> a -> Path
l (-Double
kw) Double
ky2
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa Double
kw Double
kw Double
0 Bool
True Bool
False ( Double
kw) Double
ky2
forall a. Show a => a -> a -> Path
l ( Double
kw) Double
ky1
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa Double
kr Double
kr Double
0 Bool
True Bool
False (-Double
kw) Double
ky1
Path
S.z
key :: S.Svg
key :: Svg
key =
Svg
S.path
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
fillRule AttributeValue
"evenodd"
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
keyPath
where
w :: Double
w = Double
0.1
x0 :: Double
x0 = Double
0.3
x1 :: Double
x1 = Double
0
x2 :: Double
x2 = Double
0.5
x3 :: Double
x3 = Double
0.8
y1 :: Double
y1 = Double
0.3
r1 :: Double
r1 = Double
0.25
keyPath :: AttributeValue
keyPath = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
forall a. Show a => a -> a -> Path
m (Double
x1forall a. Num a => a -> a -> a
-Double
2forall a. Num a => a -> a -> a
*Double
w) (-Double
0.005)
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa Double
r1 Double
r1 Double
0 Bool
True Bool
False (Double
x1forall a. Num a => a -> a -> a
-Double
2forall a. Num a => a -> a -> a
*Double
w) Double
0
Path
S.z
forall a. Show a => a -> a -> Path
m Double
x1 (-Double
w)
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa (Double
r1forall a. Num a => a -> a -> a
+Double
2forall a. Num a => a -> a -> a
*Double
w) (Double
r1forall a. Num a => a -> a -> a
+Double
2forall a. Num a => a -> a -> a
*Double
w) Double
0 Bool
True Bool
False Double
x1 Double
w
forall a. Show a => a -> a -> Path
l (Double
x2 forall a. Num a => a -> a -> a
- Double
w) ( Double
w)
forall a. Show a => a -> a -> Path
l (Double
x2 forall a. Num a => a -> a -> a
- Double
w) (Double
y1)
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa ( Double
w) ( Double
w) Double
0 Bool
True Bool
False (Double
x2 forall a. Num a => a -> a -> a
+ Double
w) Double
y1
forall a. Show a => a -> a -> Path
l (Double
x2 forall a. Num a => a -> a -> a
+ Double
w) ( Double
w)
forall a. Show a => a -> a -> Path
l (Double
x3 forall a. Num a => a -> a -> a
- Double
w) ( Double
w)
forall a. Show a => a -> a -> Path
l (Double
x3 forall a. Num a => a -> a -> a
- Double
w) (Double
y1)
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa ( Double
w) ( Double
w) Double
0 Bool
True Bool
False (Double
x3 forall a. Num a => a -> a -> a
+ Double
w) Double
y1
forall a. Show a => a -> a -> Path
l (Double
x3 forall a. Num a => a -> a -> a
+ Double
w) (-Double
w)
Path
S.z
keyWithArc :: S.Svg
keyWithArc :: Svg
keyWithArc =
Svg -> Svg
S.g forall a b. (a -> b) -> a -> b
$ do
Svg
key forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (forall a. Show a => a -> a -> AttributeValue
translate (-Double
0.4) Double
0 forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> a -> AttributeValue
S.scale Double
0.6 Double
0.6)
Svg
arc forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.transform (forall a. Show a => a -> a -> AttributeValue
S.scale Double
0.6 Double
0.6)
where
w :: Double
w = Double
0.1
r1 :: Double
r1 = Double
1.3
r2 :: Double
r2 = Double
r1 forall a. Num a => a -> a -> a
+ Double
2forall a. Num a => a -> a -> a
*Double
w
π :: Double
π = forall a. Floating a => a
pi
α :: Double
α = Double
π forall a. Fractional a => a -> a -> a
/ Double
4
x1 :: Double
x1 = Double
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Double
α
y1 :: Double
y1 = Double
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
α
x2 :: Double
x2 = Double
r2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Double
α
y2 :: Double
y2 = Double
r2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
α
arc :: Svg
arc =
Svg
S.path
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
arcPath
arcPath :: AttributeValue
arcPath = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
forall a. Show a => a -> a -> Path
m (-Double
x1) (-Double
y1)
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa Double
w Double
w Double
0 Bool
True Bool
True (-Double
x2) (-Double
y2)
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa Double
r2 Double
r2 Double
0 Bool
True Bool
True (-Double
x2) ( Double
y2)
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa Double
w Double
w Double
0 Bool
True Bool
True (-Double
x1) ( Double
y1)
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa Double
r1 Double
r1 Double
0 Bool
True Bool
False (-Double
x1) (-Double
y1)
Path
S.z
cogwheel :: Int -> Float -> S.Svg
cogwheel :: Int -> Float -> Svg
cogwheel Int
n Float
eps =
Svg
S.path
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.d AttributeValue
cogPath
where
r1 :: Float
r1 = Float
0.4 :: Float
r2 :: Float
r2 = Float
0.66 :: Float
r3 :: Float
r3 = Float
0.94 :: Float
a :: Float
a = (Float
2 forall a. Num a => a -> a -> a
* forall a. Floating a => a
pi) forall a. Fractional a => a -> a -> a
/ (Float
2 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
makeAngles :: p -> [Float]
makeAngles p
k' =
let k :: Float
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral p
k'
in [ Float
kforall a. Num a => a -> a -> a
*Float
a forall a. Num a => a -> a -> a
- Float
eps, Float
kforall a. Num a => a -> a -> a
*Float
a forall a. Num a => a -> a -> a
+ Float
eps ]
makePoint :: b -> b -> (b, b)
makePoint b
r b
α = ( b
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos b
α , b
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin b
α)
outer :: [(Float, Float)]
outer = forall a b. (a -> b) -> [a] -> [b]
map (forall {b}. Floating b => b -> b -> (b, b)
makePoint Float
r3) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {p}. Integral p => p -> [Float]
makeAngles forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall a. Integral a => a -> Bool
even [Int
0 .. Int
2forall a. Num a => a -> a -> a
*Int
n]
inner :: [(Float, Float)]
inner = forall a b. (a -> b) -> [a] -> [b]
map (forall {b}. Floating b => b -> b -> (b, b)
makePoint Float
r2) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {p}. Integral p => p -> [Float]
makeAngles forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall a. Integral a => a -> Bool
odd [Int
0 .. Int
2forall a. Num a => a -> a -> a
*Int
n]
f :: [(a, a)] -> [(Float, Float)] -> Path
f ((a
a1,a
a2):(a
b1,a
b2):[(a, a)]
outs) ((Float
c1,Float
c2):(Float
d1,Float
d2):[(Float, Float)]
ins) = do
forall a. Show a => a -> a -> Path
l a
a1 a
a2
forall a. Show a => a -> a -> Path
l a
b1 a
b2
forall a. Show a => a -> a -> Path
l Float
c1 Float
c2
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa Float
r2 Float
r2 Float
0 Bool
False Bool
True Float
d1 Float
d2
[(a, a)] -> [(Float, Float)] -> Path
f [(a, a)]
outs [(Float, Float)]
ins
f [(a, a)]
_ [(Float, Float)]
_ = Path
S.z
cogPath :: AttributeValue
cogPath = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
forall a. Show a => a -> a -> Path
m ( Float
r1) Float
0
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa Float
r1 Float
r1 Float
0 Bool
True Bool
False (-Float
r1) Float
0
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa Float
r1 Float
r1 Float
0 Bool
True Bool
False ( Float
r1) Float
0
forall a. Show a => a -> a -> Path
m (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Float, Float)]
outer) (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(Float, Float)]
outer)
forall {a}. Show a => [(a, a)] -> [(Float, Float)] -> Path
f [(Float, Float)]
outer [(Float, Float)]
inner
cog6 :: S.Svg
cog6 :: Svg
cog6 = Int -> Float -> Svg
cogwheel Int
6 Float
0.18
cog9 :: S.Svg
cog9 :: Svg
cog9 = Int -> Float -> Svg
cogwheel Int
9 Float
0.12