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

-- | 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. This library uses the term /surface/ chart but it is often referred to as a heatmap.
module Chart.Surface
  ( SurfaceData (..),
    SurfaceOptions (..),
    defaultSurfaceOptions,
    SurfaceStyle (..),
    defaultSurfaceStyle,
    mkSurfaceData,
    surfaces,
    surfacef,
    SurfaceLegendOptions (..),
    defaultSurfaceLegendOptions,
    surfaceLegendAxisOptions,
    gridReferenceChart,
    addSurfaceLegend,
  )
where

import Chart.Data
import Chart.Hud
import Chart.Primitive
import Chart.Style
import Data.Bifunctor
import Data.Bool
import Data.Colour
import Data.Foldable
import Data.FormatN
import Data.Maybe
import GHC.Generics
import NumHask.Space
import Optics.Core
import Prelude

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

-- | 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
$cshowsPrec :: Int -> SurfaceOptions -> ShowS
showsPrec :: Int -> SurfaceOptions -> ShowS
$cshow :: SurfaceOptions -> String
show :: SurfaceOptions -> String
$cshowList :: [SurfaceOptions] -> ShowS
showList :: [SurfaceOptions] -> ShowS
Show, SurfaceOptions -> SurfaceOptions -> Bool
(SurfaceOptions -> SurfaceOptions -> Bool)
-> (SurfaceOptions -> SurfaceOptions -> Bool) -> Eq SurfaceOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SurfaceOptions -> SurfaceOptions -> Bool
== :: SurfaceOptions -> SurfaceOptions -> Bool
$c/= :: SurfaceOptions -> SurfaceOptions -> Bool
/= :: 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
$cfrom :: forall x. SurfaceOptions -> Rep SurfaceOptions x
from :: forall x. SurfaceOptions -> Rep SurfaceOptions x
$cto :: forall x. Rep SurfaceOptions x -> SurfaceOptions
to :: forall x. Rep SurfaceOptions x -> SurfaceOptions
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 'RectChart'
--
-- >>> defaultSurfaceStyle
-- SurfaceStyle {surfaceColors = [Colour 0.02 0.73 0.80 1.00,Colour 0.02 0.29 0.48 1.00], surfaceRectStyle = Style {size = 6.0e-2, borderSize = 0.0, color = Colour 0.05 0.05 0.05 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}}
--
-- ![surface example](other/surface.svg)
data SurfaceStyle = SurfaceStyle
  { -- | list of colours to interpolate between.
    SurfaceStyle -> [Colour]
surfaceColors :: [Colour],
    SurfaceStyle -> Style
surfaceRectStyle :: Style
  }
  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
$cshowsPrec :: Int -> SurfaceStyle -> ShowS
showsPrec :: Int -> SurfaceStyle -> ShowS
$cshow :: SurfaceStyle -> String
show :: SurfaceStyle -> String
$cshowList :: [SurfaceStyle] -> ShowS
showList :: [SurfaceStyle] -> ShowS
Show, SurfaceStyle -> SurfaceStyle -> Bool
(SurfaceStyle -> SurfaceStyle -> Bool)
-> (SurfaceStyle -> SurfaceStyle -> Bool) -> Eq SurfaceStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SurfaceStyle -> SurfaceStyle -> Bool
== :: SurfaceStyle -> SurfaceStyle -> Bool
$c/= :: SurfaceStyle -> SurfaceStyle -> Bool
/= :: 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
$cfrom :: forall x. SurfaceStyle -> Rep SurfaceStyle x
from :: forall x. SurfaceStyle -> Rep SurfaceStyle x
$cto :: forall x. Rep SurfaceStyle x -> SurfaceStyle
to :: forall x. Rep SurfaceStyle x -> SurfaceStyle
Generic)

-- | The official surface style.
defaultSurfaceStyle :: SurfaceStyle
defaultSurfaceStyle :: SurfaceStyle
defaultSurfaceStyle =
  [Colour] -> Style -> SurfaceStyle
SurfaceStyle (Int -> Colour
palette (Int -> Colour) -> [Int] -> [Colour]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. Int
1]) (Colour -> Style
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
$cshowsPrec :: Int -> SurfaceData -> ShowS
showsPrec :: Int -> SurfaceData -> ShowS
$cshow :: SurfaceData -> String
show :: SurfaceData -> String
$cshowList :: [SurfaceData] -> ShowS
showList :: [SurfaceData] -> ShowS
Show, SurfaceData -> SurfaceData -> Bool
(SurfaceData -> SurfaceData -> Bool)
-> (SurfaceData -> SurfaceData -> Bool) -> Eq SurfaceData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SurfaceData -> SurfaceData -> Bool
== :: SurfaceData -> SurfaceData -> Bool
$c/= :: SurfaceData -> SurfaceData -> Bool
/= :: 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
$cfrom :: forall x. SurfaceData -> Rep SurfaceData x
from :: forall x. SurfaceData -> Rep SurfaceData x
$cto :: forall x. Rep SurfaceData x -> SurfaceData
to :: forall x. Rep SurfaceData x -> SurfaceData
Generic)

-- | surface chart without any hud trimmings
surfaces :: Style -> [SurfaceData] -> [Chart]
surfaces :: Style -> [SurfaceData] -> [Chart]
surfaces Style
rs [SurfaceData]
ps =
  ( \(SurfaceData Rect Double
r Colour
c) ->
      Style -> ChartData -> Chart
Chart
        (Style
rs 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)
        ([Rect Double] -> ChartData
RectData [Rect Double
r])
  )
    (SurfaceData -> Chart) -> [SurfaceData] -> [Chart]
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 -> Colour -> SurfaceData)
-> [Rect Double] -> [Colour] -> [SurfaceData]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Rect Double -> Colour -> SurfaceData
SurfaceData [Rect Double]
rects ((Double -> [Colour] -> Colour) -> [Colour] -> Double -> Colour
forall a b c. (a -> b -> c) -> b -> a -> c
flip Double -> [Colour] -> Colour
mixes [Colour]
cs (Double -> Colour) -> [Double] -> [Colour]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
proj), Range Double
x)
  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
    rects :: [Rect Double]
rects = (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
    vs :: [Double]
vs = (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
    x :: Range Double
x = [Element (Range Double)] -> Range Double
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 [Double]
[Element (Range Double)]
vs :: Range Double
    proj :: [Double]
proj = Range Double
-> Range Double -> Element (Range Double) -> Element (Range Double)
forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project Range Double
x (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]
vs

-- | Create a surface chart from a function.
surfacef :: (Point Double -> Double) -> SurfaceOptions -> ([Chart], Range Double)
surfacef :: (Point Double -> Double)
-> SurfaceOptions -> ([Chart], Range Double)
surfacef Point Double -> Double
f SurfaceOptions
cfg =
  ([SurfaceData] -> [Chart])
-> ([SurfaceData], Range Double) -> ([Chart], Range Double)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Style -> [SurfaceData] -> [Chart]
surfaces (Optic' A_Lens NoIx SurfaceOptions Style -> SurfaceOptions -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens NoIx SurfaceOptions SurfaceOptions SurfaceStyle SurfaceStyle
#soStyle Optic
  A_Lens NoIx SurfaceOptions SurfaceOptions SurfaceStyle SurfaceStyle
-> Optic A_Lens NoIx SurfaceStyle SurfaceStyle Style Style
-> Optic' A_Lens NoIx SurfaceOptions Style
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx SurfaceStyle SurfaceStyle Style Style
#surfaceRectStyle) SurfaceOptions
cfg)) (([SurfaceData], Range Double) -> ([Chart], Range Double))
-> ([SurfaceData], Range Double) -> ([Chart], 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
      (Optic' A_Lens NoIx SurfaceOptions (Rect Double)
-> SurfaceOptions -> Rect Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx SurfaceOptions (Rect Double)
#soRange SurfaceOptions
cfg)
      (Optic' A_Lens NoIx SurfaceOptions (Point Int)
-> SurfaceOptions -> Point Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx SurfaceOptions (Point Int)
#soGrain SurfaceOptions
cfg)
      ([Colour] -> [Colour]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([Colour] -> [Colour]) -> [Colour] -> [Colour]
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx SurfaceOptions [Colour]
-> SurfaceOptions -> [Colour]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens NoIx SurfaceOptions SurfaceOptions SurfaceStyle SurfaceStyle
#soStyle Optic
  A_Lens NoIx SurfaceOptions SurfaceOptions SurfaceStyle SurfaceStyle
-> Optic A_Lens NoIx SurfaceStyle SurfaceStyle [Colour] [Colour]
-> Optic' A_Lens NoIx SurfaceOptions [Colour]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx SurfaceStyle SurfaceStyle [Colour] [Colour]
#surfaceColors) SurfaceOptions
cfg)

-- | Legend specialization for a surface chart.
data SurfaceLegendOptions = SurfaceLegendOptions
  { SurfaceLegendOptions -> AxisOptions
sloAxisOptions :: AxisOptions,
    -- | Width of the legend glyph
    SurfaceLegendOptions -> Double
sloWidth :: Double,
    -- | Resolution of the legend glyph
    SurfaceLegendOptions -> Int
sloResolution :: Int,
    SurfaceLegendOptions -> Range Double
sloDataRange :: Range Double,
    -- | Placement of the legend versus normalised chart placement
    SurfaceLegendOptions -> Rect Double
sloRect :: Rect Double,
    SurfaceLegendOptions -> SurfaceStyle
sloSurfaceStyle :: SurfaceStyle
  }
  deriving (SurfaceLegendOptions -> SurfaceLegendOptions -> Bool
(SurfaceLegendOptions -> SurfaceLegendOptions -> Bool)
-> (SurfaceLegendOptions -> SurfaceLegendOptions -> Bool)
-> Eq SurfaceLegendOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SurfaceLegendOptions -> SurfaceLegendOptions -> Bool
== :: SurfaceLegendOptions -> SurfaceLegendOptions -> Bool
$c/= :: SurfaceLegendOptions -> SurfaceLegendOptions -> Bool
/= :: 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
$cshowsPrec :: Int -> SurfaceLegendOptions -> ShowS
showsPrec :: Int -> SurfaceLegendOptions -> ShowS
$cshow :: SurfaceLegendOptions -> String
show :: SurfaceLegendOptions -> String
$cshowList :: [SurfaceLegendOptions] -> ShowS
showList :: [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
$cfrom :: forall x. SurfaceLegendOptions -> Rep SurfaceLegendOptions x
from :: forall x. SurfaceLegendOptions -> Rep SurfaceLegendOptions x
$cto :: forall x. Rep SurfaceLegendOptions x -> SurfaceLegendOptions
to :: forall x. Rep SurfaceLegendOptions x -> SurfaceLegendOptions
Generic)

-- | 'AxisOptions' for a surface chart legend.
surfaceLegendAxisOptions :: AxisOptions
surfaceLegendAxisOptions :: AxisOptions
surfaceLegendAxisOptions =
  Maybe AxisBar -> Maybe Adjustments -> Ticks -> Place -> AxisOptions
AxisOptions
    Maybe AxisBar
forall a. Maybe a
Nothing
    Maybe Adjustments
forall a. Maybe a
Nothing
    ( Tick
-> Maybe TickStyle -> Maybe TickStyle -> Maybe TickStyle -> Ticks
Ticks
        (FormatN -> Int -> TickExtend -> Tick
TickRound (FStyle -> Maybe Int -> Int -> Bool -> Bool -> FormatN
FormatN FStyle
FSPrec (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) Int
4 Bool
True Bool
True) Int
4 TickExtend
NoTickExtend)
        (TickStyle -> Maybe TickStyle
forall a. a -> Maybe a
Just TickStyle
defaultGlyphTickStyleY)
        (TickStyle -> Maybe TickStyle
forall a. a -> Maybe a
Just (TickStyle
defaultTextTick TickStyle -> (TickStyle -> TickStyle) -> TickStyle
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TickStyle TickStyle Double Double
-> Double -> TickStyle -> TickStyle
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 TickStyle TickStyle Double Double
#buffer Double
0.05))
        Maybe TickStyle
forall a. Maybe a
Nothing
    )
    Place
PlaceRight

-- | official surface legend options
defaultSurfaceLegendOptions :: SurfaceLegendOptions
defaultSurfaceLegendOptions :: SurfaceLegendOptions
defaultSurfaceLegendOptions =
  AxisOptions
-> Double
-> Int
-> Range Double
-> Rect Double
-> SurfaceStyle
-> SurfaceLegendOptions
SurfaceLegendOptions AxisOptions
surfaceLegendAxisOptions Double
0.2 Int
100 Range Double
forall a. Multiplicative a => a
one (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0.7 Double
0.9 Double
0 Double
0.5) SurfaceStyle
defaultSurfaceStyle

-- | Chart used as a reference to a surface chart.
gridReferenceChart :: SurfaceLegendOptions -> ChartTree
gridReferenceChart :: SurfaceLegendOptions -> ChartTree
gridReferenceChart SurfaceLegendOptions
slo =
  Text -> [Chart] -> ChartTree
named Text
"grid reference" ([Chart] -> ChartTree) -> [Chart] -> ChartTree
forall a b. (a -> b) -> a -> b
$
    (Rect Double -> Colour -> Chart)
-> [Rect Double] -> [Colour] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
      (\Rect Double
r Colour
c -> Style -> ChartData -> Chart
Chart (Colour -> Style
blob Colour
c) ([Rect Double] -> ChartData
RectData [Rect Double
r]))
      (Range Double -> Rect Double
gridf (Range Double -> Rect Double) -> [Range Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Range Double]
spaceGrid)
      [Colour]
colorGrid
  where
    spaceGrid :: [Range Double]
spaceGrid = Range Double -> Grid (Range Double) -> [Range Double]
forall s. FieldSpace s => s -> Grid s -> [s]
gridSpace (Optic' A_Lens NoIx SurfaceLegendOptions (Range Double)
-> SurfaceLegendOptions -> Range Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx SurfaceLegendOptions (Range Double)
#sloDataRange SurfaceLegendOptions
slo) (Optic' A_Lens NoIx SurfaceLegendOptions (Grid (Range Double))
-> SurfaceLegendOptions -> Grid (Range Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx SurfaceLegendOptions (Grid (Range Double))
#sloResolution SurfaceLegendOptions
slo)
    gridf :: Range Double -> Rect Double
gridf =
      (Range Double -> Rect Double)
-> (Range Double -> Rect Double)
-> Bool
-> Range Double
-> Rect Double
forall a. a -> a -> Bool -> a
bool
        (\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 (Optic' A_Lens NoIx SurfaceLegendOptions Double
-> SurfaceLegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx SurfaceLegendOptions Double
#sloWidth SurfaceLegendOptions
slo)) Range Double
yr)
        (\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 (Optic' A_Lens NoIx SurfaceLegendOptions Double
-> SurfaceLegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx SurfaceLegendOptions Double
#sloWidth SurfaceLegendOptions
slo)))
        (SurfaceLegendOptions -> Bool
isHori SurfaceLegendOptions
slo)
    colorGrid :: [Colour]
colorGrid =
      (\Double
x -> Double -> [Colour] -> Colour
mixes Double
x ([Colour] -> [Colour]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([Colour] -> [Colour]) -> [Colour] -> [Colour]
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx SurfaceLegendOptions [Colour]
-> SurfaceLegendOptions -> [Colour]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  SurfaceStyle
  SurfaceStyle
#sloSurfaceStyle Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  SurfaceStyle
  SurfaceStyle
-> Optic A_Lens NoIx SurfaceStyle SurfaceStyle [Colour] [Colour]
-> Optic' A_Lens NoIx SurfaceLegendOptions [Colour]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx SurfaceStyle SurfaceStyle [Colour] [Colour]
#surfaceColors) SurfaceLegendOptions
slo))
        (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) (Optic' A_Lens NoIx SurfaceLegendOptions Int
-> SurfaceLegendOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx SurfaceLegendOptions Int
#sloResolution SurfaceLegendOptions
slo)

isHori :: SurfaceLegendOptions -> Bool
isHori :: SurfaceLegendOptions -> Bool
isHori SurfaceLegendOptions
slo =
  Optic' A_Lens NoIx SurfaceLegendOptions Place
-> SurfaceLegendOptions -> Place
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  AxisOptions
  AxisOptions
#sloAxisOptions Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  AxisOptions
  AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Place Place
-> Optic' A_Lens NoIx SurfaceLegendOptions Place
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place) SurfaceLegendOptions
slo Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom
    Bool -> Bool -> Bool
|| Optic' A_Lens NoIx SurfaceLegendOptions Place
-> SurfaceLegendOptions -> Place
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  AxisOptions
  AxisOptions
#sloAxisOptions Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  AxisOptions
  AxisOptions
-> Optic A_Lens NoIx AxisOptions AxisOptions Place Place
-> Optic' A_Lens NoIx SurfaceLegendOptions Place
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place) SurfaceLegendOptions
slo Place -> Place -> Bool
forall a. Eq a => a -> a -> Bool
== Place
PlaceTop

-- | Add a surface legend to a main surface chart.
addSurfaceLegend :: SurfaceLegendOptions -> ChartTree -> ChartTree
addSurfaceLegend :: SurfaceLegendOptions -> ChartTree -> ChartTree
addSurfaceLegend SurfaceLegendOptions
slo ChartTree
ct = ChartTree
ctBoth
  where
    grc :: ChartTree
grc = SurfaceLegendOptions -> ChartTree
gridReferenceChart SurfaceLegendOptions
slo
    hoLegend :: HudOptions
hoLegend = (HudOptions
forall a. Monoid a => a
mempty :: HudOptions) HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> [Priority AxisOptions] -> HudOptions -> HudOptions
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
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes [Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
1 (Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  AxisOptions
  AxisOptions
-> SurfaceLegendOptions -> AxisOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic
  A_Lens
  NoIx
  SurfaceLegendOptions
  SurfaceLegendOptions
  AxisOptions
  AxisOptions
#sloAxisOptions SurfaceLegendOptions
slo)]
    grcLegend :: ChartTree
grcLegend = ChartAspect -> HudOptions -> ChartTree -> ChartTree
addHud (Double -> ChartAspect
FixedAspect (Optic' A_Lens NoIx SurfaceLegendOptions Double
-> SurfaceLegendOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx SurfaceLegendOptions Double
#sloWidth SurfaceLegendOptions
slo)) HudOptions
hoLegend ChartTree
grc
    ctbox :: Rect Double
ctbox = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one (Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
-> ChartTree -> Maybe (Rect Double)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ChartTree (Maybe (Rect Double))
styleBox' ChartTree
ct)
    legbox :: Rect Double
legbox = Rect Double -> Rect Double -> Rect Double -> Rect Double
projectOnR Rect Double
ctbox Rect Double
forall a. Multiplicative a => a
one (Optic' A_Lens NoIx SurfaceLegendOptions (Rect Double)
-> SurfaceLegendOptions -> Rect Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx SurfaceLegendOptions (Rect Double)
#sloRect SurfaceLegendOptions
slo)
    ctBoth :: ChartTree
ctBoth = [ChartTree] -> ChartTree
forall a. Monoid a => [a] -> a
mconcat [Rect Double -> ChartTree -> ChartTree
projectChartTree Rect Double
legbox ChartTree
grcLegend, ChartTree
ct]