{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE RecordWildCards        #-}
{-# LANGUAGE TemplateHaskell        #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE ViewPatterns           #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Plots.Axis.ColourBar
-- Copyright   :  (C) 2016 Christopher Chalmers
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Christopher Chalmers
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Options for rendering a colour bar, either attached to an axis or
-- rendered separately.
--
-- To change the colour map used for the colour bar see
-- 'Plots.Style.axisColourMap' from "Plots.Style".
--
----------------------------------------------------------------------------
module Plots.Axis.ColourBar
 ( -- * The colour bar
   ColourBar
 , HasColourBar (..)
 , defColourBar

   -- ** Rendering options
 , gradientColourBar
 , pathColourBar

   -- * Rendering colour bars
 , renderColourBar
 , addColourBar
 ) where

import           Data.Bool               (bool)
import qualified Data.Foldable           as F
import           Data.Typeable
import           Diagrams.Core.Transform (fromSymmetric)
import           Diagrams.Prelude        hiding (gap)
import           Diagrams.TwoD.Text
import           Plots.Axis.Grid
import           Plots.Axis.Labels
import           Plots.Axis.Ticks
import           Plots.Style
import           Plots.Types
import           Plots.Util

-- | Options for drawing a colour bar. Note that for an axis, the
--   'ColourMap' is stored in the 'AxisStyle'. These options are for
--   other aspects of the bar, not the colours used.
data ColourBar b n = ColourBar
  { forall b n. ColourBar b n -> Placement
cbPlacement  :: Placement
  , forall b n. ColourBar b n -> Bool
cbVisible    :: Bool
  , forall b n. ColourBar b n -> MajorTicks V2 n
cbTicks      :: MajorTicks V2 n
  , forall b n. ColourBar b n -> MinorTicks V2 n
cbMinorTicks :: MinorTicks V2 n
  , forall b n. ColourBar b n -> MajorGridLines V2 n
cbGridLines  :: MajorGridLines V2 n
  , forall b n. ColourBar b n -> TickLabels b V2 n
cbTickLabels :: TickLabels b V2 n
  , forall b n. ColourBar b n -> ColourMap -> QDiagram b V2 n Any
cbDraw       :: ColourMap -> QDiagram b V2 n Any
  , forall b n. ColourBar b n -> n
cbWidth      :: n
  , forall b n. ColourBar b n -> n -> n
cbLengthFun  :: n -> n
  , forall b n. ColourBar b n -> n
cbGap        :: n
  , forall b n. ColourBar b n -> Style V2 n
cbStyle      :: Style V2 n
  }

type instance V (ColourBar b n) = V2
type instance N (ColourBar b n) = n

-- | The default colour bar.
defColourBar :: (Renderable (Text n) b, Renderable (Path V2 n) b, TypeableFloat n)
             => ColourBar b n
defColourBar :: forall n b.
(Renderable (Text n) b, Renderable (Path V2 n) b,
 TypeableFloat n) =>
ColourBar b n
defColourBar = ColourBar
  { cbPlacement :: Placement
cbPlacement   = Placement
rightMid
  , cbVisible :: Bool
cbVisible     = Bool
False
  , cbTicks :: MajorTicks V2 n
cbTicks       = MajorTicks V2 n
forall a. Default a => a
def
  , cbMinorTicks :: MinorTicks V2 n
cbMinorTicks  = MinorTicks V2 n
forall a. Default a => a
def MinorTicks V2 n
-> (MinorTicks V2 n -> MinorTicks V2 n) -> MinorTicks V2 n
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool)
-> MinorTicks V2 n -> Identity (MinorTicks V2 n)
forall a. HasVisibility a => Lens' a Bool
Lens' (MinorTicks V2 n) Bool
hidden ((Bool -> Identity Bool)
 -> MinorTicks V2 n -> Identity (MinorTicks V2 n))
-> Bool -> MinorTicks V2 n -> MinorTicks V2 n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
  , cbGridLines :: MajorGridLines V2 n
cbGridLines   = MajorGridLines V2 n
forall a. Default a => a
def
  , cbTickLabels :: TickLabels b V2 n
cbTickLabels  = TickLabels b V2 n
forall a. Default a => a
def
  , cbDraw :: ColourMap -> QDiagram b V2 n Any
cbDraw        = ColourMap -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
ColourMap -> QDiagram b V2 n Any
gradientColourBar
  , cbWidth :: n
cbWidth       = n
20
  , cbLengthFun :: n -> n
cbLengthFun   = n -> n
forall a. a -> a
id
  , cbGap :: n
cbGap         = n
20
  , cbStyle :: Style V2 n
cbStyle       = Style V2 n
forall a. Monoid a => a
mempty
  }

class HasColourBar a b | a -> b where
  -- | Lens onto the 'ColourBar'.
  colourBar :: Lens' a (ColourBar b (N a))

  -- | How to draw the colour bar. Expects a 1 by 1 box with the
  --   gradient going from left to right, without an outline with origin
  --   in the middle of the left side. See 'gradientColourBar' and
  --   'pathColourBar'.
  --
  --   The colour map this function recieves it given by
  --   'Plots.Style.axisColourMap' from "Plots.Style"
  --
  --   Default is 'gradientColourBar'.
  colourBarDraw :: Lens' a (ColourMap -> QDiagram b V2 (N a) Any)
  colourBarDraw = (ColourBar b (N a) -> f (ColourBar b (N a))) -> a -> f a
forall a b. HasColourBar a b => Lens' a (ColourBar b (N a))
Lens' a (ColourBar b (N a))
colourBar ((ColourBar b (N a) -> f (ColourBar b (N a))) -> a -> f a)
-> (((ColourMap -> QDiagram b V2 (N a) Any)
     -> f (ColourMap -> QDiagram b V2 (N a) Any))
    -> ColourBar b (N a) -> f (ColourBar b (N a)))
-> ((ColourMap -> QDiagram b V2 (N a) Any)
    -> f (ColourMap -> QDiagram b V2 (N a) Any))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColourBar b (N a) -> ColourMap -> QDiagram b V2 (N a) Any)
-> (ColourBar b (N a)
    -> (ColourMap -> QDiagram b V2 (N a) Any) -> ColourBar b (N a))
-> Lens
     (ColourBar b (N a))
     (ColourBar b (N a))
     (ColourMap -> QDiagram b V2 (N a) Any)
     (ColourMap -> QDiagram b V2 (N a) Any)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ColourBar b (N a) -> ColourMap -> QDiagram b V2 (N a) Any
forall b n. ColourBar b n -> ColourMap -> QDiagram b V2 n Any
cbDraw (\ColourBar b (N a)
c ColourMap -> QDiagram b V2 (N a) Any
a -> ColourBar b (N a)
c {cbDraw = a})

  -- | The width (orthogonal to the colour bar direction) of the colour
  --   bar.
  --
  --   'Default' is @20@.
  colourBarWidth :: Lens' a (N a)
  colourBarWidth = (ColourBar b (N a) -> f (ColourBar b (N a))) -> a -> f a
forall a b. HasColourBar a b => Lens' a (ColourBar b (N a))
Lens' a (ColourBar b (N a))
colourBar ((ColourBar b (N a) -> f (ColourBar b (N a))) -> a -> f a)
-> ((N a -> f (N a)) -> ColourBar b (N a) -> f (ColourBar b (N a)))
-> (N a -> f (N a))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColourBar b (N a) -> N a)
-> (ColourBar b (N a) -> N a -> ColourBar b (N a))
-> Lens (ColourBar b (N a)) (ColourBar b (N a)) (N a) (N a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ColourBar b (N a) -> N a
forall b n. ColourBar b n -> n
cbWidth (\ColourBar b (N a)
c N a
a -> ColourBar b (N a)
c {cbWidth = a})

  -- | Set the length of the colour bar given the length of the axis the
  --   colour bar is aligned to.
  --
  --   'Default' is 'id'.
  colourBarLengthFunction :: Lens' a (N a -> N a)
  colourBarLengthFunction = (ColourBar b (N a) -> f (ColourBar b (N a))) -> a -> f a
forall a b. HasColourBar a b => Lens' a (ColourBar b (N a))
Lens' a (ColourBar b (N a))
colourBar ((ColourBar b (N a) -> f (ColourBar b (N a))) -> a -> f a)
-> (((N a -> N a) -> f (N a -> N a))
    -> ColourBar b (N a) -> f (ColourBar b (N a)))
-> ((N a -> N a) -> f (N a -> N a))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColourBar b (N a) -> N a -> N a)
-> (ColourBar b (N a) -> (N a -> N a) -> ColourBar b (N a))
-> Lens
     (ColourBar b (N a)) (ColourBar b (N a)) (N a -> N a) (N a -> N a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ColourBar b (N a) -> N a -> N a
forall b n. ColourBar b n -> n -> n
cbLengthFun (\ColourBar b (N a)
c N a -> N a
a -> ColourBar b (N a)
c {cbLengthFun = a})

  -- | Gap between the axis and the colour bar (if rendered with an axis).
  --
  --   'Default' is @20@.
  colourBarGap :: Lens' a (N a)
  colourBarGap = (ColourBar b (N a) -> f (ColourBar b (N a))) -> a -> f a
forall a b. HasColourBar a b => Lens' a (ColourBar b (N a))
Lens' a (ColourBar b (N a))
colourBar ((ColourBar b (N a) -> f (ColourBar b (N a))) -> a -> f a)
-> ((N a -> f (N a)) -> ColourBar b (N a) -> f (ColourBar b (N a)))
-> (N a -> f (N a))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColourBar b (N a) -> N a)
-> (ColourBar b (N a) -> N a -> ColourBar b (N a))
-> Lens (ColourBar b (N a)) (ColourBar b (N a)) (N a) (N a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ColourBar b (N a) -> N a
forall b n. ColourBar b n -> n
cbGap (\ColourBar b (N a)
c N a
a -> ColourBar b (N a)
c {cbGap = a})

  -- | Style used for the outline of a colour bar.
  colourBarStyle :: Lens' a (Style V2 (N a))
  colourBarStyle = (ColourBar b (N a) -> f (ColourBar b (N a))) -> a -> f a
forall a b. HasColourBar a b => Lens' a (ColourBar b (N a))
Lens' a (ColourBar b (N a))
colourBar ((ColourBar b (N a) -> f (ColourBar b (N a))) -> a -> f a)
-> ((Style V2 (N a) -> f (Style V2 (N a)))
    -> ColourBar b (N a) -> f (ColourBar b (N a)))
-> (Style V2 (N a) -> f (Style V2 (N a)))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColourBar b (N a) -> Style V2 (N a))
-> (ColourBar b (N a) -> Style V2 (N a) -> ColourBar b (N a))
-> Lens
     (ColourBar b (N a))
     (ColourBar b (N a))
     (Style V2 (N a))
     (Style V2 (N a))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ColourBar b (N a) -> Style V2 (N a)
forall b n. ColourBar b n -> Style V2 n
cbStyle (\ColourBar b (N a)
c Style V2 (N a)
a -> ColourBar b (N a)
c {cbStyle = a})

instance HasColourBar (ColourBar b n) b where
  colourBar :: Lens' (ColourBar b n) (ColourBar b (N (ColourBar b n)))
colourBar = (ColourBar b n -> f (ColourBar b n))
-> ColourBar b n -> f (ColourBar b n)
(ColourBar b (N (ColourBar b n))
 -> f (ColourBar b (N (ColourBar b n))))
-> ColourBar b n -> f (ColourBar b n)
forall a. a -> a
id

instance HasGap (ColourBar b n) where
  gap :: Lens' (ColourBar b n) (N (ColourBar b n))
gap = (N (ColourBar b n) -> f (N (ColourBar b n)))
-> ColourBar b n -> f (ColourBar b n)
forall a b. HasColourBar a b => Lens' a (N a)
Lens' (ColourBar b n) (N (ColourBar b n))
colourBarGap

instance HasPlacement (ColourBar b n) where
  placement :: Lens' (ColourBar b n) Placement
placement = (ColourBar b n -> Placement)
-> (ColourBar b n -> Placement -> ColourBar b n)
-> Lens' (ColourBar b n) Placement
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ColourBar b n -> Placement
forall b n. ColourBar b n -> Placement
cbPlacement (\ColourBar b n
c Placement
p -> ColourBar b n
c {cbPlacement = p})

-- This is a kinda strange instance that I'm using as an experiment.
-- The Orientation depends on the 'Placement' of the colour bar.
--
-- \ N /
-- W * E
-- / S \
--
-- if it's on the east or west it's vertical, north or south it's
-- horizontal. If it's on a border it uses whatever way the gap
-- direction points. If the direction is parallel to the direction it's
-- on, we arbitrary choose pointing NE or SE to be vertical, NW and SW
-- to be horizontal (just for completeness, having such gap directions
-- doesn't make much sense).
--
-- When reversing the direction we map E <-> S and N <-> W. The gap
-- direction is rotated to match the new position and anchor has its x
-- and y flipped.
instance HasOrientation (ColourBar b n) where
  orientation :: Lens' (ColourBar b n) Orientation
orientation = (ColourBar b n -> Orientation)
-> (ColourBar b n -> Orientation -> ColourBar b n)
-> Lens' (ColourBar b n) Orientation
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ColourBar b n -> Orientation
forall {s}. HasPlacement s => s -> Orientation
getter ColourBar b n -> Orientation -> ColourBar b n
forall {a}. HasPlacement a => a -> Orientation -> a
setter where

    getter :: s -> Orientation
getter s
p
      | Bool
north     Bool -> Bool -> Bool
|| Bool
south = Orientation
Horizontal
      | Bool
east      Bool -> Bool -> Bool
|| Bool
west  = Orientation
Vertical
      | Bool
northEast          = Orientation -> Orientation -> Bool -> Orientation
forall a. a -> a -> Bool -> a
bool Orientation
Horizontal Orientation
Vertical (Rational
dx Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
dy)
      | Bool
southEast          = Orientation -> Orientation -> Bool -> Orientation
forall a. a -> a -> Bool -> a
bool Orientation
Horizontal Orientation
Vertical (Rational
dx Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> -Rational
dy)
      | Bool
southWest          = Orientation -> Orientation -> Bool -> Orientation
forall a. a -> a -> Bool -> a
bool Orientation
Horizontal Orientation
Vertical (Rational
dx Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
dy)
      | Bool
northWest          = Orientation -> Orientation -> Bool -> Orientation
forall a. a -> a -> Bool -> a
bool Orientation
Horizontal Orientation
Vertical (Rational
dx Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< -Rational
dy)
      | Bool
otherwise          = [Char] -> Orientation
forall a. HasCallStack => [Char] -> a
error ([Char] -> Orientation) -> [Char] -> Orientation
forall a b. (a -> b) -> a -> b
$ [Char]
"internal error: get colourBar orientation: "
                                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Placement -> [Char]
forall a. Show a => a -> [Char]
show (s
p s -> Getting Placement s Placement -> Placement
forall s a. s -> Getting a s a -> a
^. Getting Placement s Placement
forall a. HasPlacement a => Lens' a Placement
Lens' s Placement
placement)
      where
        V2 Rational
x Rational
y   = s
p s -> Getting (V2 Rational) s (V2 Rational) -> V2 Rational
forall s a. s -> Getting a s a -> a
^. Getting (V2 Rational) s (V2 Rational)
forall a. HasPlacement a => Lens' a (V2 Rational)
Lens' s (V2 Rational)
placementAt
        V2 Rational
dx Rational
dy = s
p s -> Getting (V2 Rational) s (V2 Rational) -> V2 Rational
forall s a. s -> Getting a s a -> a
^. (Direction V2 Rational
 -> Const (V2 Rational) (Direction V2 Rational))
-> s -> Const (V2 Rational) s
forall a. HasPlacement a => Lens' a (Direction V2 Rational)
Lens' s (Direction V2 Rational)
gapDirection ((Direction V2 Rational
  -> Const (V2 Rational) (Direction V2 Rational))
 -> s -> Const (V2 Rational) s)
-> ((V2 Rational -> Const (V2 Rational) (V2 Rational))
    -> Direction V2 Rational
    -> Const (V2 Rational) (Direction V2 Rational))
-> Getting (V2 Rational) s (V2 Rational)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V2 Rational -> Const (V2 Rational) (V2 Rational))
-> Direction V2 Rational
-> Const (V2 Rational) (Direction V2 Rational)
forall (v :: * -> *) n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (v n) (f (v n)) -> p (Direction v n) (f (Direction v n))
_Dir
        north :: Bool
north = Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
y Bool -> Bool -> Bool
&& Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> (-Rational
y)
        east :: Bool
east  = Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
y Bool -> Bool -> Bool
&& Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> (-Rational
y)
        south :: Bool
south = Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
y Bool -> Bool -> Bool
&& Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< (-Rational
y)
        west :: Bool
west  = Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
y Bool -> Bool -> Bool
&& Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< (-Rational
y)
        northEast :: Bool
northEast = Rational
x Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
==   Rational
y  Bool -> Bool -> Bool
&& Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0
        southEast :: Bool
southEast = Rational
x Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== (-Rational
y) Bool -> Bool -> Bool
&& Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0
        southWest :: Bool
southWest = Rational
x Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
==   Rational
y  Bool -> Bool -> Bool
&& Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0
        northWest :: Bool
northWest = Rational
x Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== (-Rational
y) Bool -> Bool -> Bool
&& Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0

    setter :: a -> Orientation -> a
setter a
p Orientation
o
      | a -> Orientation
forall {s}. HasPlacement s => s -> Orientation
getter a
p Orientation -> Orientation -> Bool
forall a. Eq a => a -> a -> Bool
== Orientation
o = a
p
      | Bool
otherwise     = a
p a -> (a -> a) -> a
forall a b. a -> (a -> b) -> b
& (V2 Rational -> Identity (V2 Rational)) -> a -> Identity a
forall a. HasPlacement a => Lens' a (V2 Rational)
Lens' a (V2 Rational)
placementAt        ((V2 Rational -> Identity (V2 Rational)) -> a -> Identity a)
-> (V2 Rational -> V2 Rational) -> a -> a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ V2 Rational -> V2 Rational
forall n. Num n => V2 n -> V2 n
flipX_Y
                          a -> (a -> a) -> a
forall a b. a -> (a -> b) -> b
& (V2 Rational -> Identity (V2 Rational)) -> a -> Identity a
forall a. HasPlacement a => Lens' a (V2 Rational)
Lens' a (V2 Rational)
placementAnchor    ((V2 Rational -> Identity (V2 Rational)) -> a -> Identity a)
-> (V2 Rational -> V2 Rational) -> a -> a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ V2 Rational -> V2 Rational
forall n. Num n => V2 n -> V2 n
flipX_Y
                          a -> (a -> a) -> a
forall a b. a -> (a -> b) -> b
& (Direction V2 Rational -> Identity (Direction V2 Rational))
-> a -> Identity a
forall a. HasPlacement a => Lens' a (Direction V2 Rational)
Lens' a (Direction V2 Rational)
gapDirection ((Direction V2 Rational -> Identity (Direction V2 Rational))
 -> a -> Identity a)
-> ((V2 Rational -> Identity (V2 Rational))
    -> Direction V2 Rational -> Identity (Direction V2 Rational))
-> (V2 Rational -> Identity (V2 Rational))
-> a
-> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(V2 Rational -> Identity (V2 Rational))
-> Direction V2 Rational -> Identity (Direction V2 Rational)
forall (v :: * -> *) n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p (v n) (f (v n)) -> p (Direction v n) (f (Direction v n))
_Dir ((V2 Rational -> Identity (V2 Rational)) -> a -> Identity a)
-> (V2 Rational -> V2 Rational) -> a -> a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ V2 Rational -> V2 Rational
forall n. Num n => V2 n -> V2 n
flipX_Y

instance Typeable n => HasStyle (ColourBar b n) where
  applyStyle :: Style (V (ColourBar b n)) (N (ColourBar b n))
-> ColourBar b n -> ColourBar b n
applyStyle Style (V (ColourBar b n)) (N (ColourBar b n))
sty = (Style V2 n -> Identity (Style V2 n))
-> ColourBar b n -> Identity (ColourBar b n)
(Style V2 (N (ColourBar b n))
 -> Identity (Style V2 (N (ColourBar b n))))
-> ColourBar b n -> Identity (ColourBar b n)
forall a b. HasColourBar a b => Lens' a (Style V2 (N a))
Lens' (ColourBar b n) (Style V2 (N (ColourBar b n)))
colourBarStyle ((Style V2 n -> Identity (Style V2 n))
 -> ColourBar b n -> Identity (ColourBar b n))
-> (Style V2 n -> Style V2 n) -> ColourBar b n -> ColourBar b n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Style (V (Style V2 n)) (N (Style V2 n)) -> Style V2 n -> Style V2 n
forall a. HasStyle a => Style (V a) (N a) -> a -> a
applyStyle Style (V (Style V2 n)) (N (Style V2 n))
Style (V (ColourBar b n)) (N (ColourBar b n))
sty

instance Functor f => HasMajorTicks f (ColourBar b n) where
  majorTicks :: LensLike'
  f
  (ColourBar b n)
  (MajorTicks (V (ColourBar b n)) (N (ColourBar b n)))
majorTicks = (ColourBar b n -> MajorTicks V2 n)
-> (ColourBar b n -> MajorTicks V2 n -> ColourBar b n)
-> Lens
     (ColourBar b n) (ColourBar b n) (MajorTicks V2 n) (MajorTicks V2 n)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ColourBar b n -> MajorTicks V2 n
forall b n. ColourBar b n -> MajorTicks V2 n
cbTicks (\ColourBar b n
c MajorTicks V2 n
a -> ColourBar b n
c {cbTicks = a})

instance Functor f => HasMinorTicks f (ColourBar b n) where
  minorTicks :: LensLike'
  f
  (ColourBar b n)
  (MinorTicks (V (ColourBar b n)) (N (ColourBar b n)))
minorTicks = (ColourBar b n -> MinorTicks V2 n)
-> (ColourBar b n -> MinorTicks V2 n -> ColourBar b n)
-> Lens
     (ColourBar b n) (ColourBar b n) (MinorTicks V2 n) (MinorTicks V2 n)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ColourBar b n -> MinorTicks V2 n
forall b n. ColourBar b n -> MinorTicks V2 n
cbMinorTicks (\ColourBar b n
c MinorTicks V2 n
a -> ColourBar b n
c {cbMinorTicks = a})

instance Functor f => HasMajorGridLines f (ColourBar b n) where
  majorGridLines :: LensLike'
  f
  (ColourBar b n)
  (MajorGridLines (V (ColourBar b n)) (N (ColourBar b n)))
majorGridLines = (ColourBar b n -> MajorGridLines V2 n)
-> (ColourBar b n -> MajorGridLines V2 n -> ColourBar b n)
-> Lens
     (ColourBar b n)
     (ColourBar b n)
     (MajorGridLines V2 n)
     (MajorGridLines V2 n)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ColourBar b n -> MajorGridLines V2 n
forall b n. ColourBar b n -> MajorGridLines V2 n
cbGridLines (\ColourBar b n
c MajorGridLines V2 n
a -> ColourBar b n
c {cbGridLines = a})

instance Functor f => HasTickLabels f (ColourBar b n) b where
  tickLabel :: LensLike'
  f
  (ColourBar b n)
  (TickLabels b (V (ColourBar b n)) (N (ColourBar b n)))
tickLabel = (ColourBar b n -> TickLabels b V2 n)
-> (ColourBar b n -> TickLabels b V2 n -> ColourBar b n)
-> Lens
     (ColourBar b n)
     (ColourBar b n)
     (TickLabels b V2 n)
     (TickLabels b V2 n)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ColourBar b n -> TickLabels b V2 n
forall b n. ColourBar b n -> TickLabels b V2 n
cbTickLabels (\ColourBar b n
c TickLabels b V2 n
a -> ColourBar b n
c {cbTickLabels = a})

instance HasVisibility (ColourBar b n) where
  visible :: Lens' (ColourBar b n) Bool
visible = (ColourBar b n -> Bool)
-> (ColourBar b n -> Bool -> ColourBar b n)
-> Lens' (ColourBar b n) Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ColourBar b n -> Bool
forall b n. ColourBar b n -> Bool
cbVisible (\ColourBar b n
c Bool
a -> ColourBar b n
c {cbVisible = a})

-- | Add a colour bar to an object, using the bounding box for the object.
addColourBar
  :: (TypeableFloat n, Renderable (Path V2 n) b)
  => BoundingBox V2 n -- ^ bounding box to place against
  -> ColourBar b n --
  -> ColourMap
  -> (n,n)
  -> QDiagram b V2 n Any
addColourBar :: forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
BoundingBox V2 n
-> ColourBar b n -> ColourMap -> (n, n) -> QDiagram b V2 n Any
addColourBar BoundingBox V2 n
bb cbo :: ColourBar b n
cbo@ColourBar {n
Bool
Style V2 n
Placement
TickLabels b V2 n
MajorGridLines V2 n
MinorTicks V2 n
MajorTicks V2 n
n -> n
ColourMap -> QDiagram b V2 n Any
cbPlacement :: forall b n. ColourBar b n -> Placement
cbVisible :: forall b n. ColourBar b n -> Bool
cbTicks :: forall b n. ColourBar b n -> MajorTicks V2 n
cbMinorTicks :: forall b n. ColourBar b n -> MinorTicks V2 n
cbGridLines :: forall b n. ColourBar b n -> MajorGridLines V2 n
cbTickLabels :: forall b n. ColourBar b n -> TickLabels b V2 n
cbDraw :: forall b n. ColourBar b n -> ColourMap -> QDiagram b V2 n Any
cbWidth :: forall b n. ColourBar b n -> n
cbLengthFun :: forall b n. ColourBar b n -> n -> n
cbGap :: forall b n. ColourBar b n -> n
cbStyle :: forall b n. ColourBar b n -> Style V2 n
cbPlacement :: Placement
cbVisible :: Bool
cbTicks :: MajorTicks V2 n
cbMinorTicks :: MinorTicks V2 n
cbGridLines :: MajorGridLines V2 n
cbTickLabels :: TickLabels b V2 n
cbDraw :: ColourMap -> QDiagram b V2 n Any
cbWidth :: n
cbLengthFun :: n -> n
cbGap :: n
cbStyle :: Style V2 n
..} ColourMap
cm (n, n)
bnds
  | Bool
cbVisible = BoundingBox V2 n
-> Placement -> n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall n a b.
(InSpace V2 n a, SameSpace a b, Enveloped a, HasOrigin b,
 Alignable b) =>
a -> Placement -> n -> b -> b
placeAgainst BoundingBox V2 n
bb Placement
cbPlacement n
cbGap QDiagram b V2 n Any
cb
  | Bool
otherwise = QDiagram b V2 n Any
forall a. Monoid a => a
mempty
  where
    cb :: QDiagram b V2 n Any
cb       = ColourBar b n -> ColourMap -> (n, n) -> n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
ColourBar b n -> ColourMap -> (n, n) -> n -> QDiagram b V2 n Any
renderColourBar ColourBar b n
cbo ColourMap
cm (n, n)
bnds n
l
    -- the length used for the rendered colour bar
    l :: n
l = n -> n
cbLengthFun n
bbl
    -- the length of the side of the bounding box the colour bar will be
    -- against
    bbl :: n
bbl = ColourBar b n -> n -> n -> n
forall o a. HasOrientation o => o -> a -> a -> a
orient ColourBar b n
cbo n
bx n
by
    V2 n
bx n
by = BoundingBox V2 n -> V2 n
forall (v :: * -> *) n.
(Additive v, Num n) =>
BoundingBox v n -> v n
boxExtents BoundingBox V2 n
bb

-- | Render a colour bar by it's self at a given width. Note this
--   ignores 'colourBarGap' and 'colourBarLengthFunction'.
renderColourBar
  :: (TypeableFloat n, Renderable (Path V2 n) b)
  => ColourBar b n -- ^ options for colour bar
  -> ColourMap     -- ^ map to use
  -> (n,n)         -- ^ bounds of the values on the colour bar
  -> n             -- ^ length of the colour bar
  -> QDiagram b V2 n Any
renderColourBar :: forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
ColourBar b n -> ColourMap -> (n, n) -> n -> QDiagram b V2 n Any
renderColourBar cb :: ColourBar b n
cb@ColourBar {n
Bool
Style V2 n
Placement
TickLabels b V2 n
MajorGridLines V2 n
MinorTicks V2 n
MajorTicks V2 n
n -> n
ColourMap -> QDiagram b V2 n Any
cbPlacement :: forall b n. ColourBar b n -> Placement
cbVisible :: forall b n. ColourBar b n -> Bool
cbTicks :: forall b n. ColourBar b n -> MajorTicks V2 n
cbMinorTicks :: forall b n. ColourBar b n -> MinorTicks V2 n
cbGridLines :: forall b n. ColourBar b n -> MajorGridLines V2 n
cbTickLabels :: forall b n. ColourBar b n -> TickLabels b V2 n
cbDraw :: forall b n. ColourBar b n -> ColourMap -> QDiagram b V2 n Any
cbWidth :: forall b n. ColourBar b n -> n
cbLengthFun :: forall b n. ColourBar b n -> n -> n
cbGap :: forall b n. ColourBar b n -> n
cbStyle :: forall b n. ColourBar b n -> Style V2 n
cbPlacement :: Placement
cbVisible :: Bool
cbTicks :: MajorTicks V2 n
cbMinorTicks :: MinorTicks V2 n
cbGridLines :: MajorGridLines V2 n
cbTickLabels :: TickLabels b V2 n
cbDraw :: ColourMap -> QDiagram b V2 n Any
cbWidth :: n
cbLengthFun :: n -> n
cbGap :: n
cbStyle :: Style V2 n
..} ColourMap
cm bnds :: (n, n)
bnds@(n
lb,n
ub) n
l
  | Bool
cbVisible = QDiagram b V2 n Any
bar QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
-> QDiagram b V2 n Any
forall a. a -> a -> a
xy QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a. a -> a
id QDiagram b V2 n Any -> QDiagram b V2 n Any
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY
                    # o id (reflectY . _reflectX_Y)

             QDiagram b V2 n Any -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a. Semigroup a => a -> a -> a
<> QDiagram b V2 n Any
tLbs
  | Bool
otherwise = QDiagram b V2 n Any
forall a. Monoid a => a
mempty

  where
  -- These functions deal with the different cases for the position of
  -- the colour bar so that the ticks and labels are on the outside of
  -- the axis and the bar horizontal/vertical depending on which side
  -- the bar is on.
  o, xy :: a -> a -> a
  o :: forall a. a -> a -> a
o      = ColourBar b n -> a -> a -> a
forall o a. HasOrientation o => o -> a -> a -> a
orient ColourBar b n
cb
  xy :: forall a. a -> a -> a
xy a
a a
b = if let V2 Rational
x Rational
y = ColourBar b n
cbColourBar b n
-> Getting (V2 Rational) (ColourBar b n) (V2 Rational)
-> V2 Rational
forall s a. s -> Getting a s a -> a
^.Getting (V2 Rational) (ColourBar b n) (V2 Rational)
forall a. HasPlacement a => Lens' a (V2 Rational)
Lens' (ColourBar b n) (V2 Rational)
placementAt in Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
y
             then a
a else a
b

  w :: n
w   = n
cbWidth
  -- move a value on the colour bar such that
  --   f lb = -l/2
  --   f ub =  l/2
  -- so it ligns up with the colour bar
  f :: n -> n
f n
x = (n
x n -> n -> n
forall a. Num a => a -> a -> a
- (n
ub n -> n -> n
forall a. Num a => a -> a -> a
+ n
lb)n -> n -> n
forall a. Fractional a => a -> a -> a
/n
2) n -> n -> n
forall a. Fractional a => a -> a -> a
/ (n
ub n -> n -> n
forall a. Num a => a -> a -> a
- n
lb) n -> n -> n
forall a. Num a => a -> a -> a
* n
l
  inRange :: n -> Bool
inRange n
x = n
x n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>= n
lb Bool -> Bool -> Bool
&& n
x n -> n -> Bool
forall a. Ord a => a -> a -> Bool
<= n
ub

  bar :: QDiagram b V2 n Any
bar = QDiagram b V2 n Any
outline QDiagram b V2 n Any -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a. Semigroup a => a -> a -> a
<> QDiagram b V2 n Any
tks QDiagram b V2 n Any -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a. Semigroup a => a -> a -> a
<> QDiagram b V2 n Any
minorTks QDiagram b V2 n Any -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a. Semigroup a => a -> a -> a
<> QDiagram b V2 n Any
gLines QDiagram b V2 n Any -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a. Semigroup a => a -> a -> a
<> QDiagram b V2 n Any
colours

  -- the outline
  outline :: QDiagram b V2 n Any
outline = n -> n -> QDiagram b V2 n Any
forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect n
l n
w QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Style (V (QDiagram b V2 n Any)) (N (QDiagram b V2 n Any))
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a. HasStyle a => Style (V a) (N a) -> a -> a
applyStyle (Style V2 n
cbStyle Style V2 n -> (Style V2 n -> Style V2 n) -> Style V2 n
forall a b. a -> (a -> b) -> b
& (Texture n -> Identity (Texture n))
-> Style V2 n -> Identity (Style V2 n)
forall n.
(Typeable n, Floating n) =>
Lens' (Style V2 n) (Texture n)
Lens' (Style V2 n) (Texture n)
_fillTexture ((Texture n -> Identity (Texture n))
 -> Style V2 n -> Identity (Style V2 n))
-> Texture n -> Style V2 n -> Style V2 n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Tagged (AlphaColour Double) (Identity (AlphaColour Double))
-> Tagged (Texture n) (Identity (Texture n))
forall n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (AlphaColour Double) (f (AlphaColour Double))
-> p (Texture n) (f (Texture n))
_AC (Tagged (AlphaColour Double) (Identity (AlphaColour Double))
 -> Tagged (Texture n) (Identity (Texture n)))
-> AlphaColour Double -> Texture n
forall t b. AReview t b -> b -> t
## AlphaColour Double
forall a. Num a => AlphaColour a
transparent)

  -- displaying the colour map
  colours :: QDiagram b V2 n Any
colours = ColourMap -> QDiagram b V2 n Any
cbDraw ColourMap
cm QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# QDiagram b V2 n Any -> QDiagram b V2 n Any
forall (v :: * -> *) n a.
(InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a) =>
a -> a
centerXY QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleX n
l QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY n
w

  -- the ticks
  tickXs :: [n]
tickXs  = Getting ((n, n) -> [n]) (MajorTicks V2 n) ((n, n) -> [n])
-> MajorTicks V2 n -> (n, n) -> [n]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ((n, n) -> [n]) (MajorTicks V2 n) ((n, n) -> [n])
LensLike'
  (Const ((n, n) -> [n]))
  (MajorTicks V2 n)
  ((N (MajorTicks V2 n), N (MajorTicks V2 n))
   -> [N (MajorTicks V2 n)])
forall (f :: * -> *) a.
(HasMajorTicks f a, Functor f) =>
LensLike' f a ((N a, N a) -> [N a])
majorTicksFunction MajorTicks V2 n
cbTicks (n, n)
bnds
  tickXs' :: [n]
tickXs' = (n -> Bool) -> [n] -> [n]
forall a. (a -> Bool) -> [a] -> [a]
filter n -> Bool
inRange [n]
tickXs
  tks :: QDiagram b V2 n Any
tks
    | MajorTicks V2 n
cbTicks MajorTicks V2 n -> Getting Bool (MajorTicks V2 n) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (MajorTicks V2 n) Bool
forall a. HasVisibility a => Lens' a Bool
Lens' (MajorTicks V2 n) Bool
hidden = QDiagram b V2 n Any
forall a. Monoid a => a
mempty
    | Bool
otherwise = (n -> QDiagram b V2 n Any) -> [n] -> QDiagram b V2 n Any
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (\n
x -> QDiagram b V2 n Any
aTick QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Vn (QDiagram b V2 n Any)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall t. Transformable t => Vn t -> t -> t
translate (n -> n -> V2 n
forall a. a -> a -> V2 a
V2 (n -> n
f n
x) (-n
wn -> n -> n
forall a. Fractional a => a -> a -> a
/n
2))) [n]
tickXs'
                    # applyStyle (cbTicks ^. majorTicksStyle)
  aTick :: QDiagram b V2 n Any
aTick = TicksAlignment -> N (QDiagram b V2 n Any) -> QDiagram b V2 n Any
forall {t}. (V t ~ V2, TrailLike t) => TicksAlignment -> N t -> t
someTick (MajorTicks V2 n
cbTicks MajorTicks V2 n
-> Getting TicksAlignment (MajorTicks V2 n) TicksAlignment
-> TicksAlignment
forall s a. s -> Getting a s a -> a
^. Getting TicksAlignment (MajorTicks V2 n) TicksAlignment
forall (f :: * -> *) a.
(HasMajorTicks f a, Functor f) =>
LensLike' f a TicksAlignment
majorTicksAlignment) (MajorTicks V2 n
cbTicks MajorTicks V2 n -> Getting n (MajorTicks V2 n) n -> n
forall s a. s -> Getting a s a -> a
^. Getting n (MajorTicks V2 n) n
LensLike' (Const n) (MajorTicks V2 n) (N (MajorTicks V2 n))
forall (f :: * -> *) a.
(HasMajorTicks f a, Functor f) =>
LensLike' f a (N a)
majorTicksLength)

  minorTickXs :: [n]
minorTickXs  = Getting
  ([n] -> (n, n) -> [n]) (MinorTicks V2 n) ([n] -> (n, n) -> [n])
-> MinorTicks V2 n -> [n] -> (n, n) -> [n]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  ([n] -> (n, n) -> [n]) (MinorTicks V2 n) ([n] -> (n, n) -> [n])
LensLike'
  (Const ([n] -> (n, n) -> [n]))
  (MinorTicks V2 n)
  ([N (MinorTicks V2 n)]
   -> (N (MinorTicks V2 n), N (MinorTicks V2 n))
   -> [N (MinorTicks V2 n)])
forall (f :: * -> *) a.
(HasMinorTicks f a, Functor f) =>
LensLike' f a ([N a] -> (N a, N a) -> [N a])
minorTicksFunction MinorTicks V2 n
cbMinorTicks [n]
tickXs (n, n)
bnds
  minorTickXs' :: [n]
minorTickXs' = (n -> Bool) -> [n] -> [n]
forall a. (a -> Bool) -> [a] -> [a]
filter n -> Bool
inRange [n]
minorTickXs
  minorTks :: QDiagram b V2 n Any
minorTks
    | MinorTicks V2 n
cbMinorTicks MinorTicks V2 n -> Getting Bool (MinorTicks V2 n) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (MinorTicks V2 n) Bool
forall a. HasVisibility a => Lens' a Bool
Lens' (MinorTicks V2 n) Bool
hidden = QDiagram b V2 n Any
forall a. Monoid a => a
mempty
    | Bool
otherwise = (n -> QDiagram b V2 n Any) -> [n] -> QDiagram b V2 n Any
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (\n
x -> QDiagram b V2 n Any
aMinorTick QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Vn (QDiagram b V2 n Any)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall t. Transformable t => Vn t -> t -> t
translate (n -> n -> V2 n
forall a. a -> a -> V2 a
V2 (n -> n
f n
x) (-n
wn -> n -> n
forall a. Fractional a => a -> a -> a
/n
2))) [n]
minorTickXs'
                    # applyStyle (cbMinorTicks ^. minorTicksStyle)
  aMinorTick :: QDiagram b V2 n Any
aMinorTick = TicksAlignment -> N (QDiagram b V2 n Any) -> QDiagram b V2 n Any
forall {t}. (V t ~ V2, TrailLike t) => TicksAlignment -> N t -> t
someTick (MajorTicks V2 n
cbTicks MajorTicks V2 n
-> Getting TicksAlignment (MajorTicks V2 n) TicksAlignment
-> TicksAlignment
forall s a. s -> Getting a s a -> a
^. Getting TicksAlignment (MajorTicks V2 n) TicksAlignment
forall (f :: * -> *) a.
(HasMajorTicks f a, Functor f) =>
LensLike' f a TicksAlignment
majorTicksAlignment) (MajorTicks V2 n
cbTicks MajorTicks V2 n -> Getting n (MajorTicks V2 n) n -> n
forall s a. s -> Getting a s a -> a
^. Getting n (MajorTicks V2 n) n
LensLike' (Const n) (MajorTicks V2 n) (N (MajorTicks V2 n))
forall (f :: * -> *) a.
(HasMajorTicks f a, Functor f) =>
LensLike' f a (N a)
majorTicksLength)

  someTick :: TicksAlignment -> N t -> t
someTick TicksAlignment
tType N t
d = case TicksAlignment
tType of
    TickSpec (Rational -> N t
forall a. Fractional a => Rational -> a
fromRational -> N t
aa) (Rational -> N t
forall a. Fractional a => Rational -> a
fromRational -> N t
bb)
             -> N t -> N t -> P2 (N t)
forall n. n -> n -> P2 n
mkP2 N t
0 (-N t
dN t -> N t -> N t
forall a. Num a => a -> a -> a
*N t
bb) P2 (N t) -> P2 (N t) -> t
forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t) =>
Point v n -> Point v n -> t
~~ N t -> N t -> P2 (N t)
forall n. n -> n -> P2 n
mkP2 N t
0 (N t
dN t -> N t -> N t
forall a. Num a => a -> a -> a
*N t
aa)
    TicksAlignment
AutoTick -> N t -> N t -> P2 (N t)
forall n. n -> n -> P2 n
mkP2 N t
0 (-N t
d)    P2 (N t) -> P2 (N t) -> t
forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t) =>
Point v n -> Point v n -> t
~~ N t -> N t -> P2 (N t)
forall n. n -> n -> P2 n
mkP2 N t
0 N t
d

  -- grid lines
  gridXs :: [n]
gridXs = (n -> Bool) -> [n] -> [n]
forall a. (a -> Bool) -> [a] -> [a]
filter n -> Bool
inRange ([n] -> [n]) -> [n] -> [n]
forall a b. (a -> b) -> a -> b
$ Getting
  ([n] -> (n, n) -> [n]) (MajorGridLines V2 n) ([n] -> (n, n) -> [n])
-> MajorGridLines V2 n -> [n] -> (n, n) -> [n]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  ([n] -> (n, n) -> [n]) (MajorGridLines V2 n) ([n] -> (n, n) -> [n])
LensLike'
  (Const ([n] -> (n, n) -> [n]))
  (MajorGridLines V2 n)
  (GridLineFunction (N (MajorGridLines V2 n)))
forall (f :: * -> *) a.
(HasMajorGridLines f a, Functor f) =>
LensLike' f a (GridLineFunction (N a))
majorGridLinesFunction MajorGridLines V2 n
cbGridLines [n]
tickXs (n, n)
bnds
  gLines :: QDiagram b V2 n Any
gLines
    | MajorGridLines V2 n
cbGridLines MajorGridLines V2 n
-> Getting Bool (MajorGridLines V2 n) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (MajorGridLines V2 n) Bool
forall a. HasVisibility a => Lens' a Bool
Lens' (MajorGridLines V2 n) Bool
hidden = QDiagram b V2 n Any
forall a. Monoid a => a
mempty
    | Bool
otherwise             = (n -> Path V2 n) -> [n] -> Path V2 n
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap n -> Path V2 n
mkGridLine [n]
gridXs
                                # strokePath
                                # applyStyle (cbGridLines ^. majorGridLinesStyle)
  mkGridLine :: n -> Path V2 n
mkGridLine n
x = n -> n -> P2 n
forall n. n -> n -> P2 n
mkP2 (n -> n
f n
x) (-n
wn -> n -> n
forall a. Fractional a => a -> a -> a
/n
2) P2 n -> P2 n -> Path V2 n
forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t) =>
Point v n -> Point v n -> t
~~ n -> n -> P2 n
forall n. n -> n -> P2 n
mkP2 (n -> n
f n
x) (n
wn -> n -> n
forall a. Fractional a => a -> a -> a
/n
2)

  -- tick labels
  tickLabelXs :: [(n, [Char])]
tickLabelXs = Getting
  ([n] -> (n, n) -> [(n, [Char])])
  (TickLabels b V2 n)
  ([n] -> (n, n) -> [(n, [Char])])
-> TickLabels b V2 n -> [n] -> (n, n) -> [(n, [Char])]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  ([n] -> (n, n) -> [(n, [Char])])
  (TickLabels b V2 n)
  ([n] -> (n, n) -> [(n, [Char])])
LensLike'
  (Const ([n] -> (n, n) -> [(n, [Char])]))
  (TickLabels b V2 n)
  ([N (TickLabels b V2 n)]
   -> (N (TickLabels b V2 n), N (TickLabels b V2 n))
   -> [(N (TickLabels b V2 n), [Char])])
forall (f :: * -> *) a b.
(HasTickLabels f a b, Functor f) =>
LensLike' f a ([N a] -> (N a, N a) -> [(N a, [Char])])
tickLabelFunction TickLabels b V2 n
cbTickLabels [n]
tickXs' (n, n)
bnds
  tLbs :: QDiagram b V2 n Any
tLbs
    | TickLabels b V2 n
cbTickLabels TickLabels b V2 n -> Getting Bool (TickLabels b V2 n) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (TickLabels b V2 n) Bool
forall a. HasVisibility a => Lens' a Bool
Lens' (TickLabels b V2 n) Bool
hidden = QDiagram b V2 n Any
forall a. Monoid a => a
mempty
    | Bool
otherwise              = ((n, [Char]) -> QDiagram b V2 n Any)
-> [(n, [Char])] -> QDiagram b V2 n Any
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (n, [Char]) -> QDiagram b V2 n Any
drawTickLabel [(n, [Char])]
tickLabelXs
  drawTickLabel :: (n, [Char]) -> QDiagram b V2 n Any
drawTickLabel (n
x,[Char]
label) =
    Getting
  (TextAlignment n -> [Char] -> QDiagram b V2 n Any)
  (TickLabels b V2 n)
  (TextAlignment n -> [Char] -> QDiagram b V2 n Any)
-> TickLabels b V2 n
-> TextAlignment n
-> [Char]
-> QDiagram b V2 n Any
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (TextAlignment n -> [Char] -> QDiagram b V2 n Any)
  (TickLabels b V2 n)
  (TextAlignment n -> [Char] -> QDiagram b V2 n Any)
LensLike'
  (Const (TextAlignment n -> [Char] -> QDiagram b V2 n Any))
  (TickLabels b V2 n)
  (TextFunction b (V (TickLabels b V2 n)) (N (TickLabels b V2 n)))
forall (f :: * -> *) a b.
(HasTickLabels f a b, Functor f) =>
LensLike' f a (TextFunction b (V a) (N a))
tickLabelTextFunction TickLabels b V2 n
cbTickLabels TextAlignment n
tAlign [Char]
label
      # translate v
      # applyStyle (cbTickLabels ^. tickLabelStyle)
        where v :: V2 n
v = n -> n -> V2 n
forall a. a -> a -> V2 a
V2 (n -> n
f n
x) (- n
wn -> n -> n
forall a. Fractional a => a -> a -> a
/n
2 n -> n -> n
forall a. Num a => a -> a -> a
- Getting n (TickLabels b V2 n) n -> TickLabels b V2 n -> n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting n (TickLabels b V2 n) n
LensLike' (Const n) (TickLabels b V2 n) (N (TickLabels b V2 n))
forall (f :: * -> *) a b.
(HasTickLabels f a b, Functor f) =>
LensLike' f a (N a)
tickLabelGap TickLabels b V2 n
cbTickLabels)
                    # xy id (_y %~ negate)
                    # o id ((_y %~ negate) . flipX_Y)

  tAlign :: TextAlignment n
tAlign = TextAlignment n -> TextAlignment n -> TextAlignment n
forall a. a -> a -> a
o (TextAlignment n -> TextAlignment n -> TextAlignment n
forall a. a -> a -> a
xy (n -> n -> TextAlignment n
forall n. n -> n -> TextAlignment n
BoxAlignedText n
0.5 n
1) (n -> n -> TextAlignment n
forall n. n -> n -> TextAlignment n
BoxAlignedText n
0.5 n
0))
             (TextAlignment n -> TextAlignment n -> TextAlignment n
forall a. a -> a -> a
xy (n -> n -> TextAlignment n
forall n. n -> n -> TextAlignment n
BoxAlignedText n
0 n
0.5) (n -> n -> TextAlignment n
forall n. n -> n -> TextAlignment n
BoxAlignedText n
1 n
0.5))

-- > import Plots
-- > gradientColourBarExample = gradientColourBar viridis # scaleX 20
-- > pathColourBarExample = pathColourBar 10 viridis # scaleX 20

-- | The colour bar generated by a gradient texture. The final diagram
--   is 1 by 1, with origin at the middle of the left side. This can be
--   used as the 'colourBarDraw' function.
--
--   This may not be supported by all backends.
--
--   <<diagrams/src_Plots_Axis_ColourBar_gradientColourBarExample.svg#diagram=gradientColourBarExample&width=600>>
gradientColourBar :: (TypeableFloat n, Renderable (Path V2 n) b) => ColourMap -> QDiagram b V2 n Any
gradientColourBar :: forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
ColourMap -> QDiagram b V2 n Any
gradientColourBar ColourMap
cm =
  n -> n -> QDiagram b V2 n Any
forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect n
1 n
1
    # fillTexture grad
    # lw none
  where
    stops :: [GradientStop n]
stops = ((Rational, Colour Double) -> GradientStop n)
-> [(Rational, Colour Double)] -> [GradientStop n]
forall a b. (a -> b) -> [a] -> [b]
map (\(Rational
x,Colour Double
c) -> SomeColor -> n -> GradientStop n
forall d. SomeColor -> d -> GradientStop d
GradientStop (Colour Double -> SomeColor
forall c. Color c => c -> SomeColor
SomeColor Colour Double
c) (Rational -> n
forall a. Fractional a => Rational -> a
fromRational Rational
x)) (ColourMap -> [(Rational, Colour Double)]
colourList ColourMap
cm)
    grad :: Texture n
grad  = Texture n
forall n. Fractional n => Texture n
defaultLG Texture n -> (Texture n -> Texture n) -> Texture n
forall a b. a -> (a -> b) -> b
& (LGradient n -> Identity (LGradient n))
-> Texture n -> Identity (Texture n)
forall n (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (LGradient n) (f (LGradient n)) -> p (Texture n) (f (Texture n))
_LG ((LGradient n -> Identity (LGradient n))
 -> Texture n -> Identity (Texture n))
-> (([GradientStop n] -> Identity [GradientStop n])
    -> LGradient n -> Identity (LGradient n))
-> ([GradientStop n] -> Identity [GradientStop n])
-> Texture n
-> Identity (Texture n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([GradientStop n] -> Identity [GradientStop n])
-> LGradient n -> Identity (LGradient n)
forall n (f :: * -> *).
Functor f =>
([GradientStop n] -> f [GradientStop n])
-> LGradient n -> f (LGradient n)
lGradStops (([GradientStop n] -> Identity [GradientStop n])
 -> Texture n -> Identity (Texture n))
-> [GradientStop n] -> Texture n -> Texture n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [GradientStop n]
stops

-- | Construct a colour bar made up of @n@ solid square paths. The final
--   diagram is 1 by 1, with origin at the middle of the left side. This
--   can be used as the 'colourBarDraw' function.
--
--   <<diagrams/src_Plots_Axis_ColourBar_pathColourBarExample.svg#diagram=pathColourBarExample&width=600>>
pathColourBar :: (TypeableFloat n, Renderable (Path V2 n) b)
              => Int -> ColourMap -> QDiagram b V2 n Any
pathColourBar :: forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Int -> ColourMap -> QDiagram b V2 n Any
pathColourBar Int
n ColourMap
cm = (Int -> Rational -> QDiagram b V2 n Any)
-> [Rational] -> QDiagram b V2 n Any
forall m a. Monoid m => (Int -> a -> m) -> [a] -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap Int -> Rational -> QDiagram b V2 n Any
mkR [Rational]
xs
  where
    mkR :: Int -> Rational -> QDiagram b V2 n Any
mkR Int
i Rational
x = n -> n -> QDiagram b V2 n Any
forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect n
d' n
1
                # alignR
                # fc (cm ^. ixColourR (x - 1/(2*fromIntegral n)))
                # translateX (fromRational x)
                # lw none
      where
        -- Some vector viewers don't render touching blocks of colour
        -- correctly. To solve this we overlap by half a bar length for
        -- all except the first bar (which is the one on top).
        d' :: n
d' | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = n
d
           | Bool
otherwise  = n
dn -> n -> n
forall a. Num a => a -> a -> a
*n
1.5

    xs :: [Rational]
xs = [Rational] -> [Rational]
forall a. HasCallStack => [a] -> [a]
tail (Rational -> Rational -> Int -> [Rational]
forall n. Fractional n => n -> n -> Int -> [n]
enumFromToN Rational
0 Rational
1 Int
n)
    d :: n
d  = n
1 n -> n -> n
forall a. Fractional a => a -> a -> a
/ Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n

flipX_Y :: Num n => V2 n -> V2 n
flipX_Y :: forall n. Num n => V2 n -> V2 n
flipX_Y (V2 n
x n
y) = n -> n -> V2 n
forall a. a -> a -> V2 a
V2 (-n
y) (-n
x)

_reflectionX_Y :: (Additive v, R2 v, Num n) => Transformation v n
_reflectionX_Y :: forall (v :: * -> *) n.
(Additive v, R2 v, Num n) =>
Transformation v n
_reflectionX_Y = (v n :-: v n) -> Transformation v n
forall (v :: * -> *) n.
(Additive v, Num n) =>
(v n :-: v n) -> Transformation v n
fromSymmetric ((v n :-: v n) -> Transformation v n)
-> (v n :-: v n) -> Transformation v n
forall a b. (a -> b) -> a -> b
$ ((V2 n -> Identity (V2 n)) -> v n -> Identity (v n)
forall a. Lens' (v a) (V2 a)
forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy ((V2 n -> Identity (V2 n)) -> v n -> Identity (v n))
-> (V2 n -> V2 n) -> v n -> v n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ V2 n -> V2 n
forall n. Num n => V2 n -> V2 n
flipX_Y) (v n -> v n) -> (v n -> v n) -> v n :-: v n
forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> ((V2 n -> Identity (V2 n)) -> v n -> Identity (v n)
forall a. Lens' (v a) (V2 a)
forall (t :: * -> *) a. R2 t => Lens' (t a) (V2 a)
_xy ((V2 n -> Identity (V2 n)) -> v n -> Identity (v n))
-> (V2 n -> V2 n) -> v n -> v n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ V2 n -> V2 n
forall n. Num n => V2 n -> V2 n
flipX_Y)

_reflectX_Y :: (InSpace v n t, R2 v, Transformable t) => t -> t
_reflectX_Y :: forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
_reflectX_Y = Transformation (V t) (N t) -> t -> t
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation v n
Transformation (V t) (N t)
forall (v :: * -> *) n.
(Additive v, R2 v, Num n) =>
Transformation v n
_reflectionX_Y