{-# LANGUAGE OverloadedStrings #-}
module Icons.Cosmos where
import Text.Blaze.Svg11 ((!))
import Text.Blaze.Svg11 as S
import Text.Blaze.Svg11.Attributes as A
import Core.Utils
svgCosmos :: [ (String , S.Svg) ]
svgCosmos :: [(String, Svg)]
svgCosmos =
[ (,) String
"sun" (Int -> Svg
sun Int
14)
, (,) String
"moon" Svg
moon
, (,) String
"crescent" Svg
crescent
]
sun :: Int -> Svg
sun :: Int -> Svg
sun Int
n =
Svg -> Svg
S.g forall a b. (a -> b) -> a -> b
$ do
Svg
S.circle
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.x AttributeValue
"0"
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.y AttributeValue
"0"
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.r AttributeValue
"0.5"
Svg
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
rays
where
r1 :: Double
r1 = Double
0.6
r2 :: Double
r2 = Double
0.78
r3 :: Double
r3 = Double
0.96
α :: Double
α = Double
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
angles :: [Double]
angles = [ Double
n forall a. Num a => a -> a -> a
* Double
α | Double
n <- [Double
0 .. (Double
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi forall a. Fractional a => a -> a -> a
/ Double
α)]]
rays :: AttributeValue
rays =
Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Double -> Path
doubleRay [Double]
angles
doubleRay :: Double -> Path
doubleRay Double
β = do
Double -> Double -> Path
ray Double
r2 Double
β
Double -> Double -> Path
ray Double
r3 (Double
β forall a. Num a => a -> a -> a
+ Double
αforall a. Fractional a => a -> a -> a
/Double
2)
ray :: Double -> Double -> Path
ray Double
r Double
β = do
forall a. Show a => a -> a -> Path
m (Double
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Double
β) (Double
r1 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
β)
forall a. Show a => a -> a -> Path
l (Double
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Double
β) (Double
r forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
β)
moon :: Svg
moon :: Svg
moon =
Svg
S.path
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
moonDirs
where
kx :: Double
kx = Double
0.72
ky :: Double
ky = Double
0.7
r1 :: Double
r1 = Double
0.92
r2 :: Double
r2 = Double
0.71
moonDirs :: AttributeValue
moonDirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
forall a. Show a => a -> a -> Path
m ( Double
kx) (-Double
ky)
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa Double
r1 Double
r1 Double
0 Bool
True Bool
False ( Double
kx) ( Double
ky)
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa Double
r2 Double
r2 Double
0 Bool
True Bool
True ( Double
kx) (-Double
ky)
Path
S.z
crescent :: Svg
crescent :: Svg
crescent =
Svg
S.path
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
moonDirs
where
kx :: Double
kx = Double
0.55
ky :: Double
ky = Double
0.55
r1 :: Double
r1 = Double
0.8
r2 :: Double
r2 = Double
0.65
moonDirs :: AttributeValue
moonDirs = Path -> AttributeValue
mkPath forall a b. (a -> b) -> a -> b
$ do
forall a. Show a => a -> a -> Path
m ( Double
kx) (-Double
ky)
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa Double
r1 Double
r1 Double
0 Bool
True Bool
False ( Double
kx) ( Double
ky)
forall a. Show a => a -> a -> a -> Bool -> Bool -> a -> a -> Path
aa Double
r2 Double
r2 Double
0 Bool
True Bool
True ( Double
kx) (-Double
ky)
Path
S.z