{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}

-- | Surface chart combinators.
--
-- A common chart is to present a set of rectangles on the XY plane with colour representing values of the underlying data; a surface chart (often called a heatmap).
--
-- 'SurfaceData', the rectangle and the color value, is a different shape to the usual data elements of a chart, so there is a bit more wrangling to do compared with other chart types.
module Chart.Surface
  ( SurfaceData (..),
    SurfaceOptions (..),
    defaultSurfaceOptions,
    SurfaceStyle (..),
    defaultSurfaceStyle,
    mkSurfaceData,
    surfaces,
    surfacef,
    surfacefl,
    SurfaceLegendOptions (..),
    defaultSurfaceLegendOptions,
  )
where

import Chart.Types
import Control.Lens
import Data.Colour
import Data.FormatN
import Data.Generics.Labels ()
import NumHask.Prelude
import NumHask.Space

-- | Options for a Surface chart.
data SurfaceOptions = SurfaceOptions
  { -- | surface style
    SurfaceOptions -> SurfaceStyle
soStyle :: SurfaceStyle,
    -- | The grain or granularity of the chart
    SurfaceOptions -> Point Int
soGrain :: Point Int,
    -- | Chart range
    SurfaceOptions -> Rect Double
soRange :: Rect Double
  }
  deriving (Int -> SurfaceOptions -> ShowS
[SurfaceOptions] -> ShowS
SurfaceOptions -> String
(Int -> SurfaceOptions -> ShowS)
-> (SurfaceOptions -> String)
-> ([SurfaceOptions] -> ShowS)
-> Show SurfaceOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SurfaceOptions] -> ShowS
$cshowList :: [SurfaceOptions] -> ShowS
show :: SurfaceOptions -> String
$cshow :: SurfaceOptions -> String
showsPrec :: Int -> SurfaceOptions -> ShowS
$cshowsPrec :: Int -> SurfaceOptions -> ShowS
Show, SurfaceOptions -> SurfaceOptions -> Bool
(SurfaceOptions -> SurfaceOptions -> Bool)
-> (SurfaceOptions -> SurfaceOptions -> Bool) -> Eq SurfaceOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SurfaceOptions -> SurfaceOptions -> Bool
$c/= :: SurfaceOptions -> SurfaceOptions -> Bool
== :: SurfaceOptions -> SurfaceOptions -> Bool
$c== :: SurfaceOptions -> SurfaceOptions -> Bool
Eq, (forall x. SurfaceOptions -> Rep SurfaceOptions x)
-> (forall x. Rep SurfaceOptions x -> SurfaceOptions)
-> Generic SurfaceOptions
forall x. Rep SurfaceOptions x -> SurfaceOptions
forall x. SurfaceOptions -> Rep SurfaceOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SurfaceOptions x -> SurfaceOptions
$cfrom :: forall x. SurfaceOptions -> Rep SurfaceOptions x
Generic)

-- | official style
defaultSurfaceOptions :: SurfaceOptions
defaultSurfaceOptions :: SurfaceOptions
defaultSurfaceOptions =
  SurfaceStyle -> Point Int -> Rect Double -> SurfaceOptions
SurfaceOptions SurfaceStyle
defaultSurfaceStyle (Int -> Int -> Point Int
forall a. a -> a -> Point a
Point Int
10 Int
10) Rect Double
forall a. Multiplicative a => a
one

-- | A surface chart is a specialization of a 'RectA' chart
--
-- >>> defaultSurfaceStyle
-- SurfaceStyle {surfaceColors = [Colour 0.69 0.35 0.16 1.00,Colour 0.65 0.81 0.89 1.00], surfaceRectStyle = RectStyle {borderSize = 0.0, borderColor = Colour 0.00 0.00 0.00 0.00, color = Colour 0.05 0.05 0.05 1.00}}
--
-- ![surface example](other/surface.svg)
data SurfaceStyle = SurfaceStyle
  { -- | list of colours to interpolate between.
    SurfaceStyle -> [Colour]
surfaceColors :: [Colour],
    SurfaceStyle -> RectStyle
surfaceRectStyle :: RectStyle
  }
  deriving (Int -> SurfaceStyle -> ShowS
[SurfaceStyle] -> ShowS
SurfaceStyle -> String
(Int -> SurfaceStyle -> ShowS)
-> (SurfaceStyle -> String)
-> ([SurfaceStyle] -> ShowS)
-> Show SurfaceStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SurfaceStyle] -> ShowS
$cshowList :: [SurfaceStyle] -> ShowS
show :: SurfaceStyle -> String
$cshow :: SurfaceStyle -> String
showsPrec :: Int -> SurfaceStyle -> ShowS
$cshowsPrec :: Int -> SurfaceStyle -> ShowS
Show, SurfaceStyle -> SurfaceStyle -> Bool
(SurfaceStyle -> SurfaceStyle -> Bool)
-> (SurfaceStyle -> SurfaceStyle -> Bool) -> Eq SurfaceStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SurfaceStyle -> SurfaceStyle -> Bool
$c/= :: SurfaceStyle -> SurfaceStyle -> Bool
== :: SurfaceStyle -> SurfaceStyle -> Bool
$c== :: SurfaceStyle -> SurfaceStyle -> Bool
Eq, (forall x. SurfaceStyle -> Rep SurfaceStyle x)
-> (forall x. Rep SurfaceStyle x -> SurfaceStyle)
-> Generic SurfaceStyle
forall x. Rep SurfaceStyle x -> SurfaceStyle
forall x. SurfaceStyle -> Rep SurfaceStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SurfaceStyle x -> SurfaceStyle
$cfrom :: forall x. SurfaceStyle -> Rep SurfaceStyle x
Generic)

-- | The official surface style.
defaultSurfaceStyle :: SurfaceStyle
defaultSurfaceStyle :: SurfaceStyle
defaultSurfaceStyle =
  [Colour] -> RectStyle -> SurfaceStyle
SurfaceStyle (Int -> [Colour] -> [Colour]
forall a. Int -> [a] -> [a]
take Int
2 [Colour]
palette1_) (Colour -> RectStyle
blob Colour
dark)

-- | Main surface data elements
data SurfaceData = SurfaceData
  { -- | XY Coordinates of surface.
    SurfaceData -> Rect Double
surfaceRect :: Rect Double,
    -- | Surface colour.
    SurfaceData -> Colour
surfaceColor :: Colour
  }
  deriving (Int -> SurfaceData -> ShowS
[SurfaceData] -> ShowS
SurfaceData -> String
(Int -> SurfaceData -> ShowS)
-> (SurfaceData -> String)
-> ([SurfaceData] -> ShowS)
-> Show SurfaceData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SurfaceData] -> ShowS
$cshowList :: [SurfaceData] -> ShowS
show :: SurfaceData -> String
$cshow :: SurfaceData -> String
showsPrec :: Int -> SurfaceData -> ShowS
$cshowsPrec :: Int -> SurfaceData -> ShowS
Show, SurfaceData -> SurfaceData -> Bool
(SurfaceData -> SurfaceData -> Bool)
-> (SurfaceData -> SurfaceData -> Bool) -> Eq SurfaceData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SurfaceData -> SurfaceData -> Bool
$c/= :: SurfaceData -> SurfaceData -> Bool
== :: SurfaceData -> SurfaceData -> Bool
$c== :: SurfaceData -> SurfaceData -> Bool
Eq, (forall x. SurfaceData -> Rep SurfaceData x)
-> (forall x. Rep SurfaceData x -> SurfaceData)
-> Generic SurfaceData
forall x. Rep SurfaceData x -> SurfaceData
forall x. SurfaceData -> Rep SurfaceData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SurfaceData x -> SurfaceData
$cfrom :: forall x. SurfaceData -> Rep SurfaceData x
Generic)

-- | surface chart without any hud trimmings
surfaces :: RectStyle -> [SurfaceData] -> [Chart Double]
surfaces :: RectStyle -> [SurfaceData] -> [Chart Double]
surfaces RectStyle
rs [SurfaceData]
ps =
  ( \(SurfaceData Rect Double
r Colour
c) ->
      Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart
        (RectStyle -> Annotation
RectA (RectStyle
rs RectStyle -> (RectStyle -> RectStyle) -> RectStyle
forall a b. a -> (a -> b) -> b
& IsLabel "color" (ASetter RectStyle RectStyle Colour Colour)
ASetter RectStyle RectStyle Colour Colour
#color ASetter RectStyle RectStyle Colour Colour
-> Colour -> RectStyle -> RectStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Colour
c))
        [Rect Double -> XY Double
forall a. Rect a -> XY a
RectXY Rect Double
r]
  )
    (SurfaceData -> Chart Double) -> [SurfaceData] -> [Chart Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SurfaceData]
ps

-- | create surface data from a function on a Point
mkSurfaceData ::
  (Point Double -> Double) ->
  Rect Double ->
  Grid (Rect Double) ->
  [Colour] ->
  ([SurfaceData], Range Double)
mkSurfaceData :: (Point Double -> Double)
-> Rect Double
-> Grid (Rect Double)
-> [Colour]
-> ([SurfaceData], Range Double)
mkSurfaceData Point Double -> Double
f Rect Double
r Grid (Rect Double)
g [Colour]
cs = ((\(Rect Double
x, Double
y) -> Rect Double -> Colour -> SurfaceData
SurfaceData Rect Double
x (Double -> [Colour] -> Colour
blends Double
y [Colour]
cs)) ((Rect Double, Double) -> SurfaceData)
-> [(Rect Double, Double)] -> [SurfaceData]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Rect Double, Double)]
ps', [Element (Range Double)] -> Range Double
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
space1 [Double]
[Element (Range Double)]
rs)
  where
    ps :: [(Rect Double, Double)]
ps = (Point Double -> Double)
-> Rect Double -> Grid (Rect Double) -> [(Rect Double, Double)]
forall b.
(Point Double -> b)
-> Rect Double -> Grid (Rect Double) -> [(Rect Double, b)]
gridF Point Double -> Double
f Rect Double
r Grid (Rect Double)
g
    rs :: [Double]
rs = (Rect Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Rect Double, Double) -> Double)
-> [(Rect Double, Double)] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Rect Double, Double)]
ps
    rs' :: [Double]
rs' = Range Double
-> Range Double -> Element (Range Double) -> Element (Range Double)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project ([Element (Range Double)] -> Range Double
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
space1 [Double]
[Element (Range Double)]
rs :: Range Double) (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
0 Double
1) (Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
rs
    ps' :: [(Rect Double, Double)]
ps' = [Rect Double] -> [Double] -> [(Rect Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Rect Double, Double) -> Rect Double
forall a b. (a, b) -> a
fst ((Rect Double, Double) -> Rect Double)
-> [(Rect Double, Double)] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Rect Double, Double)]
ps) [Double]
rs'

-- | create a surface chart from a function.
surfacef :: (Point Double -> Double) -> SurfaceOptions -> ([Chart Double], Range Double)
surfacef :: (Point Double -> Double)
-> SurfaceOptions -> ([Chart Double], Range Double)
surfacef Point Double -> Double
f SurfaceOptions
cfg =
  ([SurfaceData] -> [Chart Double])
-> ([SurfaceData], Range Double) -> ([Chart Double], Range Double)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (RectStyle -> [SurfaceData] -> [Chart Double]
surfaces (SurfaceOptions
cfg SurfaceOptions
-> Getting RectStyle SurfaceOptions RectStyle -> RectStyle
forall s a. s -> Getting a s a -> a
^. IsLabel
  "soStyle"
  ((SurfaceStyle -> Const RectStyle SurfaceStyle)
   -> SurfaceOptions -> Const RectStyle SurfaceOptions)
(SurfaceStyle -> Const RectStyle SurfaceStyle)
-> SurfaceOptions -> Const RectStyle SurfaceOptions
#soStyle ((SurfaceStyle -> Const RectStyle SurfaceStyle)
 -> SurfaceOptions -> Const RectStyle SurfaceOptions)
-> ((RectStyle -> Const RectStyle RectStyle)
    -> SurfaceStyle -> Const RectStyle SurfaceStyle)
-> Getting RectStyle SurfaceOptions RectStyle
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "surfaceRectStyle"
  ((RectStyle -> Const RectStyle RectStyle)
   -> SurfaceStyle -> Const RectStyle SurfaceStyle)
(RectStyle -> Const RectStyle RectStyle)
-> SurfaceStyle -> Const RectStyle SurfaceStyle
#surfaceRectStyle)) (([SurfaceData], Range Double) -> ([Chart Double], Range Double))
-> ([SurfaceData], Range Double) -> ([Chart Double], Range Double)
forall a b. (a -> b) -> a -> b
$
    (Point Double -> Double)
-> Rect Double
-> Grid (Rect Double)
-> [Colour]
-> ([SurfaceData], Range Double)
mkSurfaceData
      Point Double -> Double
f
      (SurfaceOptions
cfg SurfaceOptions
-> Getting (Rect Double) SurfaceOptions (Rect Double)
-> Rect Double
forall s a. s -> Getting a s a -> a
^. IsLabel
  "soRange" (Getting (Rect Double) SurfaceOptions (Rect Double))
Getting (Rect Double) SurfaceOptions (Rect Double)
#soRange)
      (SurfaceOptions
cfg SurfaceOptions
-> Getting (Point Int) SurfaceOptions (Point Int) -> Point Int
forall s a. s -> Getting a s a -> a
^. IsLabel "soGrain" (Getting (Point Int) SurfaceOptions (Point Int))
Getting (Point Int) SurfaceOptions (Point Int)
#soGrain)
      (SurfaceOptions
cfg SurfaceOptions
-> Getting [Colour] SurfaceOptions [Colour] -> [Colour]
forall s a. s -> Getting a s a -> a
^. IsLabel
  "soStyle"
  ((SurfaceStyle -> Const [Colour] SurfaceStyle)
   -> SurfaceOptions -> Const [Colour] SurfaceOptions)
(SurfaceStyle -> Const [Colour] SurfaceStyle)
-> SurfaceOptions -> Const [Colour] SurfaceOptions
#soStyle ((SurfaceStyle -> Const [Colour] SurfaceStyle)
 -> SurfaceOptions -> Const [Colour] SurfaceOptions)
-> (([Colour] -> Const [Colour] [Colour])
    -> SurfaceStyle -> Const [Colour] SurfaceStyle)
-> Getting [Colour] SurfaceOptions [Colour]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "surfaceColors"
  (([Colour] -> Const [Colour] [Colour])
   -> SurfaceStyle -> Const [Colour] SurfaceStyle)
([Colour] -> Const [Colour] [Colour])
-> SurfaceStyle -> Const [Colour] SurfaceStyle
#surfaceColors)

-- | Create a surface chart and accompanying legend from a function.
surfacefl :: (Point Double -> Double) -> SurfaceOptions -> SurfaceLegendOptions -> ([Chart Double], [Hud Double])
surfacefl :: (Point Double -> Double)
-> SurfaceOptions
-> SurfaceLegendOptions
-> ([Chart Double], [Hud Double])
surfacefl Point Double -> Double
f SurfaceOptions
po SurfaceLegendOptions
slo = ([Chart Double]
cs, [LegendOptions -> [Chart Double] -> Hud Double
legendHud (SurfaceLegendOptions
slo SurfaceLegendOptions
-> Getting LegendOptions SurfaceLegendOptions LegendOptions
-> LegendOptions
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloLegendOptions"
  (Getting LegendOptions SurfaceLegendOptions LegendOptions)
Getting LegendOptions SurfaceLegendOptions LegendOptions
#sloLegendOptions) (Range Double -> SurfaceLegendOptions -> [Chart Double]
surfaceLegendChart Range Double
dr SurfaceLegendOptions
slo)])
  where
    ([Chart Double]
cs, Range Double
dr) = (Point Double -> Double)
-> SurfaceOptions -> ([Chart Double], Range Double)
surfacef Point Double -> Double
f SurfaceOptions
po

-- | Legend specialization for a surface chart.
data SurfaceLegendOptions = SurfaceLegendOptions
  { SurfaceLegendOptions -> SurfaceStyle
sloStyle :: SurfaceStyle,
    SurfaceLegendOptions -> Text
sloTitle :: Text,
    -- | Width of the legend glyph
    SurfaceLegendOptions -> Double
sloWidth :: Double,
    -- | Resolution of the legend glyph
    SurfaceLegendOptions -> Int
sloResolution :: Int,
    SurfaceLegendOptions -> AxisOptions
sloAxisOptions :: AxisOptions,
    SurfaceLegendOptions -> LegendOptions
sloLegendOptions :: LegendOptions
  }
  deriving (SurfaceLegendOptions -> SurfaceLegendOptions -> Bool
(SurfaceLegendOptions -> SurfaceLegendOptions -> Bool)
-> (SurfaceLegendOptions -> SurfaceLegendOptions -> Bool)
-> Eq SurfaceLegendOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SurfaceLegendOptions -> SurfaceLegendOptions -> Bool
$c/= :: SurfaceLegendOptions -> SurfaceLegendOptions -> Bool
== :: SurfaceLegendOptions -> SurfaceLegendOptions -> Bool
$c== :: SurfaceLegendOptions -> SurfaceLegendOptions -> Bool
Eq, Int -> SurfaceLegendOptions -> ShowS
[SurfaceLegendOptions] -> ShowS
SurfaceLegendOptions -> String
(Int -> SurfaceLegendOptions -> ShowS)
-> (SurfaceLegendOptions -> String)
-> ([SurfaceLegendOptions] -> ShowS)
-> Show SurfaceLegendOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SurfaceLegendOptions] -> ShowS
$cshowList :: [SurfaceLegendOptions] -> ShowS
show :: SurfaceLegendOptions -> String
$cshow :: SurfaceLegendOptions -> String
showsPrec :: Int -> SurfaceLegendOptions -> ShowS
$cshowsPrec :: Int -> SurfaceLegendOptions -> ShowS
Show, (forall x. SurfaceLegendOptions -> Rep SurfaceLegendOptions x)
-> (forall x. Rep SurfaceLegendOptions x -> SurfaceLegendOptions)
-> Generic SurfaceLegendOptions
forall x. Rep SurfaceLegendOptions x -> SurfaceLegendOptions
forall x. SurfaceLegendOptions -> Rep SurfaceLegendOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SurfaceLegendOptions x -> SurfaceLegendOptions
$cfrom :: forall x. SurfaceLegendOptions -> Rep SurfaceLegendOptions x
Generic)

surfaceAxisOptions :: AxisOptions
surfaceAxisOptions :: AxisOptions
surfaceAxisOptions =
  Maybe AxisBar -> Maybe Adjustments -> Tick -> Place -> AxisOptions
AxisOptions
    Maybe AxisBar
forall a. Maybe a
Nothing
    Maybe Adjustments
forall a. Maybe a
Nothing
    ( TickStyle
-> Maybe (GlyphStyle, Double)
-> Maybe (TextStyle, Double)
-> Maybe (LineStyle, Double)
-> Tick
Tick
        (FormatN -> Int -> TickExtend -> TickStyle
TickRound (Maybe Int -> FormatN
FormatPrec (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3)) Int
4 TickExtend
NoTickExtend)
        ((GlyphStyle, Double) -> Maybe (GlyphStyle, Double)
forall a. a -> Maybe a
Just (GlyphStyle
defaultGlyphTick GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel "color" (ASetter GlyphStyle GlyphStyle Colour Colour)
ASetter GlyphStyle GlyphStyle Colour Colour
#color ASetter GlyphStyle GlyphStyle Colour Colour
-> Colour -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Colour
dark GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "shape" (ASetter GlyphStyle GlyphStyle GlyphShape GlyphShape)
ASetter GlyphStyle GlyphStyle GlyphShape GlyphShape
#shape ASetter GlyphStyle GlyphStyle GlyphShape GlyphShape
-> GlyphShape -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> GlyphShape
VLineGlyph Double
0.005, Double
0.01))
        ((TextStyle, Double) -> Maybe (TextStyle, Double)
forall a. a -> Maybe a
Just (TextStyle
defaultTextTick, Double
0.03))
        Maybe (LineStyle, Double)
forall a. Maybe a
Nothing
    )
    Place
PlaceRight

-- | official surface legend options
defaultSurfaceLegendOptions :: Text -> SurfaceLegendOptions
defaultSurfaceLegendOptions :: Text -> SurfaceLegendOptions
defaultSurfaceLegendOptions Text
t =
  SurfaceStyle
-> Text
-> Double
-> Int
-> AxisOptions
-> LegendOptions
-> SurfaceLegendOptions
SurfaceLegendOptions SurfaceStyle
defaultSurfaceStyle Text
t Double
0.05 Int
100 AxisOptions
surfaceAxisOptions LegendOptions
surfaceLegendOptions

surfaceLegendOptions :: LegendOptions
surfaceLegendOptions :: LegendOptions
surfaceLegendOptions =
  LegendOptions
defaultLegendOptions
    LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel "lplace" (ASetter LegendOptions LegendOptions Place Place)
ASetter LegendOptions LegendOptions Place Place
#lplace ASetter LegendOptions LegendOptions Place Place
-> Place -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceRight
    LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "lscale" (ASetter LegendOptions LegendOptions Double Double)
ASetter LegendOptions LegendOptions Double Double
#lscale ASetter LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.7
    LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel "lsize" (ASetter LegendOptions LegendOptions Double Double)
ASetter LegendOptions LegendOptions Double Double
#lsize ASetter LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.5
    LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel "vgap" (ASetter LegendOptions LegendOptions Double Double)
ASetter LegendOptions LegendOptions Double Double
#vgap ASetter LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.05
    LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel "hgap" (ASetter LegendOptions LegendOptions Double Double)
ASetter LegendOptions LegendOptions Double Double
#hgap ASetter LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.01
    LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "innerPad" (ASetter LegendOptions LegendOptions Double Double)
ASetter LegendOptions LegendOptions Double Double
#innerPad ASetter LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.05
    LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "outerPad" (ASetter LegendOptions LegendOptions Double Double)
ASetter LegendOptions LegendOptions Double Double
#outerPad ASetter LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.02
    LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "ltext"
  ((TextStyle -> Identity TextStyle)
   -> LegendOptions -> Identity LegendOptions)
(TextStyle -> Identity TextStyle)
-> LegendOptions -> Identity LegendOptions
#ltext ((TextStyle -> Identity TextStyle)
 -> LegendOptions -> Identity LegendOptions)
-> ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> ASetter LegendOptions LegendOptions Double Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "hsize"
  ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
(Double -> Identity Double) -> TextStyle -> Identity TextStyle
#hsize ASetter LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.5
    LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "legendFrame"
  (ASetter
     LegendOptions LegendOptions (Maybe RectStyle) (Maybe RectStyle))
ASetter
  LegendOptions LegendOptions (Maybe RectStyle) (Maybe RectStyle)
#legendFrame ASetter
  LegendOptions LegendOptions (Maybe RectStyle) (Maybe RectStyle)
-> Maybe RectStyle -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe RectStyle
forall a. Maybe a
Nothing

-- | Creation of the classical heatmap glyph within a legend context.
surfaceLegendChart :: Range Double -> SurfaceLegendOptions -> [Chart Double]
surfaceLegendChart :: Range Double -> SurfaceLegendOptions -> [Chart Double]
surfaceLegendChart Range Double
dataRange SurfaceLegendOptions
l =
  Double -> [Chart Double] -> [Chart Double]
padChart (SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting Double SurfaceLegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloLegendOptions"
  ((LegendOptions -> Const Double LegendOptions)
   -> SurfaceLegendOptions -> Const Double SurfaceLegendOptions)
(LegendOptions -> Const Double LegendOptions)
-> SurfaceLegendOptions -> Const Double SurfaceLegendOptions
#sloLegendOptions ((LegendOptions -> Const Double LegendOptions)
 -> SurfaceLegendOptions -> Const Double SurfaceLegendOptions)
-> ((Double -> Const Double Double)
    -> LegendOptions -> Const Double LegendOptions)
-> Getting Double SurfaceLegendOptions Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "outerPad"
  ((Double -> Const Double Double)
   -> LegendOptions -> Const Double LegendOptions)
(Double -> Const Double Double)
-> LegendOptions -> Const Double LegendOptions
#outerPad)
    ([Chart Double] -> [Chart Double])
-> ([Chart Double] -> [Chart Double])
-> [Chart Double]
-> [Chart Double]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([Chart Double] -> [Chart Double])
-> (RectStyle -> [Chart Double] -> [Chart Double])
-> Maybe RectStyle
-> [Chart Double]
-> [Chart Double]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Chart Double] -> [Chart Double]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\RectStyle
x -> RectStyle -> Double -> [Chart Double] -> [Chart Double]
frameChart RectStyle
x (SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting Double SurfaceLegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloLegendOptions"
  ((LegendOptions -> Const Double LegendOptions)
   -> SurfaceLegendOptions -> Const Double SurfaceLegendOptions)
(LegendOptions -> Const Double LegendOptions)
-> SurfaceLegendOptions -> Const Double SurfaceLegendOptions
#sloLegendOptions ((LegendOptions -> Const Double LegendOptions)
 -> SurfaceLegendOptions -> Const Double SurfaceLegendOptions)
-> ((Double -> Const Double Double)
    -> LegendOptions -> Const Double LegendOptions)
-> Getting Double SurfaceLegendOptions Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "innerPad"
  ((Double -> Const Double Double)
   -> LegendOptions -> Const Double LegendOptions)
(Double -> Const Double Double)
-> LegendOptions -> Const Double LegendOptions
#innerPad)) (SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting (Maybe RectStyle) SurfaceLegendOptions (Maybe RectStyle)
-> Maybe RectStyle
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloLegendOptions"
  ((LegendOptions -> Const (Maybe RectStyle) LegendOptions)
   -> SurfaceLegendOptions
   -> Const (Maybe RectStyle) SurfaceLegendOptions)
(LegendOptions -> Const (Maybe RectStyle) LegendOptions)
-> SurfaceLegendOptions
-> Const (Maybe RectStyle) SurfaceLegendOptions
#sloLegendOptions ((LegendOptions -> Const (Maybe RectStyle) LegendOptions)
 -> SurfaceLegendOptions
 -> Const (Maybe RectStyle) SurfaceLegendOptions)
-> ((Maybe RectStyle -> Const (Maybe RectStyle) (Maybe RectStyle))
    -> LegendOptions -> Const (Maybe RectStyle) LegendOptions)
-> Getting (Maybe RectStyle) SurfaceLegendOptions (Maybe RectStyle)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "legendFrame"
  ((Maybe RectStyle -> Const (Maybe RectStyle) (Maybe RectStyle))
   -> LegendOptions -> Const (Maybe RectStyle) LegendOptions)
(Maybe RectStyle -> Const (Maybe RectStyle) (Maybe RectStyle))
-> LegendOptions -> Const (Maybe RectStyle) LegendOptions
#legendFrame)
    ([Chart Double] -> [Chart Double])
-> [Chart Double] -> [Chart Double]
forall a b. (a -> b) -> a -> b
$ [Chart Double]
hs
  where
    a :: [Chart Double]
a = SurfaceLegendOptions -> [Chart Double] -> [Chart Double]
makeSurfaceTick SurfaceLegendOptions
l [Chart Double]
pchart
    pchart :: [Chart Double]
pchart
      | SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting Place SurfaceLegendOptions Place -> Place
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloLegendOptions"
  ((LegendOptions -> Const Place LegendOptions)
   -> SurfaceLegendOptions -> Const Place SurfaceLegendOptions)
(LegendOptions -> Const Place LegendOptions)
-> SurfaceLegendOptions -> Const Place SurfaceLegendOptions
#sloLegendOptions ((LegendOptions -> Const Place LegendOptions)
 -> SurfaceLegendOptions -> Const Place SurfaceLegendOptions)
-> ((Place -> Const Place Place)
    -> LegendOptions -> Const Place LegendOptions)
-> Getting Place SurfaceLegendOptions Place
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "lplace"
  ((Place -> Const Place Place)
   -> LegendOptions -> Const Place LegendOptions)
(Place -> Const Place Place)
-> LegendOptions -> Const Place LegendOptions
#lplace Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom
          Bool -> Bool -> Bool
|| SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting Place SurfaceLegendOptions Place -> Place
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloLegendOptions"
  ((LegendOptions -> Const Place LegendOptions)
   -> SurfaceLegendOptions -> Const Place SurfaceLegendOptions)
(LegendOptions -> Const Place LegendOptions)
-> SurfaceLegendOptions -> Const Place SurfaceLegendOptions
#sloLegendOptions ((LegendOptions -> Const Place LegendOptions)
 -> SurfaceLegendOptions -> Const Place SurfaceLegendOptions)
-> ((Place -> Const Place Place)
    -> LegendOptions -> Const Place LegendOptions)
-> Getting Place SurfaceLegendOptions Place
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "lplace"
  ((Place -> Const Place Place)
   -> LegendOptions -> Const Place LegendOptions)
(Place -> Const Place Place)
-> LegendOptions -> Const Place LegendOptions
#lplace Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceTop =
        [Chart Double]
vertGlyph
      | Bool
otherwise = [Chart Double]
horiGlyph
    t :: Chart Double
t = Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (TextStyle -> [Text] -> Annotation
TextA (SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting TextStyle SurfaceLegendOptions TextStyle -> TextStyle
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloLegendOptions"
  ((LegendOptions -> Const TextStyle LegendOptions)
   -> SurfaceLegendOptions -> Const TextStyle SurfaceLegendOptions)
(LegendOptions -> Const TextStyle LegendOptions)
-> SurfaceLegendOptions -> Const TextStyle SurfaceLegendOptions
#sloLegendOptions ((LegendOptions -> Const TextStyle LegendOptions)
 -> SurfaceLegendOptions -> Const TextStyle SurfaceLegendOptions)
-> ((TextStyle -> Const TextStyle TextStyle)
    -> LegendOptions -> Const TextStyle LegendOptions)
-> Getting TextStyle SurfaceLegendOptions TextStyle
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "ltext"
  ((TextStyle -> Const TextStyle TextStyle)
   -> LegendOptions -> Const TextStyle LegendOptions)
(TextStyle -> Const TextStyle TextStyle)
-> LegendOptions -> Const TextStyle LegendOptions
#ltext TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel "anchor" (ASetter TextStyle TextStyle Anchor Anchor)
ASetter TextStyle TextStyle Anchor Anchor
#anchor ASetter TextStyle TextStyle Anchor Anchor
-> Anchor -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Anchor
AnchorStart) [SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting Text SurfaceLegendOptions Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "sloTitle" (Getting Text SurfaceLegendOptions Text)
Getting Text SurfaceLegendOptions Text
#sloTitle]) [XY Double
forall a. Additive a => a
zero]
    hs :: [Chart Double]
hs = Double -> [[Chart Double]] -> [Chart Double]
vert (SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting Double SurfaceLegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloLegendOptions"
  ((LegendOptions -> Const Double LegendOptions)
   -> SurfaceLegendOptions -> Const Double SurfaceLegendOptions)
(LegendOptions -> Const Double LegendOptions)
-> SurfaceLegendOptions -> Const Double SurfaceLegendOptions
#sloLegendOptions ((LegendOptions -> Const Double LegendOptions)
 -> SurfaceLegendOptions -> Const Double SurfaceLegendOptions)
-> ((Double -> Const Double Double)
    -> LegendOptions -> Const Double LegendOptions)
-> Getting Double SurfaceLegendOptions Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "vgap"
  ((Double -> Const Double Double)
   -> LegendOptions -> Const Double LegendOptions)
(Double -> Const Double Double)
-> LegendOptions -> Const Double LegendOptions
#vgap) [[Chart Double]
a, [Chart Double
t]]
    vertGlyph :: [Chart Double]
    vertGlyph :: [Chart Double]
vertGlyph =
      (Rect Double -> Colour -> Chart Double)
-> [Rect Double] -> [Colour] -> [Chart Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (\Rect Double
r Colour
c -> Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (RectStyle -> Annotation
RectA (RectStyle -> Annotation) -> RectStyle -> Annotation
forall a b. (a -> b) -> a -> b
$ Colour -> RectStyle
blob Colour
c) [Rect Double -> XY Double
forall a. Rect a -> XY a
RectXY Rect Double
r])
        ( (\Range Double
xr -> Range Double -> Range Double -> Rect Double
forall a. Range a -> Range a -> Rect a
Ranges Range Double
xr (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
0 (SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting Double SurfaceLegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "sloWidth" (Getting Double SurfaceLegendOptions Double)
Getting Double SurfaceLegendOptions Double
#sloWidth)))
            (Range Double -> Rect Double) -> [Range Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Double -> Grid (Range Double) -> [Range Double]
forall s. FieldSpace s => s -> Grid s -> [s]
gridSpace
              Range Double
dataRange
              (SurfaceLegendOptions
l SurfaceLegendOptions -> Getting Int SurfaceLegendOptions Int -> Int
forall s a. s -> Getting a s a -> a
^. IsLabel "sloResolution" (Getting Int SurfaceLegendOptions Int)
Getting Int SurfaceLegendOptions Int
#sloResolution)
        )
        ( (\Double
x -> Double -> [Colour] -> Colour
blends Double
x (SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting [Colour] SurfaceLegendOptions [Colour] -> [Colour]
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloStyle"
  ((SurfaceStyle -> Const [Colour] SurfaceStyle)
   -> SurfaceLegendOptions -> Const [Colour] SurfaceLegendOptions)
(SurfaceStyle -> Const [Colour] SurfaceStyle)
-> SurfaceLegendOptions -> Const [Colour] SurfaceLegendOptions
#sloStyle ((SurfaceStyle -> Const [Colour] SurfaceStyle)
 -> SurfaceLegendOptions -> Const [Colour] SurfaceLegendOptions)
-> (([Colour] -> Const [Colour] [Colour])
    -> SurfaceStyle -> Const [Colour] SurfaceStyle)
-> Getting [Colour] SurfaceLegendOptions [Colour]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "surfaceColors"
  (([Colour] -> Const [Colour] [Colour])
   -> SurfaceStyle -> Const [Colour] SurfaceStyle)
([Colour] -> Const [Colour] [Colour])
-> SurfaceStyle -> Const [Colour] SurfaceStyle
#surfaceColors))
            (Double -> Colour) -> [Double] -> [Colour]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pos
-> Range Double -> Grid (Range Double) -> [Element (Range Double)]
forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
MidPos (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
0 Double
1) (SurfaceLegendOptions
l SurfaceLegendOptions -> Getting Int SurfaceLegendOptions Int -> Int
forall s a. s -> Getting a s a -> a
^. IsLabel "sloResolution" (Getting Int SurfaceLegendOptions Int)
Getting Int SurfaceLegendOptions Int
#sloResolution)
        )
    horiGlyph :: [Chart Double]
    horiGlyph :: [Chart Double]
horiGlyph =
      (Rect Double -> Colour -> Chart Double)
-> [Rect Double] -> [Colour] -> [Chart Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (\Rect Double
r Colour
c -> Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (RectStyle -> Annotation
RectA (RectStyle -> Annotation) -> RectStyle -> Annotation
forall a b. (a -> b) -> a -> b
$ Colour -> RectStyle
blob Colour
c) [Rect Double -> XY Double
forall a. Rect a -> XY a
RectXY Rect Double
r])
        ( (\Range Double
yr -> Range Double -> Range Double -> Rect Double
forall a. Range a -> Range a -> Rect a
Ranges (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
0 (SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting Double SurfaceLegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "sloWidth" (Getting Double SurfaceLegendOptions Double)
Getting Double SurfaceLegendOptions Double
#sloWidth)) Range Double
yr)
            (Range Double -> Rect Double) -> [Range Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Double -> Grid (Range Double) -> [Range Double]
forall s. FieldSpace s => s -> Grid s -> [s]
gridSpace
              Range Double
dataRange
              (SurfaceLegendOptions
l SurfaceLegendOptions -> Getting Int SurfaceLegendOptions Int -> Int
forall s a. s -> Getting a s a -> a
^. IsLabel "sloResolution" (Getting Int SurfaceLegendOptions Int)
Getting Int SurfaceLegendOptions Int
#sloResolution)
        )
        ( (\Double
x -> Double -> [Colour] -> Colour
blends Double
x (SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting [Colour] SurfaceLegendOptions [Colour] -> [Colour]
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloStyle"
  ((SurfaceStyle -> Const [Colour] SurfaceStyle)
   -> SurfaceLegendOptions -> Const [Colour] SurfaceLegendOptions)
(SurfaceStyle -> Const [Colour] SurfaceStyle)
-> SurfaceLegendOptions -> Const [Colour] SurfaceLegendOptions
#sloStyle ((SurfaceStyle -> Const [Colour] SurfaceStyle)
 -> SurfaceLegendOptions -> Const [Colour] SurfaceLegendOptions)
-> (([Colour] -> Const [Colour] [Colour])
    -> SurfaceStyle -> Const [Colour] SurfaceStyle)
-> Getting [Colour] SurfaceLegendOptions [Colour]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "surfaceColors"
  (([Colour] -> Const [Colour] [Colour])
   -> SurfaceStyle -> Const [Colour] SurfaceStyle)
([Colour] -> Const [Colour] [Colour])
-> SurfaceStyle -> Const [Colour] SurfaceStyle
#surfaceColors))
            (Double -> Colour) -> [Double] -> [Colour]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pos
-> Range Double -> Grid (Range Double) -> [Element (Range Double)]
forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
MidPos (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range Double
0 Double
1) (SurfaceLegendOptions
l SurfaceLegendOptions -> Getting Int SurfaceLegendOptions Int -> Int
forall s a. s -> Getting a s a -> a
^. IsLabel "sloResolution" (Getting Int SurfaceLegendOptions Int)
Getting Int SurfaceLegendOptions Int
#sloResolution)
        )

isHori :: SurfaceLegendOptions -> Bool
isHori :: SurfaceLegendOptions -> Bool
isHori SurfaceLegendOptions
l =
  SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting Place SurfaceLegendOptions Place -> Place
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloLegendOptions"
  ((LegendOptions -> Const Place LegendOptions)
   -> SurfaceLegendOptions -> Const Place SurfaceLegendOptions)
(LegendOptions -> Const Place LegendOptions)
-> SurfaceLegendOptions -> Const Place SurfaceLegendOptions
#sloLegendOptions ((LegendOptions -> Const Place LegendOptions)
 -> SurfaceLegendOptions -> Const Place SurfaceLegendOptions)
-> ((Place -> Const Place Place)
    -> LegendOptions -> Const Place LegendOptions)
-> Getting Place SurfaceLegendOptions Place
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "lplace"
  ((Place -> Const Place Place)
   -> LegendOptions -> Const Place LegendOptions)
(Place -> Const Place Place)
-> LegendOptions -> Const Place LegendOptions
#lplace Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom
    Bool -> Bool -> Bool
|| SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting Place SurfaceLegendOptions Place -> Place
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloLegendOptions"
  ((LegendOptions -> Const Place LegendOptions)
   -> SurfaceLegendOptions -> Const Place SurfaceLegendOptions)
(LegendOptions -> Const Place LegendOptions)
-> SurfaceLegendOptions -> Const Place SurfaceLegendOptions
#sloLegendOptions ((LegendOptions -> Const Place LegendOptions)
 -> SurfaceLegendOptions -> Const Place SurfaceLegendOptions)
-> ((Place -> Const Place Place)
    -> LegendOptions -> Const Place LegendOptions)
-> Getting Place SurfaceLegendOptions Place
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "lplace"
  ((Place -> Const Place Place)
   -> LegendOptions -> Const Place LegendOptions)
(Place -> Const Place Place)
-> LegendOptions -> Const Place LegendOptions
#lplace Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceTop

makeSurfaceTick :: SurfaceLegendOptions -> [Chart Double] -> [Chart Double]
makeSurfaceTick :: SurfaceLegendOptions -> [Chart Double] -> [Chart Double]
makeSurfaceTick SurfaceLegendOptions
l [Chart Double]
pchart = [Chart Double]
phud
  where
    r :: Rect Double
r = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one ([Chart Double] -> Maybe (Rect Double)
styleBoxes [Chart Double]
pchart)
    r' :: Rect Double
r' = Rect Double -> Rect Double -> Bool -> Rect Double
forall a. a -> a -> Bool -> a
bool (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting Double SurfaceLegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "sloWidth" (Getting Double SurfaceLegendOptions Double)
Getting Double SurfaceLegendOptions Double
#sloWidth) Double
0 (SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting Double SurfaceLegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloLegendOptions"
  ((LegendOptions -> Const Double LegendOptions)
   -> SurfaceLegendOptions -> Const Double SurfaceLegendOptions)
(LegendOptions -> Const Double LegendOptions)
-> SurfaceLegendOptions -> Const Double SurfaceLegendOptions
#sloLegendOptions ((LegendOptions -> Const Double LegendOptions)
 -> SurfaceLegendOptions -> Const Double SurfaceLegendOptions)
-> ((Double -> Const Double Double)
    -> LegendOptions -> Const Double LegendOptions)
-> Getting Double SurfaceLegendOptions Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "lsize"
  ((Double -> Const Double Double)
   -> LegendOptions -> Const Double LegendOptions)
(Double -> Const Double Double)
-> LegendOptions -> Const Double LegendOptions
#lsize)) (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting Double SurfaceLegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloLegendOptions"
  ((LegendOptions -> Const Double LegendOptions)
   -> SurfaceLegendOptions -> Const Double SurfaceLegendOptions)
(LegendOptions -> Const Double LegendOptions)
-> SurfaceLegendOptions -> Const Double SurfaceLegendOptions
#sloLegendOptions ((LegendOptions -> Const Double LegendOptions)
 -> SurfaceLegendOptions -> Const Double SurfaceLegendOptions)
-> ((Double -> Const Double Double)
    -> LegendOptions -> Const Double LegendOptions)
-> Getting Double SurfaceLegendOptions Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
  "lsize"
  ((Double -> Const Double Double)
   -> LegendOptions -> Const Double LegendOptions)
(Double -> Const Double Double)
-> LegendOptions -> Const Double LegendOptions
#lsize) Double
0 (SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting Double SurfaceLegendOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. IsLabel "sloWidth" (Getting Double SurfaceLegendOptions Double)
Getting Double SurfaceLegendOptions Double
#sloWidth)) (SurfaceLegendOptions -> Bool
isHori SurfaceLegendOptions
l)
    ([Hud Double]
hs, [Chart Double]
_) =
      Rect Double -> HudOptions -> ([Hud Double], [Chart Double])
makeHud
        Rect Double
r
        ( HudOptions
forall a. Monoid a => a
mempty HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudAxes"
  (ASetter HudOptions HudOptions [AxisOptions] [AxisOptions])
ASetter HudOptions HudOptions [AxisOptions] [AxisOptions]
#hudAxes
            ASetter HudOptions HudOptions [AxisOptions] [AxisOptions]
-> [AxisOptions] -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ SurfaceLegendOptions
l SurfaceLegendOptions
-> Getting AxisOptions SurfaceLegendOptions AxisOptions
-> AxisOptions
forall s a. s -> Getting a s a -> a
^. IsLabel
  "sloAxisOptions"
  (Getting AxisOptions SurfaceLegendOptions AxisOptions)
Getting AxisOptions SurfaceLegendOptions AxisOptions
#sloAxisOptions
                   AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel "place" (ASetter AxisOptions AxisOptions Place Place)
ASetter AxisOptions AxisOptions Place Place
#place ASetter AxisOptions AxisOptions Place Place
-> Place -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place -> Place -> Bool -> Place
forall a. a -> a -> Bool -> a
bool Place
PlaceRight Place
PlaceBottom (SurfaceLegendOptions -> Bool
isHori SurfaceLegendOptions
l)
               ]
        )
    phud :: [Chart Double]
phud = Rect Double
-> Rect Double -> [Hud Double] -> [Chart Double] -> [Chart Double]
runHudWith Rect Double
r' Rect Double
r [Hud Double]
hs [Chart Double]
pchart