{-# 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,

    -- * Stack Styling
    TextAnchor (..),
    fromTextAnchor,
    fromAnchoring,
    Align (..),

    -- * 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, textAnchor = 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 -> TextAnchor
textAnchor :: TextAnchor,
    -- | 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
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
/= :: Style -> Style -> Bool
Eq, Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
(Int -> Style -> ShowS)
-> (Style -> String) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Style -> ShowS
showsPrec :: Int -> Style -> ShowS
$cshow :: Style -> String
show :: Style -> String
$cshowList :: [Style] -> ShowS
showList :: [Style] -> ShowS
Show, (forall x. Style -> Rep Style x)
-> (forall x. Rep Style x -> Style) -> Generic Style
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
$cfrom :: forall x. Style -> Rep Style x
from :: forall x. Style -> Rep Style x
$cto :: forall x. Rep Style x -> Style
to :: forall x. Rep Style x -> Style
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, textAnchor = 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
-> TextAnchor
-> 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 TextAnchor
AnchorMiddle Maybe Double
forall a. Maybe a
Nothing Maybe (Point Double)
forall a. Maybe a
Nothing EscapeText
EscapeText Maybe Style
forall a. Maybe a
Nothing 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 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, textAnchor = 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, textAnchor = 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 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx Style Double -> Double -> Style -> Style
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 Style Double
#size Double
0.06 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
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 Style Style Colour Colour
#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, textAnchor = 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 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx Style Double -> Double -> Style -> Style
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 Style Double
#size Double
0.03 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
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 Style Style Colour Colour
#color (Int -> Double -> Colour
paletteO Int
0 Double
0.2) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
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 Style Style Colour Colour
#borderColor (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
paletteO Int
1 Double
1) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx Style Double -> Double -> Style -> Style
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 Style Double
#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, textAnchor = 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 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx Style Double -> Double -> Style -> Style
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 Style Double
#size Double
0.012 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
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 Style Style Colour Colour
#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, textAnchor = 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 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
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 Style Style Colour Colour
#color (Int -> Colour
palette Int
2) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
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 Style Style Colour Colour
#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
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx Style Double
-> (Double -> Double) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic' A_Lens NoIx Style Double
#size (Double
x *)
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx Style Double
-> (Double -> Double) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic' A_Lens NoIx Style Double
#borderSize (Double
x *)
    Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  Style
  Style
  (Maybe (Point Double))
  (Maybe (Point Double))
-> (Maybe (Point Double) -> Maybe (Point Double)) -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic
  A_Lens
  NoIx
  Style
  Style
  (Maybe (Point Double))
  (Maybe (Point Double))
#translate ((Point Double -> Point Double)
-> Maybe (Point Double) -> Maybe (Point Double)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double) -> Point Double -> Point Double
forall a b. (a -> b) -> Point a -> Point b
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, textAnchor = 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 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx Style Double -> Double -> Style -> Style
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 Style Double
#borderSize Double
0 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
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 Style Style Colour Colour
#borderColor Colour
transparent Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
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 Style Style Colour Colour
#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, textAnchor = 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 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx Style Double -> Double -> Style -> Style
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 Style Double
#borderSize Double
0 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
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 Style Style Colour Colour
#borderColor Colour
transparent Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
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 Style Style Colour Colour
#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, textAnchor = 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 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx Style Double -> Double -> Style -> Style
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 Style Double
#borderSize Double
s Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
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 Style Style Colour Colour
#borderColor Colour
c Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
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 Style Style Colour Colour
#color Colour
transparent

-- | Whether to escape the common XML escaped characters.
data EscapeText = EscapeText | NoEscapeText deriving (EscapeText -> EscapeText -> Bool
(EscapeText -> EscapeText -> Bool)
-> (EscapeText -> EscapeText -> Bool) -> Eq EscapeText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EscapeText -> EscapeText -> Bool
== :: EscapeText -> EscapeText -> Bool
$c/= :: EscapeText -> EscapeText -> Bool
/= :: EscapeText -> EscapeText -> Bool
Eq, Int -> EscapeText -> ShowS
[EscapeText] -> ShowS
EscapeText -> String
(Int -> EscapeText -> ShowS)
-> (EscapeText -> String)
-> ([EscapeText] -> ShowS)
-> Show EscapeText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EscapeText -> ShowS
showsPrec :: Int -> EscapeText -> ShowS
$cshow :: EscapeText -> String
show :: EscapeText -> String
$cshowList :: [EscapeText] -> ShowS
showList :: [EscapeText] -> ShowS
Show, (forall x. EscapeText -> Rep EscapeText x)
-> (forall x. Rep EscapeText x -> EscapeText) -> Generic EscapeText
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
$cfrom :: forall x. EscapeText -> Rep EscapeText x
from :: forall x. EscapeText -> Rep EscapeText x
$cto :: forall x. Rep EscapeText x -> EscapeText
to :: forall x. Rep EscapeText x -> EscapeText
Generic)

-- | 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 (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 Element (Rect Double)
Point 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) (Optic' A_Lens NoIx Style (Maybe Double) -> Style -> Maybe Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style (Maybe Double)
#rotation Style
o)
  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 = Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#size Style
o
    h :: Double
h = Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#hsize Style
o
    v :: Double
v = Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#vsize Style
o
    n1 :: Double
n1 = Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#vshift Style
o
    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 (Text -> Int
Text.length 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 Optic' A_Lens NoIx Style TextAnchor -> Style -> TextAnchor
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style TextAnchor
#textAnchor Style
o of
      TextAnchor
AnchorStart -> Double
0.5
      TextAnchor
AnchorEnd -> -Double
0.5
      TextAnchor
AnchorMiddle -> Double
0.0
    mpad :: Rect Double -> Rect Double
mpad = case Optic' A_Lens NoIx Style (Maybe Style) -> Style -> Maybe Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style (Maybe Style)
#frame Style
o of
      Maybe Style
Nothing -> Rect Double -> Rect Double
forall a. a -> a
id
      Just Style
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 Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#borderSize Style
f Double -> Double -> Double
forall a. Num a => a -> a -> a
* Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#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
(Int -> GlyphShape -> ShowS)
-> (GlyphShape -> String)
-> ([GlyphShape] -> ShowS)
-> Show GlyphShape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlyphShape -> ShowS
showsPrec :: Int -> GlyphShape -> ShowS
$cshow :: GlyphShape -> String
show :: GlyphShape -> String
$cshowList :: [GlyphShape] -> ShowS
showList :: [GlyphShape] -> ShowS
Show, GlyphShape -> GlyphShape -> Bool
(GlyphShape -> GlyphShape -> Bool)
-> (GlyphShape -> GlyphShape -> Bool) -> Eq GlyphShape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GlyphShape -> GlyphShape -> Bool
== :: GlyphShape -> GlyphShape -> Bool
$c/= :: GlyphShape -> GlyphShape -> Bool
/= :: 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
$cfrom :: forall x. GlyphShape -> Rep GlyphShape x
from :: forall x. GlyphShape -> Rep GlyphShape x
$cto :: forall x. Rep GlyphShape x -> GlyphShape
to :: forall x. Rep GlyphShape x -> GlyphShape
Generic)

-- | the extra area from glyph styling
styleBoxGlyph :: Style -> Rect Double
styleBoxGlyph :: Style -> Rect Double
styleBoxGlyph Style
s = Element (Rect Double) -> Rect Double -> Rect Double
forall s. (Additive (Element s), Space s) => Element s -> s -> s
move Element (Rect Double)
Point 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 Optic' A_Lens NoIx Style GlyphShape -> Style -> GlyphShape
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style GlyphShape
#glyphShape Style
s of
      GlyphShape
CircleGlyph -> (Double
sz *) (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) -> 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 (Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#borderSize Style
s) 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 (Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#borderSize Style
s)) Rect Double
forall a. Multiplicative a => a
one
      TriangleGlyph Point Double
a Point Double
b Point Double
c -> (Double
sz *) (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 ByteString
path' -> 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 a b. (a -> b) -> Rect a -> Rect b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
sz *)) ([PathData Double] -> Maybe (Rect Double)
pathBoxes ([PathData Double] -> Maybe (Rect Double))
-> (ByteString -> [PathData Double])
-> ByteString
-> Maybe (Rect Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [PathData Double]
svgToPathData (ByteString -> Maybe (Rect Double))
-> ByteString -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ ByteString
path')
  where
    sz :: Double
sz = Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#size Style
s
    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
* Optic' A_Lens NoIx Style Double -> Style -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style Double
#borderSize Style
s)
    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) (Optic
  A_Lens
  NoIx
  Style
  Style
  (Maybe (Point Double))
  (Maybe (Point Double))
-> Style -> Maybe (Point Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic
  A_Lens
  NoIx
  Style
  Style
  (Maybe (Point Double))
  (Maybe (Point Double))
#translate Style
s)
    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 Style (Maybe Double) -> Style -> Maybe Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx Style (Maybe Double)
#rotation Style
s)

-- | Infinite list of glyph shapes
--
-- >>> gpalette 0
-- CircleGlyph
gpalette :: Int -> GlyphShape
gpalette :: Int -> GlyphShape
gpalette Int
x = [GlyphShape] -> [GlyphShape]
forall a. HasCallStack => [a] -> [a]
cycle [GlyphShape]
gpalette1_ [GlyphShape] -> Int -> GlyphShape
forall a. HasCallStack => [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),
    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
(LineCap -> LineCap -> Bool)
-> (LineCap -> LineCap -> Bool) -> Eq LineCap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LineCap -> LineCap -> Bool
== :: LineCap -> LineCap -> Bool
$c/= :: LineCap -> LineCap -> Bool
/= :: 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
$cshowsPrec :: Int -> LineCap -> ShowS
showsPrec :: Int -> LineCap -> ShowS
$cshow :: LineCap -> String
show :: LineCap -> String
$cshowList :: [LineCap] -> ShowS
showList :: [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
$cfrom :: forall x. LineCap -> Rep LineCap x
from :: forall x. LineCap -> Rep LineCap x
$cto :: forall x. Rep LineCap x -> LineCap
to :: forall x. Rep LineCap x -> LineCap
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
(LineJoin -> LineJoin -> Bool)
-> (LineJoin -> LineJoin -> Bool) -> Eq LineJoin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LineJoin -> LineJoin -> Bool
== :: LineJoin -> LineJoin -> Bool
$c/= :: LineJoin -> LineJoin -> Bool
/= :: 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
$cshowsPrec :: Int -> LineJoin -> ShowS
showsPrec :: Int -> LineJoin -> ShowS
$cshow :: LineJoin -> String
show :: LineJoin -> String
$cshowList :: [LineJoin] -> ShowS
showList :: [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
$cfrom :: forall x. LineJoin -> Rep LineJoin x
from :: forall x. LineJoin -> Rep LineJoin x
$cto :: forall x. Rep LineJoin x -> LineJoin
to :: forall x. Rep LineJoin x -> LineJoin
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

-- | Text Anchor
data TextAnchor = AnchorMiddle | AnchorStart | AnchorEnd deriving (TextAnchor -> TextAnchor -> Bool
(TextAnchor -> TextAnchor -> Bool)
-> (TextAnchor -> TextAnchor -> Bool) -> Eq TextAnchor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextAnchor -> TextAnchor -> Bool
== :: TextAnchor -> TextAnchor -> Bool
$c/= :: TextAnchor -> TextAnchor -> Bool
/= :: TextAnchor -> TextAnchor -> Bool
Eq, Int -> TextAnchor -> ShowS
[TextAnchor] -> ShowS
TextAnchor -> String
(Int -> TextAnchor -> ShowS)
-> (TextAnchor -> String)
-> ([TextAnchor] -> ShowS)
-> Show TextAnchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextAnchor -> ShowS
showsPrec :: Int -> TextAnchor -> ShowS
$cshow :: TextAnchor -> String
show :: TextAnchor -> String
$cshowList :: [TextAnchor] -> ShowS
showList :: [TextAnchor] -> ShowS
Show, (forall x. TextAnchor -> Rep TextAnchor x)
-> (forall x. Rep TextAnchor x -> TextAnchor) -> Generic TextAnchor
forall x. Rep TextAnchor x -> TextAnchor
forall x. TextAnchor -> Rep TextAnchor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TextAnchor -> Rep TextAnchor x
from :: forall x. TextAnchor -> Rep TextAnchor x
$cto :: forall x. Rep TextAnchor x -> TextAnchor
to :: forall x. Rep TextAnchor x -> TextAnchor
Generic)

-- | Convert a 'TextAnchor' to a 'ByteString' label.
fromTextAnchor :: TextAnchor -> ByteString
fromTextAnchor :: TextAnchor -> ByteString
fromTextAnchor TextAnchor
AnchorMiddle = ByteString
"middle"
fromTextAnchor TextAnchor
AnchorStart = ByteString
"start"
fromTextAnchor TextAnchor
AnchorEnd = ByteString
"end"

-- | Convert a Double to a TextAnchor
fromAnchoring :: Double -> TextAnchor
fromAnchoring :: Double -> TextAnchor
fromAnchoring Double
x = case Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
x Double
forall a. Additive a => a
zero of
  Ordering
EQ -> TextAnchor
AnchorMiddle
  Ordering
GT -> TextAnchor
AnchorEnd
  Ordering
LT -> TextAnchor
AnchorStart

-- | Aligning stacked things.
data Align = NoAlign | AlignRight | AlignLeft | AlignMid deriving (Align -> Align -> Bool
(Align -> Align -> Bool) -> (Align -> Align -> Bool) -> Eq Align
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Align -> Align -> Bool
== :: Align -> Align -> Bool
$c/= :: Align -> Align -> Bool
/= :: Align -> Align -> Bool
Eq, Int -> Align -> ShowS
[Align] -> ShowS
Align -> String
(Int -> Align -> ShowS)
-> (Align -> String) -> ([Align] -> ShowS) -> Show Align
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Align -> ShowS
showsPrec :: Int -> Align -> ShowS
$cshow :: Align -> String
show :: Align -> String
$cshowList :: [Align] -> ShowS
showList :: [Align] -> ShowS
Show, (forall x. Align -> Rep Align x)
-> (forall x. Rep Align x -> Align) -> Generic Align
forall x. Rep Align x -> Align
forall x. Align -> Rep Align x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Align -> Rep Align x
from :: forall x. Align -> Rep Align x
$cto :: forall x. Rep Align x -> Align
to :: forall x. Rep Align x -> Align
Generic)

-- | 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. ScaleP -> Rep ScaleP x)
-> (forall x. Rep ScaleP x -> ScaleP) -> Generic ScaleP
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
$cfrom :: forall x. ScaleP -> Rep ScaleP x
from :: forall x. ScaleP -> Rep ScaleP x
$cto :: forall x. Rep ScaleP x -> ScaleP
to :: forall x. Rep ScaleP x -> ScaleP
Generic, ScaleP -> ScaleP -> Bool
(ScaleP -> ScaleP -> Bool)
-> (ScaleP -> ScaleP -> Bool) -> Eq ScaleP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScaleP -> ScaleP -> Bool
== :: ScaleP -> ScaleP -> Bool
$c/= :: ScaleP -> ScaleP -> Bool
/= :: ScaleP -> ScaleP -> Bool
Eq, Int -> ScaleP -> ShowS
[ScaleP] -> ShowS
ScaleP -> String
(Int -> ScaleP -> ShowS)
-> (ScaleP -> String) -> ([ScaleP] -> ShowS) -> Show ScaleP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScaleP -> ShowS
showsPrec :: Int -> ScaleP -> ShowS
$cshow :: ScaleP -> String
show :: ScaleP -> String
$cshowList :: [ScaleP] -> ShowS
showList :: [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 = Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool Double
1 (Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
nx Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ox) (Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ox Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
nx Double -> Double -> Bool
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 = Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool Double
1 (Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ny Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
oy) (Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
oy Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ny Double -> Double -> Bool
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 = Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool Double
1 (Double -> Double
forall a. Floating a => a -> a
sqrt (Double
an Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
ao)) (Double
an Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
ao Double -> Double -> Bool
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 = Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
nx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ny
    ao :: Double
ao = Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
width Range Double
ox Double -> Double -> Double
forall a. Num a => a -> a -> a
* Range Double -> Element (Range Double)
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' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 Bool -> Bool -> Bool
&& Double
y' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool Double
x' Double
y' (Double
x' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
y')
      | Double
x' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 Bool -> Bool -> Bool
&& Double
y' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 = Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool Double
x' Double
y' (Double
x' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
y'))
      | Double
x' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 Bool -> Bool -> Bool
&& Double
y' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool Double
x' Double
y' ((Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
x') Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
y')
      | Bool
otherwise = Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool Double
x' Double
y' ((Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
x') Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
y'))