{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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. 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,
    surfacefl,
    SurfaceLegendOptions (..),
    defaultSurfaceLegendOptions,
    surfaceAxisOptions,
  )
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.Text (Text)
import GHC.Generics
import Optics.Core
import Prelude

-- | 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
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
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. 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 (forall a. a -> a -> Point a
Point Int
10 Int
10) 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 = 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
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
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. 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
palette1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. Int
1]) (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
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
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. 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]
surfaces :: RectStyle -> [SurfaceData] -> [Chart]
surfaces RectStyle
rs [SurfaceData]
ps =
  ( \(SurfaceData Rect Double
r Colour
c) ->
      RectStyle -> [Rect Double] -> Chart
RectChart
        (RectStyle
rs forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c)
        [Rect Double
r]
  )
    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
mixes Double
y [Colour]
cs)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Rect Double, Double)]
ps', forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 [Double]
rs)
  where
    ps :: [(Rect Double, Double)]
ps = 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 = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Rect Double, Double)]
ps
    rs' :: [Double]
rs' = forall s.
(Space s, Field (Element s)) =>
s -> s -> Element s -> Element s
project (forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 [Double]
rs :: Range Double) (forall a. a -> a -> Range a
Range Double
0 Double
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
rs
    ps' :: [(Rect Double, Double)]
ps' = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a, b) -> a
fst 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], Range Double)
surfacef :: (Point Double -> Double)
-> SurfaceOptions -> ([Chart], Range Double)
surfacef Point Double -> Double
f SurfaceOptions
cfg =
  forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (RectStyle -> [SurfaceData] -> [Chart]
surfaces (SurfaceOptions
cfg forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "soStyle" a => a
#soStyle 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
% forall a. IsLabel "surfaceRectStyle" a => a
#surfaceRectStyle)) 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 forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "soRange" a => a
#soRange)
      (SurfaceOptions
cfg forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "soGrain" a => a
#soGrain)
      (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ SurfaceOptions
cfg forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "soStyle" a => a
#soStyle 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
% forall a. IsLabel "surfaceColors" a => a
#surfaceColors)

-- | Create a surface chart and accompanying legend from a function.
surfacefl :: (Point Double -> Double) -> SurfaceOptions -> SurfaceLegendOptions -> ([Chart], [Hud])
surfacefl :: (Point Double -> Double)
-> SurfaceOptions -> SurfaceLegendOptions -> ([Chart], [Hud])
surfacefl Point Double -> Double
f SurfaceOptions
po SurfaceLegendOptions
slo =
  ( [Chart]
cs,
    [Double -> State HudChart ChartTree -> Hud
Hud Double
10 (LegendOptions -> ChartTree -> State HudChart ChartTree
legendHud (SurfaceLegendOptions
slo forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloLegendOptions" a => a
#sloLegendOptions) (Range Double -> SurfaceLegendOptions -> ChartTree
surfaceLegendChart Range Double
dr SurfaceLegendOptions
slo))]
  )
  where
    ([Chart]
cs, Range Double
dr) = (Point Double -> Double)
-> SurfaceOptions -> ([Chart], 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
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
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. 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)

-- | 'AxisOptions' for a surface chart.
surfaceAxisOptions :: Colour -> AxisOptions
surfaceAxisOptions :: Colour -> AxisOptions
surfaceAxisOptions Colour
c =
  Maybe AxisBar -> Maybe Adjustments -> Ticks -> Place -> AxisOptions
AxisOptions
    forall a. Maybe a
Nothing
    forall a. Maybe a
Nothing
    ( TickStyle
-> Maybe (GlyphStyle, Double)
-> Maybe (TextStyle, Double)
-> Maybe (LineStyle, Double)
-> Ticks
Ticks
        (FormatN -> Int -> TickExtend -> TickStyle
TickRound (FStyle -> Maybe Int -> Bool -> FormatN
FormatN FStyle
FSPrec (forall a. a -> Maybe a
Just Int
3) Bool
True) Int
4 TickExtend
NoTickExtend)
        (forall a. a -> Maybe a
Just (GlyphStyle
defaultGlyphTick forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderColor" a => a
#borderColor forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c forall a b. a -> (a -> b) -> b
& forall a. IsLabel "shape" a => a
#shape forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ GlyphShape
VLineGlyph, Double
0.01))
        (forall a. a -> Maybe a
Just (TextStyle
defaultTextTick forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c, Double
0.03))
        forall a. Maybe a
Nothing
    )
    Place
PlaceRight

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

surfaceLegendOptions :: LegendOptions
surfaceLegendOptions :: LegendOptions
surfaceLegendOptions =
  LegendOptions
defaultLegendOptions
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "place" a => a
#place forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceRight
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "overallScale" a => a
#overallScale forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.9
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.5
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "vgap" a => a
#vgap forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.05
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hgap" a => a
#hgap forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.01
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "innerPad" a => a
#innerPad forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.05
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "outerPad" a => a
#outerPad forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.02
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "textStyle" a => a
#textStyle 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
% forall a. IsLabel "hsize" a => a
#hsize forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.5
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "textStyle" a => a
#textStyle 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
% forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.1
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "frame" a => a
#frame forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing

-- | Creation of the classical heatmap glyph within a legend context.
surfaceLegendChart :: Range Double -> SurfaceLegendOptions -> ChartTree
surfaceLegendChart :: Range Double -> SurfaceLegendOptions -> ChartTree
surfaceLegendChart Range Double
dataRange SurfaceLegendOptions
l =
  LegendOptions -> ChartTree -> ChartTree
legendFrame (forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "sloLegendOptions" a => a
#sloLegendOptions SurfaceLegendOptions
l) ChartTree
hs
  where
    a :: ChartTree
a = SurfaceLegendOptions -> ChartTree -> ChartTree
makeSurfaceTick SurfaceLegendOptions
l (Text -> [Chart] -> ChartTree
named Text
"pchart" [Chart]
pchart)
    pchart :: [Chart]
pchart
      | SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloLegendOptions" a => a
#sloLegendOptions 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
% forall a. IsLabel "place" a => a
#place forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom
          Bool -> Bool -> Bool
|| SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloLegendOptions" a => a
#sloLegendOptions 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
% forall a. IsLabel "place" a => a
#place forall a. Eq a => a -> a -> Bool
== Place
PlaceTop =
        [Chart]
vertGlyph
      | Bool
otherwise = [Chart]
horiGlyph
    t :: Chart
t = TextStyle -> [(Text, Point Double)] -> Chart
TextChart (SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloLegendOptions" a => a
#sloLegendOptions 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
% forall a. IsLabel "textStyle" a => a
#textStyle forall a b. a -> (a -> b) -> b
& forall a. IsLabel "anchor" a => a
#anchor forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Anchor
AnchorStart) [(SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloTitle" a => a
#sloTitle, forall a. Additive a => a
zero)]
    hs :: ChartTree
hs = Double -> [ChartTree] -> ChartTree
vert (SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloLegendOptions" a => a
#sloLegendOptions 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
% forall a. IsLabel "vgap" a => a
#vgap) [ChartTree
a, [Chart] -> ChartTree
unnamed [Chart
t]]
    vertGlyph :: [Chart]
    vertGlyph :: [Chart]
vertGlyph =
      forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (\Rect Double
r Colour
c -> RectStyle -> [Rect Double] -> Chart
RectChart (Colour -> RectStyle
blob Colour
c) [Rect Double
r])
        ( (\Range Double
xr -> forall a. Range a -> Range a -> Rect a
Ranges Range Double
xr (forall a. a -> a -> Range a
Range Double
0 (SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloWidth" a => a
#sloWidth)))
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. FieldSpace s => s -> Grid s -> [s]
gridSpace
              Range Double
dataRange
              (SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloResolution" a => a
#sloResolution)
        )
        ( (\Double
x -> Double -> [Colour] -> Colour
mixes Double
x (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloStyle" a => a
#sloStyle 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
% forall a. IsLabel "surfaceColors" a => a
#surfaceColors))
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
MidPos (forall a. a -> a -> Range a
Range Double
0 Double
1) (SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloResolution" a => a
#sloResolution)
        )
    horiGlyph :: [Chart]
    horiGlyph :: [Chart]
horiGlyph =
      forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (\Rect Double
r Colour
c -> RectStyle -> [Rect Double] -> Chart
RectChart (Colour -> RectStyle
blob Colour
c) [Rect Double
r])
        ( (\Range Double
yr -> forall a. Range a -> Range a -> Rect a
Ranges (forall a. a -> a -> Range a
Range Double
0 (SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloWidth" a => a
#sloWidth)) Range Double
yr)
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. FieldSpace s => s -> Grid s -> [s]
gridSpace
              Range Double
dataRange
              (SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloResolution" a => a
#sloResolution)
        )
        ( (\Double
x -> Double -> [Colour] -> Colour
mixes Double
x (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloStyle" a => a
#sloStyle 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
% forall a. IsLabel "surfaceColors" a => a
#surfaceColors))
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
MidPos (forall a. a -> a -> Range a
Range Double
0 Double
1) (SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloResolution" a => a
#sloResolution)
        )

isHori :: SurfaceLegendOptions -> Bool
isHori :: SurfaceLegendOptions -> Bool
isHori SurfaceLegendOptions
l =
  SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloLegendOptions" a => a
#sloLegendOptions 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
% forall a. IsLabel "place" a => a
#place forall a. Eq a => a -> a -> Bool
== Place
PlaceBottom
    Bool -> Bool -> Bool
|| SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloLegendOptions" a => a
#sloLegendOptions 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
% forall a. IsLabel "place" a => a
#place forall a. Eq a => a -> a -> Bool
== Place
PlaceTop

makeSurfaceTick :: SurfaceLegendOptions -> ChartTree -> ChartTree
makeSurfaceTick :: SurfaceLegendOptions -> ChartTree -> ChartTree
makeSurfaceTick SurfaceLegendOptions
l ChartTree
pchart = case forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' ChartTree (Maybe (Rect Double))
styleBox' ChartTree
pchart of
  Maybe (Rect Double)
Nothing -> ChartTree
pchart
  Just Rect Double
r' -> ChartTree
phud
    where
      r'' :: Rect Double
r'' = forall a. a -> a -> Bool -> a
bool (forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloWidth" a => a
#sloWidth) Double
0 (SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloLegendOptions" a => a
#sloLegendOptions 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
% forall a. IsLabel "size" a => a
#size)) (forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloLegendOptions" a => a
#sloLegendOptions 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
% forall a. IsLabel "size" a => a
#size) Double
0 (SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloWidth" a => a
#sloWidth)) (SurfaceLegendOptions -> Bool
isHori SurfaceLegendOptions
l)
      ([Hud]
hs, Rect Double
db) = HudOptions -> Rect Double -> ([Hud], Rect Double)
toHuds (forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "chartAspect" a => a
#chartAspect ChartAspect
ChartAspect forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "axes" a => a
#axes [(Double
9, SurfaceLegendOptions
l forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "sloAxisOptions" a => a
#sloAxisOptions forall a b. a -> (a -> b) -> b
& forall a. IsLabel "place" a => a
#place forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. a -> a -> Bool -> a
bool Place
PlaceRight Place
PlaceBottom (SurfaceLegendOptions -> Bool
isHori SurfaceLegendOptions
l))]) Rect Double
r'
      phud :: ChartTree
phud = Rect Double -> Rect Double -> [Hud] -> ChartTree -> ChartTree
runHudWith Rect Double
r'' Rect Double
db [Hud]
hs ChartTree
pchart