{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}

-- | Stylistic or syntactical options for chart elements.
--
module Chart.Style
  ( -- * RectStyle
    RectStyle (..),
    defaultRectStyle,
    blob,
    clear,
    border,

    -- * TextStyle
    TextStyle (..),
    defaultTextStyle,
    styleBoxText,
    ScaleX (..),

    -- * GlyphStyle
    GlyphStyle (..),
    defaultGlyphStyle,
    styleBoxGlyph,
    gpalette1,
    ScaleBorder (..),
    GlyphShape (..),
    glyphText,

    -- * LineStyle
    LineStyle (..),
    defaultLineStyle,
    LineCap (..),
    fromLineCap,
    toLineCap,
    LineJoin (..),
    fromLineJoin,
    toLineJoin,
    fromDashArray,
    Anchor (..),
    fromAnchor,
    toAnchor,

    -- * PathStyle
    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

-- $setup
--
-- >>> :set -XOverloadedLabels
-- >>> :set -XOverloadedStrings
-- >>> import Chart
-- >>> import Optics.Core

-- | Rectangle styling
--
-- >>> defaultRectStyle
-- RectStyle {borderSize = 1.0e-2, borderColor = Colour 0.02 0.29 0.48 1.00, color = Colour 0.02 0.73 0.80 0.10}
--
-- ![unit example](other/unit.svg)
data RectStyle = RectStyle
  { RectStyle -> Double
borderSize :: Double,
    RectStyle -> Colour
borderColor :: Colour,
    RectStyle -> Colour
color :: Colour
  }
  deriving (Int -> RectStyle -> ShowS
[RectStyle] -> ShowS
RectStyle -> String
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
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. 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)

-- | the style
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)

-- | solid rectangle, no border
--
-- >>> blob black
-- RectStyle {borderSize = 0.0, borderColor = Colour 0.00 0.00 0.00 0.00, color = Colour 0.00 0.00 0.00 1.00}
blob :: Colour -> RectStyle
blob :: Colour -> RectStyle
blob = Double -> Colour -> Colour -> RectStyle
RectStyle Double
0 Colour
transparent

-- | transparent rect
--
-- >>> clear
-- RectStyle {borderSize = 0.0, borderColor = Colour 0.00 0.00 0.00 0.00, color = Colour 0.00 0.00 0.00 0.00}
clear :: RectStyle
clear :: RectStyle
clear = Double -> Colour -> Colour -> RectStyle
RectStyle Double
0 Colour
transparent Colour
transparent

-- | transparent rectangle, with border
--
-- >>> border 0.01 transparent
-- RectStyle {borderSize = 1.0e-2, borderColor = Colour 0.00 0.00 0.00 0.00, color = Colour 0.00 0.00 0.00 0.00}
border :: Double -> Colour -> RectStyle
border :: Double -> Colour -> RectStyle
border Double
s Colour
c = Double -> Colour -> Colour -> RectStyle
RectStyle Double
s Colour
c Colour
transparent

-- | Text styling
--
-- >>> defaultTextStyle
-- TextStyle {size = 0.12, color = Colour 0.05 0.05 0.05 1.00, anchor = AnchorMiddle, hsize = 0.45, vsize = 1.1, vshift = -0.25, rotation = Nothing, scalex = ScaleX, frame = Nothing}
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
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
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. 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)

-- | Whether to scale text given X-axis scaling
data ScaleX = ScaleX | NoScaleX deriving (ScaleX -> ScaleX -> Bool
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
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. 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)

-- | position anchor
data Anchor = AnchorMiddle | AnchorStart | AnchorEnd deriving (Anchor -> Anchor -> Bool
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
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. 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)

-- | text
fromAnchor :: (IsString s) => Anchor -> s
fromAnchor :: forall s. IsString s => Anchor -> s
fromAnchor Anchor
AnchorMiddle = s
"Middle"
fromAnchor Anchor
AnchorStart = s
"Start"
fromAnchor Anchor
AnchorEnd = s
"End"

-- | from text
toAnchor :: (Eq s, IsString s) => s -> Anchor
toAnchor :: forall s. (Eq s, IsString s) => s -> Anchor
toAnchor s
"Middle" = Anchor
AnchorMiddle
toAnchor s
"Start" = Anchor
AnchorStart
toAnchor s
"End" = Anchor
AnchorEnd
toAnchor s
_ = Anchor
AnchorMiddle

-- | the offical text style
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) forall a. Maybe a
Nothing ScaleX
ScaleX forall a. Maybe a
Nothing

-- | the extra area from text styling
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 forall a b. (a -> b) -> a -> b
$ forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
p forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rect Double
flat (forall a. (TrigField a, Ord a) => a -> Rect a -> Rect a
`rotationBound` Rect Double
flat) (TextStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "rotation" a => a
#rotation)
  where
    flat :: Rect Double
flat = forall a. a -> a -> a -> a -> Rect a
Rect ((-Double
x' forall a. Fractional a => a -> a -> a
/ Double
2.0) forall a. Num a => a -> a -> a
+ Double
x' forall a. Num a => a -> a -> a
* Double
a') (Double
x' forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
+ Double
x' forall a. Num a => a -> a -> a
* Double
a') (-Double
y' forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
+ Double
n1') (Double
y' forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
+ Double
n1')
    s :: Double
s = TextStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size
    h :: Double
h = TextStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "hsize" a => a
#hsize
    v :: Double
v = TextStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "vsize" a => a
#vsize
    n1 :: Double
n1 = TextStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "vshift" a => a
#vshift
    x' :: Double
x' = Double
s forall a. Num a => a -> a -> a
* Double
h forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Text -> Int
Text.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall str. Tag str -> Maybe str
maybeTagText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall str. StringLike str => str -> [Tag str]
parseTags Text
t)
    y' :: Double
y' = Double
s forall a. Num a => a -> a -> a
* Double
v
    n1' :: Double
n1' = -Double
s forall a. Num a => a -> a -> a
* Double
n1
    a' :: Double
a' = case TextStyle
o forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "anchor" a => a
#anchor of
      Anchor
AnchorStart -> Double
0.5
      Anchor
AnchorEnd -> -Double
0.5
      Anchor
AnchorMiddle -> Double
0.0
    mpad :: Rect Double -> Rect Double
mpad = case forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "frame" a => a
#frame TextStyle
o of
      Maybe RectStyle
Nothing -> forall a. a -> a
id
      Just RectStyle
f -> forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Double
0.5 forall a. Num a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "borderSize" a => a
#borderSize RectStyle
f forall a. Num a => a -> a -> a
* forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "size" a => a
#size TextStyle
o)

-- | Glyph styling
--
-- >>> defaultGlyphStyle
-- GlyphStyle {size = 3.0e-2, color = Colour 0.02 0.73 0.80 0.20, borderColor = Colour 0.02 0.29 0.48 1.00, borderSize = 3.0e-3, shape = SquareGlyph, rotation = Nothing, translate = Nothing}
--
-- ![glyph example](other/glyphs.svg)
data GlyphStyle = GlyphStyle
  { -- | glyph radius
    GlyphStyle -> Double
size :: Double,
    -- | fill color
    GlyphStyle -> Colour
color :: Colour,
    -- | stroke color
    GlyphStyle -> Colour
borderColor :: Colour,
    -- | stroke width (adds a bit to the bounding box)
    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
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
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. 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)

-- | the offical glyph style
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)
    (forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' Colour Double
lightness' Double
0.4 forall a b. (a -> b) -> a -> b
$ Int -> Double -> Colour
palette1a Int
1 Double
1)
    Double
0.003
    GlyphShape
SquareGlyph
    forall a. Maybe a
Nothing
    forall a. Maybe a
Nothing

-- | Should glyph borders be scaled?
data ScaleBorder = ScaleBorder | NoScaleBorder deriving (Int -> ScaleBorder -> ShowS
[ScaleBorder] -> ShowS
ScaleBorder -> String
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
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. 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)

-- | glyph shapes
data GlyphShape
  = CircleGlyph
  | SquareGlyph
  | EllipseGlyph Double
  | RectSharpGlyph Double
  | RectRoundedGlyph Double Double Double
  | -- | line width is determined by borderSize
    TriangleGlyph (Point Double) (Point Double) (Point Double)
  | VLineGlyph
  | HLineGlyph
  | PathGlyph Text ScaleBorder
  deriving (Int -> GlyphShape -> ShowS
[GlyphShape] -> ShowS
GlyphShape -> String
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
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. 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)

-- | textifier
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"

-- | the extra area from glyph styling
styleBoxGlyph :: GlyphStyle -> Rect Double
styleBoxGlyph :: GlyphStyle -> Rect Double
styleBoxGlyph GlyphStyle
s = forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Point Double
p' forall a b. (a -> b) -> a -> b
$
  Rect Double -> Rect Double
rot' forall a b. (a -> b) -> a -> b
$
    Rect Double -> Rect Double
sw forall a b. (a -> b) -> a -> b
$ case GlyphShape
sh of
      GlyphShape
CircleGlyph -> (Double
sz forall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Multiplicative a => a
one
      GlyphShape
SquareGlyph -> (Double
sz forall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Multiplicative a => a
one
      EllipseGlyph Double
a -> forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (forall a. a -> a -> Point a
Point Double
sz (Double
a forall a. Num a => a -> a -> a
* Double
sz)) forall a. Multiplicative a => a
one
      RectSharpGlyph Double
a -> forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (forall a. a -> a -> Point a
Point Double
sz (Double
a forall a. Num a => a -> a -> a
* Double
sz)) forall a. Multiplicative a => a
one
      RectRoundedGlyph Double
a Double
_ Double
_ -> forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (forall a. a -> a -> Point a
Point Double
sz (Double
a forall a. Num a => a -> a -> a
* Double
sz)) forall a. Multiplicative a => a
one
      GlyphShape
VLineGlyph -> forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (forall a. a -> a -> Point a
Point (GlyphStyle
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderSize" a => a
#borderSize) Double
sz) forall a. Multiplicative a => a
one
      GlyphShape
HLineGlyph -> forall s.
(Multiplicative (Element s), Space s) =>
Element s -> s -> s
scale (forall a. a -> a -> Point a
Point Double
sz (GlyphStyle
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderSize" a => a
#borderSize)) forall a. Multiplicative a => a
one
      TriangleGlyph Point Double
a Point Double
b Point Double
c -> (Double
sz forall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
_ -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Additive a => a
zero (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
sz forall a. Num a => a -> a -> a
*)) ([PathData Double] -> Maybe (Rect Double)
pathBoxes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [PathData Double]
svgToPathData forall a b. (a -> b) -> a -> b
$ Text
path')
  where
    sh :: GlyphShape
sh = GlyphStyle
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "shape" a => a
#shape
    sz :: Double
sz = GlyphStyle
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "size" a => a
#size
    sw :: Rect Double -> Rect Double
sw = forall a. Subtractive a => a -> Rect a -> Rect a
padRect (Double
0.5 forall a. Num a => a -> a -> a
* GlyphStyle
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "borderSize" a => a
#borderSize)
    p' :: Point Double
p' = forall a. a -> Maybe a -> a
fromMaybe (forall a. a -> a -> Point a
Point Double
0.0 Double
0.0) (GlyphStyle
s forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "translate" a => a
#translate)
    rot' :: Rect Double -> Rect Double
rot' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. (TrigField a, Ord a) => a -> Rect a -> Rect a
rotationBound (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "rotation" a => a
#rotation GlyphStyle
s)

-- | Infinite list of glyph shapes
--
-- >>> gpalette1 0
-- CircleGlyph
gpalette1 :: Int -> GlyphShape
gpalette1 :: Int -> GlyphShape
gpalette1 Int
x = forall a. [a] -> [a]
cycle [GlyphShape]
gpalette1_ forall a. [a] -> Int -> a
List.!! Int
x

-- | finite list of glyphs
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 (forall a. a -> a -> Point a
Point Double
0.0 Double
0.0) (forall a. a -> a -> Point a
Point Double
1 Double
1) (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
  ]

-- | line cap style
data LineCap = LineCapButt | LineCapRound | LineCapSquare deriving (LineCap -> LineCap -> Bool
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
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. 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)

-- | textifier
fromLineCap :: (IsString s) => LineCap -> s
fromLineCap :: forall s. IsString s => LineCap -> s
fromLineCap LineCap
LineCapButt = s
"butt"
fromLineCap LineCap
LineCapRound = s
"round"
fromLineCap LineCap
LineCapSquare = s
"square"

-- | readifier
toLineCap :: (Eq s, IsString s) => s -> LineCap
toLineCap :: forall s. (Eq s, IsString s) => s -> LineCap
toLineCap s
"butt" = LineCap
LineCapButt
toLineCap s
"round" = LineCap
LineCapRound
toLineCap s
"square" = LineCap
LineCapSquare
toLineCap s
_ = LineCap
LineCapButt

-- | line cap style
data LineJoin = LineJoinMiter | LineJoinBevel | LineJoinRound deriving (LineJoin -> LineJoin -> Bool
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
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. 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)

-- | textifier
fromLineJoin :: (IsString s) => LineJoin -> s
fromLineJoin :: forall s. IsString s => LineJoin -> s
fromLineJoin LineJoin
LineJoinMiter = s
"miter"
fromLineJoin LineJoin
LineJoinBevel = s
"bevel"
fromLineJoin LineJoin
LineJoinRound = s
"round"

-- | readifier
toLineJoin :: (Eq s, IsString s) => s -> LineJoin
toLineJoin :: forall s. (Eq s, IsString s) => s -> LineJoin
toLineJoin s
"miter" = LineJoin
LineJoinMiter
toLineJoin s
"bevel" = LineJoin
LineJoinBevel
toLineJoin s
"round" = LineJoin
LineJoinRound
toLineJoin s
_ = LineJoin
LineJoinMiter

-- | Convert a dash representation from a list to text
fromDashArray :: [Double] -> Text
fromDashArray :: [Double] -> Text
fromDashArray [Double]
xs = Text -> [Text] -> Text
Text.intercalate Text
" " forall a b. (a -> b) -> a -> b
$ String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
xs

-- | line style
--
-- >>> defaultLineStyle
-- LineStyle {size = 1.2e-2, color = Colour 0.05 0.05 0.05 1.00, linecap = Nothing, linejoin = Nothing, dasharray = Nothing, dashoffset = Nothing}
--
-- ![line example](other/line.svg)
--
-- See also <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute>
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
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
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. 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)

-- | the official default line style
defaultLineStyle :: LineStyle
defaultLineStyle :: LineStyle
defaultLineStyle = Double
-> Colour
-> Maybe LineCap
-> Maybe LineJoin
-> Maybe [Double]
-> Maybe Double
-> LineStyle
LineStyle Double
0.012 Colour
dark forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | Path styling
--
-- >>> defaultPathStyle
-- PathStyle {borderSize = 1.0e-2, borderColor = Colour 0.02 0.29 0.48 1.00, color = Colour 0.66 0.07 0.55 1.00}
data PathStyle = PathStyle
  { PathStyle -> Double
borderSize :: Double,
    PathStyle -> Colour
borderColor :: Colour,
    PathStyle -> Colour
color :: Colour
  }
  deriving (Int -> PathStyle -> ShowS
[PathStyle] -> ShowS
PathStyle -> String
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
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. 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)

-- | the style
defaultPathStyle :: PathStyle
defaultPathStyle :: PathStyle
defaultPathStyle =
  Double -> Colour -> Colour -> PathStyle
PathStyle Double
0.01 (Int -> Colour
palette1 Int
1) (Int -> Colour
palette1 Int
2)