{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Definition of the syntactical manifestation of chart elements.
module Chart.Style
  ( Style (..),
    defaultStyle,
    scaleStyle,

    -- * RectStyle
    defaultRectStyle,
    blob,
    clear,
    border,

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

    -- * GlyphStyle
    defaultGlyphStyle,
    styleBoxGlyph,
    gpalette,
    GlyphShape (..),

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

    -- * PathStyle
    defaultPathStyle,

    -- * Style scaling
    ScaleP (..),
    scaleRatio,
  )
where

import Chart.Data
import Data.Bool
import Data.ByteString (ByteString)
import Data.Colour
import Data.List qualified as List
import Data.Maybe
import Data.Path
import Data.Path.Parser
import Data.String
import Data.Text (Text)
import Data.Text qualified as Text
import GHC.Generics
import NumHask.Space
import Optics.Core
import Prelude

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

-- | Stylistic content of chart elements, involving how chart data is represented in the physical chart.
--
-- >>> defaultStyle
-- Style {size = 6.0e-2, borderSize = 1.0e-2, color = Colour 0.02 0.73 0.80 0.10, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, anchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}
data Style = Style
  { -- | The size of the element in relation to the canvas domain.
    Style -> Double
size :: Double,
    -- | stroke-width
    Style -> Double
borderSize :: Double,
    -- | fill & fill-opacity
    Style -> Colour
color :: Colour,
    -- | stroke & stroke-opacity
    Style -> Colour
borderColor :: Colour,
    -- | How to treat scale projections.
    Style -> ScaleP
scaleP :: ScaleP,
    -- | text-anchor
    Style -> Anchor
anchor :: Anchor,
    -- | element rotation is radians
    Style -> Maybe Double
rotation :: Maybe Double,
    -- | element translation
    Style -> Maybe (Point Double)
translate :: Maybe (Point Double),
    -- | whether to html-like escape text
    Style -> EscapeText
escapeText :: EscapeText,
    -- | rectangular frame around an element.
    Style -> Maybe Style
frame :: Maybe Style,
    -- | stroke-linecap
    Style -> Maybe LineCap
lineCap :: Maybe LineCap,
    -- | stroke-linejoin
    Style -> Maybe LineJoin
lineJoin :: Maybe LineJoin,
    -- | stroke-dasharray
    Style -> Maybe [Double]
dasharray :: Maybe [Double],
    -- | stroke-dashoffset
    Style -> Maybe Double
dashoffset :: Maybe Double,
    -- | horizontal scaling modifier for text
    Style -> Double
hsize :: Double,
    -- | vertical scaling modifier for text
    Style -> Double
vsize :: Double,
    -- | horizontal shift for text alignment
    Style -> Double
vshift :: Double,
    -- | shape for glyph chart elements
    Style -> GlyphShape
glyphShape :: GlyphShape
  }
  deriving (Style -> Style -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c== :: Style -> Style -> Bool
Eq, Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Style] -> ShowS
$cshowList :: [Style] -> ShowS
show :: Style -> String
$cshow :: Style -> String
showsPrec :: Int -> Style -> ShowS
$cshowsPrec :: Int -> Style -> ShowS
Show, forall x. Rep Style x -> Style
forall x. Style -> Rep Style x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Style x -> Style
$cfrom :: forall x. Style -> Rep Style x
Generic)

-- | The official default style
--
-- >>> defaultStyle
-- Style {size = 6.0e-2, borderSize = 1.0e-2, color = Colour 0.02 0.73 0.80 0.10, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, anchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}
defaultStyle :: Style
defaultStyle :: Style
defaultStyle = Double
-> Double
-> Colour
-> Colour
-> ScaleP
-> Anchor
-> Maybe Double
-> Maybe (Point Double)
-> EscapeText
-> Maybe Style
-> Maybe LineCap
-> Maybe LineJoin
-> Maybe [Double]
-> Maybe Double
-> Double
-> Double
-> Double
-> GlyphShape
-> Style
Style Double
0.06 Double
0.01 (Int -> Double -> Colour
paletteO Int
0 Double
0.1) (Int -> Double -> Colour
paletteO Int
1 Double
1) ScaleP
NoScaleP Anchor
AnchorMiddle forall a. Maybe a
Nothing forall a. Maybe a
Nothing EscapeText
EscapeText forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing Double
0.6 Double
1.1 (-Double
0.25) GlyphShape
SquareGlyph

-- | The official style for rectangles.
--
-- >>> defaultRectStyle
-- Style {size = 6.0e-2, borderSize = 1.0e-2, color = Colour 0.02 0.73 0.80 0.10, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, anchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}
defaultRectStyle :: Style
defaultRectStyle :: Style
defaultRectStyle = Style
defaultStyle

-- | The official style for text elements.
--
-- >>> defaultTextStyle
-- Style {size = 6.0e-2, borderSize = 1.0e-2, color = Colour 0.05 0.05 0.05 1.00, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, anchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}
defaultTextStyle :: Style
defaultTextStyle :: Style
defaultTextStyle = Style
defaultStyle forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "size" a => a
#size Double
0.06 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "color" a => a
#color Colour
dark

-- | The official style for glyphs.
--
-- >>> defaultGlyphStyle
-- Style {size = 3.0e-2, borderSize = 3.0e-3, color = Colour 0.02 0.73 0.80 0.20, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, anchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}
defaultGlyphStyle :: Style
defaultGlyphStyle :: Style
defaultGlyphStyle = Style
defaultStyle forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "size" a => a
#size Double
0.03 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "color" a => a
#color (Int -> Double -> Colour
paletteO Int
0 Double
0.2) forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "borderColor" a => a
#borderColor (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
paletteO Int
1 Double
1) forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "borderSize" a => a
#borderSize Double
0.003

-- | The official style for lines.
--
-- >>> defaultLineStyle
-- Style {size = 1.2e-2, borderSize = 1.0e-2, color = Colour 0.05 0.05 0.05 1.00, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, anchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}
defaultLineStyle :: Style
defaultLineStyle :: Style
defaultLineStyle = Style
defaultStyle forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "size" a => a
#size Double
0.012 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "color" a => a
#color Colour
dark

-- | The official style for paths.
--
-- >>> defaultPathStyle
-- Style {size = 6.0e-2, borderSize = 1.0e-2, color = Colour 0.66 0.07 0.55 1.00, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, anchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}
defaultPathStyle :: Style
defaultPathStyle :: Style
defaultPathStyle = Style
defaultStyle forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "color" a => a
#color (Int -> Colour
palette Int
2) forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "borderColor" a => a
#borderColor (Int -> Colour
palette Int
1)

-- | Scale the size, borderSize and any translations of a 'Style'.
scaleStyle :: Double -> Style -> Style
scaleStyle :: Double -> Style -> Style
scaleStyle Double
x Style
s =
  Style
s
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "size" a => a
#size (Double
x *)
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "borderSize" a => a
#borderSize (Double
x *)
    forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over forall a. IsLabel "translate" a => a
#translate (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
x *)))

-- | solid rectangle, no border
--
-- >>> blob black
-- Style {size = 6.0e-2, borderSize = 0.0, color = Colour 0.00 0.00 0.00 1.00, borderColor = Colour 0.00 0.00 0.00 0.00, scaleP = NoScaleP, anchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}
blob :: Colour -> Style
blob :: Colour -> Style
blob Colour
c = Style
defaultRectStyle forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "borderSize" a => a
#borderSize Double
0 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "borderColor" a => a
#borderColor Colour
transparent forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "color" a => a
#color Colour
c

-- | transparent rect
--
-- >>> clear
-- Style {size = 6.0e-2, borderSize = 0.0, color = Colour 0.00 0.00 0.00 0.00, borderColor = Colour 0.00 0.00 0.00 0.00, scaleP = NoScaleP, anchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}
clear :: Style
clear :: Style
clear = Style
defaultRectStyle forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "borderSize" a => a
#borderSize Double
0 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "borderColor" a => a
#borderColor Colour
transparent forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "color" a => a
#color Colour
transparent

-- | transparent rectangle, with border
--
-- >>> border 0.01 transparent
-- Style {size = 6.0e-2, borderSize = 1.0e-2, color = Colour 0.00 0.00 0.00 0.00, borderColor = Colour 0.00 0.00 0.00 0.00, scaleP = NoScaleP, anchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}
border :: Double -> Colour -> Style
border :: Double -> Colour -> Style
border Double
s Colour
c = Style
defaultRectStyle forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "borderSize" a => a
#borderSize Double
s forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "borderColor" a => a
#borderColor Colour
c forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "color" a => a
#color Colour
transparent

-- | Whether to escape the common XML escaped characters.
data EscapeText = EscapeText | NoEscapeText deriving (EscapeText -> EscapeText -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EscapeText -> EscapeText -> Bool
$c/= :: EscapeText -> EscapeText -> Bool
== :: EscapeText -> EscapeText -> Bool
$c== :: EscapeText -> EscapeText -> Bool
Eq, Int -> EscapeText -> ShowS
[EscapeText] -> ShowS
EscapeText -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EscapeText] -> ShowS
$cshowList :: [EscapeText] -> ShowS
show :: EscapeText -> String
$cshow :: EscapeText -> String
showsPrec :: Int -> EscapeText -> ShowS
$cshowsPrec :: Int -> EscapeText -> ShowS
Show, forall x. Rep EscapeText x -> EscapeText
forall x. EscapeText -> Rep EscapeText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EscapeText x -> EscapeText
$cfrom :: forall x. EscapeText -> Rep EscapeText 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 extra area from text styling
styleBoxText ::
  Style ->
  Text ->
  Point Double ->
  Rect Double
styleBoxText :: Style -> Text -> Point Double -> Rect Double
styleBoxText Style
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) (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 Style
o)
  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 = 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 Style
o
    h :: Double
h = forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "hsize" a => a
#hsize Style
o
    v :: Double
v = forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "vsize" a => a
#vsize Style
o
    n1 :: Double
n1 = forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "vshift" a => a
#vshift Style
o
    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 (Text -> Int
Text.length 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 forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "anchor" a => a
#anchor Style
o 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 Style
o of
      Maybe Style
Nothing -> forall a. a -> a
id
      Just Style
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 Style
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 Style
o)

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

-- | the extra area from glyph styling
styleBoxGlyph :: Style -> Rect Double
styleBoxGlyph :: Style -> Rect Double
styleBoxGlyph Style
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 forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "glyphShape" a => a
#glyphShape Style
s of
      GlyphShape
CircleGlyph -> (Double
sz *) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Multiplicative a => a
one
      GlyphShape
SquareGlyph -> (Double
sz *) 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 (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 Style
s) 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 (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 Style
s)) forall a. Multiplicative a => a
one
      TriangleGlyph Point Double
a Point Double
b Point Double
c -> (Double
sz *) 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 ByteString
path' -> 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 *)) ([PathData Double] -> Maybe (Rect Double)
pathBoxes forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [PathData Double]
svgToPathData forall a b. (a -> b) -> a -> b
$ ByteString
path')
  where
    sz :: Double
sz = 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 Style
s
    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
* 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 Style
s)
    p' :: Point Double
p' = forall a. a -> Maybe a -> a
fromMaybe (forall a. a -> a -> Point a
Point Double
0.0 Double
0.0) (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "translate" a => a
#translate Style
s)
    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 Style
s)

-- | Infinite list of glyph shapes
--
-- >>> gpalette 0
-- CircleGlyph
gpalette :: Int -> GlyphShape
gpalette :: Int -> GlyphShape
gpalette 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),
    ByteString -> GlyphShape
PathGlyph ByteString
"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"
  ]

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

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

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

-- | Scale Projection options
data ScaleP
  = -- | Do not scale under projection.
    NoScaleP
  | -- | Scale based on the X axis ratio of a projection
    ScalePX
  | -- | Scale based on the Y axis ratio of a projection
    ScalePY
  | -- | Scale based on minimum of (X axis, Y axis) ratio
    ScalePMinDim
  | -- | Scale based on the area ratio of a projection
    ScalePArea
  deriving (forall x. Rep ScaleP x -> ScaleP
forall x. ScaleP -> Rep ScaleP x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScaleP x -> ScaleP
$cfrom :: forall x. ScaleP -> Rep ScaleP x
Generic, ScaleP -> ScaleP -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScaleP -> ScaleP -> Bool
$c/= :: ScaleP -> ScaleP -> Bool
== :: ScaleP -> ScaleP -> Bool
$c== :: ScaleP -> ScaleP -> Bool
Eq, Int -> ScaleP -> ShowS
[ScaleP] -> ShowS
ScaleP -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScaleP] -> ShowS
$cshowList :: [ScaleP] -> ShowS
show :: ScaleP -> String
$cshow :: ScaleP -> String
showsPrec :: Int -> ScaleP -> ShowS
$cshowsPrec :: Int -> ScaleP -> ShowS
Show)

-- | given a ScaleP and two Rects, what is the scaling factor for a projection
--
-- Guards against scaling to zero or infinity
scaleRatio :: ScaleP -> Rect Double -> Rect Double -> Double
scaleRatio :: ScaleP -> Rect Double -> Rect Double -> Double
scaleRatio ScaleP
NoScaleP Rect Double
_ Rect Double
_ = Double
1
scaleRatio ScaleP
ScalePX Rect Double
new Rect Double
old = forall a. a -> a -> Bool -> a
bool Double
1 (forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
nx forall a. Fractional a => a -> a -> a
/ forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ox) (forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ox forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
nx forall a. Ord a => a -> a -> Bool
> Double
0)
  where
    (Ranges Range Double
nx Range Double
_) = Rect Double
new
    (Ranges Range Double
ox Range Double
_) = Rect Double
old
scaleRatio ScaleP
ScalePY Rect Double
new Rect Double
old = forall a. a -> a -> Bool -> a
bool Double
1 (forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ny forall a. Fractional a => a -> a -> a
/ forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
oy) (forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
oy forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ny forall a. Ord a => a -> a -> Bool
> Double
0)
  where
    (Ranges Range Double
_ Range Double
ny) = Rect Double
new
    (Ranges Range Double
_ Range Double
oy) = Rect Double
old
scaleRatio ScaleP
ScalePArea Rect Double
new Rect Double
old = forall a. a -> a -> Bool -> a
bool Double
1 (forall a. Floating a => a -> a
sqrt (Double
an forall a. Fractional a => a -> a -> a
/ Double
ao)) (Double
an forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
ao forall a. Ord a => a -> a -> Bool
> Double
0)
  where
    (Ranges Range Double
nx Range Double
ny) = Rect Double
new
    (Ranges Range Double
ox Range Double
oy) = Rect Double
old
    an :: Double
an = forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
nx forall a. Num a => a -> a -> a
* forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ny
    ao :: Double
ao = forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ox forall a. Num a => a -> a -> a
* forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
oy
scaleRatio ScaleP
ScalePMinDim Rect Double
new Rect Double
old = Double
closestToOne
  where
    x' :: Double
x' = ScaleP -> Rect Double -> Rect Double -> Double
scaleRatio ScaleP
ScalePX Rect Double
new Rect Double
old
    y' :: Double
y' = ScaleP -> Rect Double -> Rect Double -> Double
scaleRatio ScaleP
ScalePY Rect Double
new Rect Double
old
    closestToOne :: Double
closestToOne
      | Double
x' forall a. Ord a => a -> a -> Bool
>= Double
1 Bool -> Bool -> Bool
&& Double
y' forall a. Ord a => a -> a -> Bool
>= Double
1 = forall a. a -> a -> Bool -> a
bool Double
x' Double
y' (Double
x' forall a. Ord a => a -> a -> Bool
> Double
y')
      | Double
x' forall a. Ord a => a -> a -> Bool
>= Double
1 Bool -> Bool -> Bool
&& Double
y' forall a. Ord a => a -> a -> Bool
< Double
1 = forall a. a -> a -> Bool -> a
bool Double
x' Double
y' (Double
x' forall a. Ord a => a -> a -> Bool
> (Double
1 forall a. Fractional a => a -> a -> a
/ Double
y'))
      | Double
x' forall a. Ord a => a -> a -> Bool
< Double
1 Bool -> Bool -> Bool
&& Double
y' forall a. Ord a => a -> a -> Bool
>= Double
1 = forall a. a -> a -> Bool -> a
bool Double
x' Double
y' ((Double
1 forall a. Fractional a => a -> a -> a
/ Double
x') forall a. Ord a => a -> a -> Bool
> Double
y')
      | Bool
otherwise = forall a. a -> a -> Bool -> a
bool Double
x' Double
y' ((Double
1 forall a. Fractional a => a -> a -> a
/ Double
x') forall a. Ord a => a -> a -> Bool
> (Double
1 forall a. Fractional a => a -> a -> a
/ Double
y'))