{-# 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
(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)

-- | 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
(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)

-- | Whether to scale text given X-axis scaling
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)

-- | position anchor
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)

-- | text
fromAnchor :: (IsString s) => Anchor -> s
fromAnchor :: 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 :: 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) Maybe Double
forall a. Maybe a
Nothing ScaleX
ScaleX Maybe RectStyle
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 (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)

-- | 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
(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)

-- | 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)
    (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

-- | Should glyph borders be scaled?
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)

-- | 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
(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)

-- | 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 = 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)

-- | Infinite list of glyph shapes
--
-- >>> gpalette1 0
-- CircleGlyph
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

-- | 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 (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
  ]

-- | line cap style
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)

-- | textifier
fromLineCap :: (IsString s) => LineCap -> s
fromLineCap :: 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 :: 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
(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)

-- | textifier
fromLineJoin :: (IsString s) => LineJoin -> s
fromLineJoin :: 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 :: 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
" " ([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

-- | 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
(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)

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

-- | 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
(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)

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