{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}
module Chart.Style
(
RectStyle (..),
defaultRectStyle,
blob,
clear,
border,
TextStyle (..),
defaultTextStyle,
styleBoxText,
ScaleX (..),
GlyphStyle (..),
defaultGlyphStyle,
styleBoxGlyph,
gpalette1,
ScaleBorder (..),
GlyphShape (..),
glyphText,
LineStyle (..),
defaultLineStyle,
LineCap (..),
fromLineCap,
toLineCap,
LineJoin (..),
fromLineJoin,
toLineJoin,
fromDashArray,
Anchor (..),
fromAnchor,
toAnchor,
PathStyle (..),
defaultPathStyle,
)
where
import Chart.Data
import Data.Colour
import qualified Data.List as List
import Data.Maybe
import Data.Path
import Data.Path.Parser
import Data.String
import Data.Text (Text, pack)
import qualified Data.Text as Text
import GHC.Generics
import Optics.Core
import Text.HTML.TagSoup (maybeTagText, parseTags)
import Prelude
data RectStyle = RectStyle
{ RectStyle -> Double
borderSize :: Double,
RectStyle -> Colour
borderColor :: Colour,
RectStyle -> Colour
color :: Colour
}
deriving (Int -> RectStyle -> ShowS
[RectStyle] -> ShowS
RectStyle -> String
(Int -> RectStyle -> ShowS)
-> (RectStyle -> String)
-> ([RectStyle] -> ShowS)
-> Show RectStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RectStyle] -> ShowS
$cshowList :: [RectStyle] -> ShowS
show :: RectStyle -> String
$cshow :: RectStyle -> String
showsPrec :: Int -> RectStyle -> ShowS
$cshowsPrec :: Int -> RectStyle -> ShowS
Show, RectStyle -> RectStyle -> Bool
(RectStyle -> RectStyle -> Bool)
-> (RectStyle -> RectStyle -> Bool) -> Eq RectStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RectStyle -> RectStyle -> Bool
$c/= :: RectStyle -> RectStyle -> Bool
== :: RectStyle -> RectStyle -> Bool
$c== :: RectStyle -> RectStyle -> Bool
Eq, (forall x. RectStyle -> Rep RectStyle x)
-> (forall x. Rep RectStyle x -> RectStyle) -> Generic RectStyle
forall x. Rep RectStyle x -> RectStyle
forall x. RectStyle -> Rep RectStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RectStyle x -> RectStyle
$cfrom :: forall x. RectStyle -> Rep RectStyle x
Generic)
defaultRectStyle :: RectStyle
defaultRectStyle :: RectStyle
defaultRectStyle = Double -> Colour -> Colour -> RectStyle
RectStyle Double
0.01 (Int -> Double -> Colour
palette1a Int
1 Double
1) (Int -> Double -> Colour
palette1a Int
0 Double
0.1)
blob :: Colour -> RectStyle
blob :: Colour -> RectStyle
blob = Double -> Colour -> Colour -> RectStyle
RectStyle Double
0 Colour
transparent
clear :: RectStyle
clear :: RectStyle
clear = Double -> Colour -> Colour -> RectStyle
RectStyle Double
0 Colour
transparent Colour
transparent
border :: Double -> Colour -> RectStyle
border :: Double -> Colour -> RectStyle
border Double
s Colour
c = Double -> Colour -> Colour -> RectStyle
RectStyle Double
s Colour
c Colour
transparent
data TextStyle = TextStyle
{ TextStyle -> Double
size :: Double,
TextStyle -> Colour
color :: Colour,
TextStyle -> Anchor
anchor :: Anchor,
TextStyle -> Double
hsize :: Double,
TextStyle -> Double
vsize :: Double,
TextStyle -> Double
vshift :: Double,
TextStyle -> Maybe Double
rotation :: Maybe Double,
TextStyle -> ScaleX
scalex :: ScaleX,
TextStyle -> Maybe RectStyle
frame :: Maybe RectStyle
}
deriving (Int -> TextStyle -> ShowS
[TextStyle] -> ShowS
TextStyle -> String
(Int -> TextStyle -> ShowS)
-> (TextStyle -> String)
-> ([TextStyle] -> ShowS)
-> Show TextStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextStyle] -> ShowS
$cshowList :: [TextStyle] -> ShowS
show :: TextStyle -> String
$cshow :: TextStyle -> String
showsPrec :: Int -> TextStyle -> ShowS
$cshowsPrec :: Int -> TextStyle -> ShowS
Show, TextStyle -> TextStyle -> Bool
(TextStyle -> TextStyle -> Bool)
-> (TextStyle -> TextStyle -> Bool) -> Eq TextStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextStyle -> TextStyle -> Bool
$c/= :: TextStyle -> TextStyle -> Bool
== :: TextStyle -> TextStyle -> Bool
$c== :: TextStyle -> TextStyle -> Bool
Eq, (forall x. TextStyle -> Rep TextStyle x)
-> (forall x. Rep TextStyle x -> TextStyle) -> Generic TextStyle
forall x. Rep TextStyle x -> TextStyle
forall x. TextStyle -> Rep TextStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextStyle x -> TextStyle
$cfrom :: forall x. TextStyle -> Rep TextStyle x
Generic)
data ScaleX = ScaleX | NoScaleX deriving (ScaleX -> ScaleX -> Bool
(ScaleX -> ScaleX -> Bool)
-> (ScaleX -> ScaleX -> Bool) -> Eq ScaleX
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScaleX -> ScaleX -> Bool
$c/= :: ScaleX -> ScaleX -> Bool
== :: ScaleX -> ScaleX -> Bool
$c== :: ScaleX -> ScaleX -> Bool
Eq, Int -> ScaleX -> ShowS
[ScaleX] -> ShowS
ScaleX -> String
(Int -> ScaleX -> ShowS)
-> (ScaleX -> String) -> ([ScaleX] -> ShowS) -> Show ScaleX
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScaleX] -> ShowS
$cshowList :: [ScaleX] -> ShowS
show :: ScaleX -> String
$cshow :: ScaleX -> String
showsPrec :: Int -> ScaleX -> ShowS
$cshowsPrec :: Int -> ScaleX -> ShowS
Show, (forall x. ScaleX -> Rep ScaleX x)
-> (forall x. Rep ScaleX x -> ScaleX) -> Generic ScaleX
forall x. Rep ScaleX x -> ScaleX
forall x. ScaleX -> Rep ScaleX x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScaleX x -> ScaleX
$cfrom :: forall x. ScaleX -> Rep ScaleX x
Generic)
data Anchor = AnchorMiddle | AnchorStart | AnchorEnd deriving (Anchor -> Anchor -> Bool
(Anchor -> Anchor -> Bool)
-> (Anchor -> Anchor -> Bool) -> Eq Anchor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Anchor -> Anchor -> Bool
$c/= :: Anchor -> Anchor -> Bool
== :: Anchor -> Anchor -> Bool
$c== :: Anchor -> Anchor -> Bool
Eq, Int -> Anchor -> ShowS
[Anchor] -> ShowS
Anchor -> String
(Int -> Anchor -> ShowS)
-> (Anchor -> String) -> ([Anchor] -> ShowS) -> Show Anchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Anchor] -> ShowS
$cshowList :: [Anchor] -> ShowS
show :: Anchor -> String
$cshow :: Anchor -> String
showsPrec :: Int -> Anchor -> ShowS
$cshowsPrec :: Int -> Anchor -> ShowS
Show, (forall x. Anchor -> Rep Anchor x)
-> (forall x. Rep Anchor x -> Anchor) -> Generic Anchor
forall x. Rep Anchor x -> Anchor
forall x. Anchor -> Rep Anchor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Anchor x -> Anchor
$cfrom :: forall x. Anchor -> Rep Anchor x
Generic)
fromAnchor :: (IsString s) => Anchor -> s
fromAnchor :: Anchor -> s
fromAnchor Anchor
AnchorMiddle = s
"Middle"
fromAnchor Anchor
AnchorStart = s
"Start"
fromAnchor Anchor
AnchorEnd = s
"End"
toAnchor :: (Eq s, IsString s) => s -> Anchor
toAnchor :: s -> Anchor
toAnchor s
"Middle" = Anchor
AnchorMiddle
toAnchor s
"Start" = Anchor
AnchorStart
toAnchor s
"End" = Anchor
AnchorEnd
toAnchor s
_ = Anchor
AnchorMiddle
defaultTextStyle :: TextStyle
defaultTextStyle :: TextStyle
defaultTextStyle =
Double
-> Colour
-> Anchor
-> Double
-> Double
-> Double
-> Maybe Double
-> ScaleX
-> Maybe RectStyle
-> TextStyle
TextStyle Double
0.12 Colour
dark Anchor
AnchorMiddle Double
0.45 Double
1.1 (-Double
0.25) Maybe Double
forall a. Maybe a
Nothing ScaleX
ScaleX Maybe RectStyle
forall a. Maybe a
Nothing
styleBoxText ::
TextStyle ->
Text ->
Point Double ->
Rect Double
styleBoxText :: TextStyle -> Text -> Point Double -> Rect Double
styleBoxText TextStyle
o Text
t Point Double
p = Rect Double -> Rect Double
mpad (Rect Double -> Rect Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> a -> b
$ Element (Rect Double) -> Rect Double -> Rect Double
forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
Element (Rect Double)
p (Rect Double -> Rect Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> a -> b
$ Rect Double
-> (Double -> Rect Double) -> Maybe Double -> Rect Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect Double
flat (Double -> Rect Double -> Rect Double
forall a. (TrigField a, Ord a) => a -> Rect a -> Rect a
`rotationBound` Rect Double
flat) (TextStyle
o TextStyle
-> Optic' A_Lens NoIx TextStyle (Maybe Double) -> Maybe Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "rotation" (Optic' A_Lens NoIx TextStyle (Maybe Double))
Optic' A_Lens NoIx TextStyle (Maybe Double)
#rotation)
where
flat :: Rect Double
flat = Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect ((-Double
x' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2.0) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a') (Double
x' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a') (-Double
y' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
n1') (Double
y' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
n1')
s :: Double
s = TextStyle
o TextStyle -> Optic' A_Lens NoIx TextStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx TextStyle Double)
Optic' A_Lens NoIx TextStyle Double
#size
h :: Double
h = TextStyle
o TextStyle -> Optic' A_Lens NoIx TextStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "hsize" (Optic' A_Lens NoIx TextStyle Double)
Optic' A_Lens NoIx TextStyle Double
#hsize
v :: Double
v = TextStyle
o TextStyle -> Optic' A_Lens NoIx TextStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "vsize" (Optic' A_Lens NoIx TextStyle Double)
Optic' A_Lens NoIx TextStyle Double
#vsize
n1 :: Double
n1 = TextStyle
o TextStyle -> Optic' A_Lens NoIx TextStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "vshift" (Optic' A_Lens NoIx TextStyle Double)
Optic' A_Lens NoIx TextStyle Double
#vshift
x' :: Double
x' = Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int -> (Text -> Int) -> Maybe Text -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Text -> Int
Text.length (Maybe Text -> Int) -> (Tag Text -> Maybe Text) -> Tag Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag Text -> Maybe Text
forall str. Tag str -> Maybe str
maybeTagText (Tag Text -> Int) -> [Tag Text] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
parseTags Text
t)
y' :: Double
y' = Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
v
n1' :: Double
n1' = -Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
n1
a' :: Double
a' = case TextStyle
o TextStyle -> Optic' A_Lens NoIx TextStyle Anchor -> Anchor
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "anchor" (Optic' A_Lens NoIx TextStyle Anchor)
Optic' A_Lens NoIx TextStyle Anchor
#anchor of
Anchor
AnchorStart -> Double
0.5
Anchor
AnchorEnd -> -Double
0.5
Anchor
AnchorMiddle -> Double
0.0
mpad :: Rect Double -> Rect Double
mpad = case Optic' A_Lens NoIx TextStyle (Maybe RectStyle)
-> TextStyle -> Maybe RectStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "frame" (Optic' A_Lens NoIx TextStyle (Maybe RectStyle))
Optic' A_Lens NoIx TextStyle (Maybe RectStyle)
#frame TextStyle
o of
Maybe RectStyle
Nothing -> Rect Double -> Rect Double
forall a. a -> a
id
Just RectStyle
f -> Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Optic' A_Lens NoIx RectStyle Double -> RectStyle -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "borderSize" (Optic' A_Lens NoIx RectStyle Double)
Optic' A_Lens NoIx RectStyle Double
#borderSize RectStyle
f Double -> Double -> Double
forall a. Num a => a -> a -> a
* Optic' A_Lens NoIx TextStyle Double -> TextStyle -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "size" (Optic' A_Lens NoIx TextStyle Double)
Optic' A_Lens NoIx TextStyle Double
#size TextStyle
o)
data GlyphStyle = GlyphStyle
{
GlyphStyle -> Double
size :: Double,
GlyphStyle -> Colour
color :: Colour,
GlyphStyle -> Colour
borderColor :: Colour,
GlyphStyle -> Double
borderSize :: Double,
GlyphStyle -> GlyphShape
shape :: GlyphShape,
GlyphStyle -> Maybe Double
rotation :: Maybe Double,
GlyphStyle -> Maybe (Point Double)
translate :: Maybe (Point Double)
}
deriving (Int -> GlyphStyle -> ShowS
[GlyphStyle] -> ShowS
GlyphStyle -> String
(Int -> GlyphStyle -> ShowS)
-> (GlyphStyle -> String)
-> ([GlyphStyle] -> ShowS)
-> Show GlyphStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlyphStyle] -> ShowS
$cshowList :: [GlyphStyle] -> ShowS
show :: GlyphStyle -> String
$cshow :: GlyphStyle -> String
showsPrec :: Int -> GlyphStyle -> ShowS
$cshowsPrec :: Int -> GlyphStyle -> ShowS
Show, GlyphStyle -> GlyphStyle -> Bool
(GlyphStyle -> GlyphStyle -> Bool)
-> (GlyphStyle -> GlyphStyle -> Bool) -> Eq GlyphStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphStyle -> GlyphStyle -> Bool
$c/= :: GlyphStyle -> GlyphStyle -> Bool
== :: GlyphStyle -> GlyphStyle -> Bool
$c== :: GlyphStyle -> GlyphStyle -> Bool
Eq, (forall x. GlyphStyle -> Rep GlyphStyle x)
-> (forall x. Rep GlyphStyle x -> GlyphStyle) -> Generic GlyphStyle
forall x. Rep GlyphStyle x -> GlyphStyle
forall x. GlyphStyle -> Rep GlyphStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlyphStyle x -> GlyphStyle
$cfrom :: forall x. GlyphStyle -> Rep GlyphStyle x
Generic)
defaultGlyphStyle :: GlyphStyle
defaultGlyphStyle :: GlyphStyle
defaultGlyphStyle =
Double
-> Colour
-> Colour
-> Double
-> GlyphShape
-> Maybe Double
-> Maybe (Point Double)
-> GlyphStyle
GlyphStyle
Double
0.03
(Int -> Double -> Colour
palette1a Int
0 Double
0.2)
(Optic A_Lens NoIx Colour Colour Double Double
-> Double -> Colour -> Colour
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Colour Colour Double Double
lightness' Double
0.4 (Colour -> Colour) -> Colour -> Colour
forall a b. (a -> b) -> a -> b
$ Int -> Double -> Colour
palette1a Int
1 Double
1)
Double
0.003
GlyphShape
SquareGlyph
Maybe Double
forall a. Maybe a
Nothing
Maybe (Point Double)
forall a. Maybe a
Nothing
data ScaleBorder = ScaleBorder | NoScaleBorder deriving (Int -> ScaleBorder -> ShowS
[ScaleBorder] -> ShowS
ScaleBorder -> String
(Int -> ScaleBorder -> ShowS)
-> (ScaleBorder -> String)
-> ([ScaleBorder] -> ShowS)
-> Show ScaleBorder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScaleBorder] -> ShowS
$cshowList :: [ScaleBorder] -> ShowS
show :: ScaleBorder -> String
$cshow :: ScaleBorder -> String
showsPrec :: Int -> ScaleBorder -> ShowS
$cshowsPrec :: Int -> ScaleBorder -> ShowS
Show, ScaleBorder -> ScaleBorder -> Bool
(ScaleBorder -> ScaleBorder -> Bool)
-> (ScaleBorder -> ScaleBorder -> Bool) -> Eq ScaleBorder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScaleBorder -> ScaleBorder -> Bool
$c/= :: ScaleBorder -> ScaleBorder -> Bool
== :: ScaleBorder -> ScaleBorder -> Bool
$c== :: ScaleBorder -> ScaleBorder -> Bool
Eq, (forall x. ScaleBorder -> Rep ScaleBorder x)
-> (forall x. Rep ScaleBorder x -> ScaleBorder)
-> Generic ScaleBorder
forall x. Rep ScaleBorder x -> ScaleBorder
forall x. ScaleBorder -> Rep ScaleBorder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScaleBorder x -> ScaleBorder
$cfrom :: forall x. ScaleBorder -> Rep ScaleBorder x
Generic)
data GlyphShape
= CircleGlyph
| SquareGlyph
| EllipseGlyph Double
| RectSharpGlyph Double
| RectRoundedGlyph Double Double Double
|
TriangleGlyph (Point Double) (Point Double) (Point Double)
| VLineGlyph
| HLineGlyph
| PathGlyph Text ScaleBorder
deriving (Int -> GlyphShape -> ShowS
[GlyphShape] -> ShowS
GlyphShape -> String
(Int -> GlyphShape -> ShowS)
-> (GlyphShape -> String)
-> ([GlyphShape] -> ShowS)
-> Show GlyphShape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlyphShape] -> ShowS
$cshowList :: [GlyphShape] -> ShowS
show :: GlyphShape -> String
$cshow :: GlyphShape -> String
showsPrec :: Int -> GlyphShape -> ShowS
$cshowsPrec :: Int -> GlyphShape -> ShowS
Show, GlyphShape -> GlyphShape -> Bool
(GlyphShape -> GlyphShape -> Bool)
-> (GlyphShape -> GlyphShape -> Bool) -> Eq GlyphShape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphShape -> GlyphShape -> Bool
$c/= :: GlyphShape -> GlyphShape -> Bool
== :: GlyphShape -> GlyphShape -> Bool
$c== :: GlyphShape -> GlyphShape -> Bool
Eq, (forall x. GlyphShape -> Rep GlyphShape x)
-> (forall x. Rep GlyphShape x -> GlyphShape) -> Generic GlyphShape
forall x. Rep GlyphShape x -> GlyphShape
forall x. GlyphShape -> Rep GlyphShape x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlyphShape x -> GlyphShape
$cfrom :: forall x. GlyphShape -> Rep GlyphShape x
Generic)
glyphText :: GlyphShape -> Text
glyphText :: GlyphShape -> Text
glyphText GlyphShape
sh =
case GlyphShape
sh of
GlyphShape
CircleGlyph -> Text
"Circle"
GlyphShape
SquareGlyph -> Text
"Square"
TriangleGlyph {} -> Text
"Triangle"
EllipseGlyph Double
_ -> Text
"Ellipse"
RectSharpGlyph Double
_ -> Text
"RectSharp"
RectRoundedGlyph {} -> Text
"RectRounded"
GlyphShape
VLineGlyph -> Text
"VLine"
GlyphShape
HLineGlyph -> Text
"HLine"
PathGlyph Text
_ ScaleBorder
_ -> Text
"Path"
styleBoxGlyph :: GlyphStyle -> Rect Double
styleBoxGlyph :: GlyphStyle -> Rect Double
styleBoxGlyph GlyphStyle
s = Element (Rect Double) -> Rect Double -> Rect Double
forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
Element (Rect Double)
p' (Rect Double -> Rect Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> a -> b
$
Rect Double -> Rect Double
rot' (Rect Double -> Rect Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> a -> b
$
Rect Double -> Rect Double
sw (Rect Double -> Rect Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> a -> b
$ case GlyphShape
sh of
GlyphShape
CircleGlyph -> (Double
sz Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rect Double
forall a. Multiplicative a => a
one
GlyphShape
SquareGlyph -> (Double
sz Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rect Double
forall a. Multiplicative a => a
one
EllipseGlyph Double
a -> Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
sz (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sz)) Rect Double
forall a. Multiplicative a => a
one
RectSharpGlyph Double
a -> Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
sz (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sz)) Rect Double
forall a. Multiplicative a => a
one
RectRoundedGlyph Double
a Double
_ Double
_ -> Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
sz (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sz)) Rect Double
forall a. Multiplicative a => a
one
GlyphShape
VLineGlyph -> Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (GlyphStyle
s GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderSize" (Optic' A_Lens NoIx GlyphStyle Double)
Optic' A_Lens NoIx GlyphStyle Double
#borderSize) Double
sz) Rect Double
forall a. Multiplicative a => a
one
GlyphShape
HLineGlyph -> Element (Rect Double) -> Rect Double -> Rect Double
forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
sz (GlyphStyle
s GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderSize" (Optic' A_Lens NoIx GlyphStyle Double)
Optic' A_Lens NoIx GlyphStyle Double
#borderSize)) Rect Double
forall a. Multiplicative a => a
one
TriangleGlyph Point Double
a Point Double
b Point Double
c -> (Double
sz Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Element (Rect Double)] -> Rect Double
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 ([Point Double
a, Point Double
b, Point Double
c] :: [Point Double])
PathGlyph Text
path' ScaleBorder
_ -> Rect Double
-> (Rect Double -> Rect Double)
-> Maybe (Rect Double)
-> Rect Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect Double
forall a. Additive a => a
zero ((Double -> Double) -> Rect Double -> Rect Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
sz Double -> Double -> Double
forall a. Num a => a -> a -> a
*)) ([PathData Double] -> Maybe (Rect Double)
pathBoxes ([PathData Double] -> Maybe (Rect Double))
-> (Text -> [PathData Double]) -> Text -> Maybe (Rect Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [PathData Double]
svgToPathData (Text -> Maybe (Rect Double)) -> Text -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ Text
path')
where
sh :: GlyphShape
sh = GlyphStyle
s GlyphStyle
-> Optic' A_Lens NoIx GlyphStyle GlyphShape -> GlyphShape
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "shape" (Optic' A_Lens NoIx GlyphStyle GlyphShape)
Optic' A_Lens NoIx GlyphStyle GlyphShape
#shape
sz :: Double
sz = GlyphStyle
s GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "size" (Optic' A_Lens NoIx GlyphStyle Double)
Optic' A_Lens NoIx GlyphStyle Double
#size
sw :: Rect Double -> Rect Double
sw = Double -> Rect Double -> Rect Double
forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* GlyphStyle
s GlyphStyle -> Optic' A_Lens NoIx GlyphStyle Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "borderSize" (Optic' A_Lens NoIx GlyphStyle Double)
Optic' A_Lens NoIx GlyphStyle Double
#borderSize)
p' :: Point Double
p' = Point Double -> Maybe (Point Double) -> Point Double
forall a. a -> Maybe a -> a
fromMaybe (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.0 Double
0.0) (GlyphStyle
s GlyphStyle
-> Optic' A_Lens NoIx GlyphStyle (Maybe (Point Double))
-> Maybe (Point Double)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
"translate" (Optic' A_Lens NoIx GlyphStyle (Maybe (Point Double)))
Optic' A_Lens NoIx GlyphStyle (Maybe (Point Double))
#translate)
rot' :: Rect Double -> Rect Double
rot' = (Rect Double -> Rect Double)
-> (Double -> Rect Double -> Rect Double)
-> Maybe Double
-> Rect Double
-> Rect Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect Double -> Rect Double
forall a. a -> a
id Double -> Rect Double -> Rect Double
forall a. (TrigField a, Ord a) => a -> Rect a -> Rect a
rotationBound (Optic' A_Lens NoIx GlyphStyle (Maybe Double)
-> GlyphStyle -> Maybe Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "rotation" (Optic' A_Lens NoIx GlyphStyle (Maybe Double))
Optic' A_Lens NoIx GlyphStyle (Maybe Double)
#rotation GlyphStyle
s)
gpalette1 :: Int -> GlyphShape
gpalette1 :: Int -> GlyphShape
gpalette1 Int
x = [GlyphShape] -> [GlyphShape]
forall a. [a] -> [a]
cycle [GlyphShape]
gpalette1_ [GlyphShape] -> Int -> GlyphShape
forall a. [a] -> Int -> a
List.!! Int
x
gpalette1_ :: [GlyphShape]
gpalette1_ :: [GlyphShape]
gpalette1_ =
[ GlyphShape
CircleGlyph,
GlyphShape
SquareGlyph,
Double -> GlyphShape
RectSharpGlyph Double
0.75,
Double -> Double -> Double -> GlyphShape
RectRoundedGlyph Double
0.75 Double
0.01 Double
0.01,
Double -> GlyphShape
EllipseGlyph Double
0.75,
GlyphShape
VLineGlyph,
GlyphShape
HLineGlyph,
Point Double -> Point Double -> Point Double -> GlyphShape
TriangleGlyph (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.0 Double
0.0) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1 Double
1) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1 Double
0),
Text -> ScaleBorder -> GlyphShape
PathGlyph Text
"M0.05,-0.03660254037844387 A0.1 0.1 0.0 0 1 0.0,0.05 0.1 0.1 0.0 0 1 -0.05,-0.03660254037844387 0.1 0.1 0.0 0 1 0.05,-0.03660254037844387 Z" ScaleBorder
ScaleBorder
]
data LineCap = LineCapButt | LineCapRound | LineCapSquare deriving (LineCap -> LineCap -> Bool
(LineCap -> LineCap -> Bool)
-> (LineCap -> LineCap -> Bool) -> Eq LineCap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineCap -> LineCap -> Bool
$c/= :: LineCap -> LineCap -> Bool
== :: LineCap -> LineCap -> Bool
$c== :: LineCap -> LineCap -> Bool
Eq, Int -> LineCap -> ShowS
[LineCap] -> ShowS
LineCap -> String
(Int -> LineCap -> ShowS)
-> (LineCap -> String) -> ([LineCap] -> ShowS) -> Show LineCap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineCap] -> ShowS
$cshowList :: [LineCap] -> ShowS
show :: LineCap -> String
$cshow :: LineCap -> String
showsPrec :: Int -> LineCap -> ShowS
$cshowsPrec :: Int -> LineCap -> ShowS
Show, (forall x. LineCap -> Rep LineCap x)
-> (forall x. Rep LineCap x -> LineCap) -> Generic LineCap
forall x. Rep LineCap x -> LineCap
forall x. LineCap -> Rep LineCap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineCap x -> LineCap
$cfrom :: forall x. LineCap -> Rep LineCap x
Generic)
fromLineCap :: (IsString s) => LineCap -> s
fromLineCap :: LineCap -> s
fromLineCap LineCap
LineCapButt = s
"butt"
fromLineCap LineCap
LineCapRound = s
"round"
fromLineCap LineCap
LineCapSquare = s
"square"
toLineCap :: (Eq s, IsString s) => s -> LineCap
toLineCap :: s -> LineCap
toLineCap s
"butt" = LineCap
LineCapButt
toLineCap s
"round" = LineCap
LineCapRound
toLineCap s
"square" = LineCap
LineCapSquare
toLineCap s
_ = LineCap
LineCapButt
data LineJoin = LineJoinMiter | LineJoinBevel | LineJoinRound deriving (LineJoin -> LineJoin -> Bool
(LineJoin -> LineJoin -> Bool)
-> (LineJoin -> LineJoin -> Bool) -> Eq LineJoin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineJoin -> LineJoin -> Bool
$c/= :: LineJoin -> LineJoin -> Bool
== :: LineJoin -> LineJoin -> Bool
$c== :: LineJoin -> LineJoin -> Bool
Eq, Int -> LineJoin -> ShowS
[LineJoin] -> ShowS
LineJoin -> String
(Int -> LineJoin -> ShowS)
-> (LineJoin -> String) -> ([LineJoin] -> ShowS) -> Show LineJoin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineJoin] -> ShowS
$cshowList :: [LineJoin] -> ShowS
show :: LineJoin -> String
$cshow :: LineJoin -> String
showsPrec :: Int -> LineJoin -> ShowS
$cshowsPrec :: Int -> LineJoin -> ShowS
Show, (forall x. LineJoin -> Rep LineJoin x)
-> (forall x. Rep LineJoin x -> LineJoin) -> Generic LineJoin
forall x. Rep LineJoin x -> LineJoin
forall x. LineJoin -> Rep LineJoin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineJoin x -> LineJoin
$cfrom :: forall x. LineJoin -> Rep LineJoin x
Generic)
fromLineJoin :: (IsString s) => LineJoin -> s
fromLineJoin :: LineJoin -> s
fromLineJoin LineJoin
LineJoinMiter = s
"miter"
fromLineJoin LineJoin
LineJoinBevel = s
"bevel"
fromLineJoin LineJoin
LineJoinRound = s
"round"
toLineJoin :: (Eq s, IsString s) => s -> LineJoin
toLineJoin :: s -> LineJoin
toLineJoin s
"miter" = LineJoin
LineJoinMiter
toLineJoin s
"bevel" = LineJoin
LineJoinBevel
toLineJoin s
"round" = LineJoin
LineJoinRound
toLineJoin s
_ = LineJoin
LineJoinMiter
fromDashArray :: [Double] -> Text
fromDashArray :: [Double] -> Text
fromDashArray [Double]
xs = Text -> [Text] -> Text
Text.intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show (Double -> Text) -> [Double] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
xs
data LineStyle = LineStyle
{ LineStyle -> Double
size :: Double,
LineStyle -> Colour
color :: Colour,
LineStyle -> Maybe LineCap
linecap :: Maybe LineCap,
LineStyle -> Maybe LineJoin
linejoin :: Maybe LineJoin,
LineStyle -> Maybe [Double]
dasharray :: Maybe [Double],
LineStyle -> Maybe Double
dashoffset :: Maybe Double
}
deriving (Int -> LineStyle -> ShowS
[LineStyle] -> ShowS
LineStyle -> String
(Int -> LineStyle -> ShowS)
-> (LineStyle -> String)
-> ([LineStyle] -> ShowS)
-> Show LineStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineStyle] -> ShowS
$cshowList :: [LineStyle] -> ShowS
show :: LineStyle -> String
$cshow :: LineStyle -> String
showsPrec :: Int -> LineStyle -> ShowS
$cshowsPrec :: Int -> LineStyle -> ShowS
Show, LineStyle -> LineStyle -> Bool
(LineStyle -> LineStyle -> Bool)
-> (LineStyle -> LineStyle -> Bool) -> Eq LineStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineStyle -> LineStyle -> Bool
$c/= :: LineStyle -> LineStyle -> Bool
== :: LineStyle -> LineStyle -> Bool
$c== :: LineStyle -> LineStyle -> Bool
Eq, (forall x. LineStyle -> Rep LineStyle x)
-> (forall x. Rep LineStyle x -> LineStyle) -> Generic LineStyle
forall x. Rep LineStyle x -> LineStyle
forall x. LineStyle -> Rep LineStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineStyle x -> LineStyle
$cfrom :: forall x. LineStyle -> Rep LineStyle x
Generic)
defaultLineStyle :: LineStyle
defaultLineStyle :: LineStyle
defaultLineStyle = Double
-> Colour
-> Maybe LineCap
-> Maybe LineJoin
-> Maybe [Double]
-> Maybe Double
-> LineStyle
LineStyle Double
0.012 Colour
dark Maybe LineCap
forall a. Maybe a
Nothing Maybe LineJoin
forall a. Maybe a
Nothing Maybe [Double]
forall a. Maybe a
Nothing Maybe Double
forall a. Maybe a
Nothing
data PathStyle = PathStyle
{ PathStyle -> Double
borderSize :: Double,
PathStyle -> Colour
borderColor :: Colour,
PathStyle -> Colour
color :: Colour
}
deriving (Int -> PathStyle -> ShowS
[PathStyle] -> ShowS
PathStyle -> String
(Int -> PathStyle -> ShowS)
-> (PathStyle -> String)
-> ([PathStyle] -> ShowS)
-> Show PathStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathStyle] -> ShowS
$cshowList :: [PathStyle] -> ShowS
show :: PathStyle -> String
$cshow :: PathStyle -> String
showsPrec :: Int -> PathStyle -> ShowS
$cshowsPrec :: Int -> PathStyle -> ShowS
Show, PathStyle -> PathStyle -> Bool
(PathStyle -> PathStyle -> Bool)
-> (PathStyle -> PathStyle -> Bool) -> Eq PathStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathStyle -> PathStyle -> Bool
$c/= :: PathStyle -> PathStyle -> Bool
== :: PathStyle -> PathStyle -> Bool
$c== :: PathStyle -> PathStyle -> Bool
Eq, (forall x. PathStyle -> Rep PathStyle x)
-> (forall x. Rep PathStyle x -> PathStyle) -> Generic PathStyle
forall x. Rep PathStyle x -> PathStyle
forall x. PathStyle -> Rep PathStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PathStyle x -> PathStyle
$cfrom :: forall x. PathStyle -> Rep PathStyle x
Generic)
defaultPathStyle :: PathStyle
defaultPathStyle :: PathStyle
defaultPathStyle =
Double -> Colour -> Colour -> PathStyle
PathStyle Double
0.01 (Int -> Colour
palette1 Int
1) (Int -> Colour
palette1 Int
2)