{-# LANGUAGE DeriveDataTypeable     #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE TypeFamilies           #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Plots.Axis.Title
-- Copyright   :  (C) 2016 Christopher Chalmers
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Christopher Chalmers
-- Stability   :  experimental
-- Portability :  non-portable
--
-- The title used for a plot.
--
----------------------------------------------------------------------------
module Plots.Axis.Title
  ( Title
  , HasTitle (..)
  , drawTitle
  ) where

import Data.Default
import Data.Typeable

import Diagrams.Prelude
import Diagrams.TwoD.Text
import Plots.Types

data Title b v n = Title
  { forall b (v :: * -> *) n. Title b v n -> Bool
tVisible   :: Bool
  , forall b (v :: * -> *) n. Title b v n -> String
tTxt       :: String
  , forall b (v :: * -> *) n.
Title b v n -> TextAlignment n -> String -> QDiagram b v n Any
tTxtFun    :: TextAlignment n -> String -> QDiagram b v n Any
  , forall b (v :: * -> *) n. Title b v n -> Style v n
tStyle     :: Style v n
  , forall b (v :: * -> *) n. Title b v n -> Placement
tPlacement :: Placement
  , forall b (v :: * -> *) n. Title b v n -> TextAlignment n
tAlignment :: TextAlignment n
  , forall b (v :: * -> *) n. Title b v n -> n
tGap       :: n
  } deriving Typeable

instance (Renderable (Text n) b, TypeableFloat n)
  => Default (Title b V2 n) where
  def :: Title b V2 n
def = Title
    { tVisible :: Bool
tVisible = Bool
True
    , tTxt :: String
tTxt     = String
""
    , tTxtFun :: TextAlignment n -> String -> QDiagram b V2 n Any
tTxtFun  = TextAlignment n -> String -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
TextAlignment n -> String -> QDiagram b V2 n Any
mkText
    , tStyle :: Style V2 n
tStyle   = Style V2 n
forall a. Monoid a => a
mempty Style V2 n -> (Style V2 n -> Style V2 n) -> Style V2 n
forall a b. a -> (a -> b) -> b
# Measure n -> Style V2 n -> Style V2 n
forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
fontSize (n -> Measure n
forall n. n -> Measure n
output n
11)
    , tPlacement :: Placement
tPlacement = Placement
midAbove
    , tAlignment :: TextAlignment n
tAlignment = n -> n -> TextAlignment n
forall n. n -> n -> TextAlignment n
BoxAlignedText n
0.5 n
0
    , tGap :: n
tGap = n
20
    }

type instance V (Title b v n) = v
type instance N (Title b v n) = n

instance HasVisibility (Title b v n) where
  visible :: Lens' (Title b v n) Bool
visible = (Title b v n -> Bool)
-> (Title b v n -> Bool -> Title b v n) -> Lens' (Title b v n) Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Title b v n -> Bool
forall b (v :: * -> *) n. Title b v n -> Bool
tVisible (\Title b v n
t Bool
b -> Title b v n
t {tVisible = b})

instance HasGap (Title b v n) where
  gap :: Lens' (Title b v n) (N (Title b v n))
gap = (Title b v n -> n)
-> (Title b v n -> n -> Title b v n)
-> Lens (Title b v n) (Title b v n) n n
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Title b v n -> n
forall b (v :: * -> *) n. Title b v n -> n
tGap (\Title b v n
t n
g -> Title b v n
t {tGap = g})

instance HasPlacement (Title b v n) where
  placement :: Lens' (Title b v n) Placement
placement = (Placement -> f Placement) -> Title b v n -> f (Title b v n)
forall a b. HasTitle a b => Lens' a Placement
Lens' (Title b v n) Placement
titlePlacement

class HasTitle a b | a -> b where
  title :: Lens' a (Title b (V a) (N a))

  -- | The text used for the title. If the string is empty, no title is
  --   drawn.
  --
  --   Default is @""@
  titleText :: Lens' a String
  titleText = (Title b (V a) (N a) -> f (Title b (V a) (N a))) -> a -> f a
forall a b. HasTitle a b => Lens' a (Title b (V a) (N a))
Lens' a (Title b (V a) (N a))
title ((Title b (V a) (N a) -> f (Title b (V a) (N a))) -> a -> f a)
-> ((String -> f String)
    -> Title b (V a) (N a) -> f (Title b (V a) (N a)))
-> (String -> f String)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Title b (V a) (N a) -> String)
-> (Title b (V a) (N a) -> String -> Title b (V a) (N a))
-> Lens (Title b (V a) (N a)) (Title b (V a) (N a)) String String
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Title b (V a) (N a) -> String
forall b (v :: * -> *) n. Title b v n -> String
tTxt (\Title b (V a) (N a)
t String
s -> Title b (V a) (N a)
t {tTxt = s})

  -- | The style applied to the title.
  --
  --   Default is 'mempty'.
  titleStyle :: Lens' a (Style (V a) (N a))
  titleStyle = (Title b (V a) (N a) -> f (Title b (V a) (N a))) -> a -> f a
forall a b. HasTitle a b => Lens' a (Title b (V a) (N a))
Lens' a (Title b (V a) (N a))
title ((Title b (V a) (N a) -> f (Title b (V a) (N a))) -> a -> f a)
-> ((Style (V a) (N a) -> f (Style (V a) (N a)))
    -> Title b (V a) (N a) -> f (Title b (V a) (N a)))
-> (Style (V a) (N a) -> f (Style (V a) (N a)))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Title b (V a) (N a) -> Style (V a) (N a))
-> (Title b (V a) (N a)
    -> Style (V a) (N a) -> Title b (V a) (N a))
-> Lens
     (Title b (V a) (N a))
     (Title b (V a) (N a))
     (Style (V a) (N a))
     (Style (V a) (N a))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Title b (V a) (N a) -> Style (V a) (N a)
forall b (v :: * -> *) n. Title b v n -> Style v n
tStyle (\Title b (V a) (N a)
t Style (V a) (N a)
s -> Title b (V a) (N a)
t {tStyle = s})

  -- | The placement of the title against the axis.
  --
  --   Default is 'mempty'.
  titlePlacement :: Lens' a Placement
  titlePlacement = (Title b (V a) (N a) -> f (Title b (V a) (N a))) -> a -> f a
forall a b. HasTitle a b => Lens' a (Title b (V a) (N a))
Lens' a (Title b (V a) (N a))
title ((Title b (V a) (N a) -> f (Title b (V a) (N a))) -> a -> f a)
-> ((Placement -> f Placement)
    -> Title b (V a) (N a) -> f (Title b (V a) (N a)))
-> (Placement -> f Placement)
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Title b (V a) (N a) -> Placement)
-> (Title b (V a) (N a) -> Placement -> Title b (V a) (N a))
-> Lens
     (Title b (V a) (N a)) (Title b (V a) (N a)) Placement Placement
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Title b (V a) (N a) -> Placement
forall b (v :: * -> *) n. Title b v n -> Placement
tPlacement (\Title b (V a) (N a)
t Placement
s -> Title b (V a) (N a)
t {tPlacement = s})

  -- | The function used to draw the title text.
  --
  --   Default is 'mkText'.
  titleTextFunction :: Lens' a (TextAlignment (N a) -> String -> QDiagram b (V a) (N a) Any)
  titleTextFunction = (Title b (V a) (N a) -> f (Title b (V a) (N a))) -> a -> f a
forall a b. HasTitle a b => Lens' a (Title b (V a) (N a))
Lens' a (Title b (V a) (N a))
title ((Title b (V a) (N a) -> f (Title b (V a) (N a))) -> a -> f a)
-> (((TextAlignment (N a) -> String -> QDiagram b (V a) (N a) Any)
     -> f (TextAlignment (N a) -> String -> QDiagram b (V a) (N a) Any))
    -> Title b (V a) (N a) -> f (Title b (V a) (N a)))
-> ((TextAlignment (N a) -> String -> QDiagram b (V a) (N a) Any)
    -> f (TextAlignment (N a) -> String -> QDiagram b (V a) (N a) Any))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Title b (V a) (N a)
 -> TextAlignment (N a) -> String -> QDiagram b (V a) (N a) Any)
-> (Title b (V a) (N a)
    -> (TextAlignment (N a) -> String -> QDiagram b (V a) (N a) Any)
    -> Title b (V a) (N a))
-> Lens
     (Title b (V a) (N a))
     (Title b (V a) (N a))
     (TextAlignment (N a) -> String -> QDiagram b (V a) (N a) Any)
     (TextAlignment (N a) -> String -> QDiagram b (V a) (N a) Any)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Title b (V a) (N a)
-> TextAlignment (N a) -> String -> QDiagram b (V a) (N a) Any
forall b (v :: * -> *) n.
Title b v n -> TextAlignment n -> String -> QDiagram b v n Any
tTxtFun (\Title b (V a) (N a)
t TextAlignment (N a) -> String -> QDiagram b (V a) (N a) Any
s -> Title b (V a) (N a)
t {tTxtFun = s})

  -- | The 'TextAlignment' used for the title text. This is given to the
  --   'titleTextFunction'.
  --
  --   Default is @'BoxAlignedText' 0.5 0@.
  titleAlignment :: Lens' a (TextAlignment (N a))
  titleAlignment = (Title b (V a) (N a) -> f (Title b (V a) (N a))) -> a -> f a
forall a b. HasTitle a b => Lens' a (Title b (V a) (N a))
Lens' a (Title b (V a) (N a))
title ((Title b (V a) (N a) -> f (Title b (V a) (N a))) -> a -> f a)
-> ((TextAlignment (N a) -> f (TextAlignment (N a)))
    -> Title b (V a) (N a) -> f (Title b (V a) (N a)))
-> (TextAlignment (N a) -> f (TextAlignment (N a)))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Title b (V a) (N a) -> TextAlignment (N a))
-> (Title b (V a) (N a)
    -> TextAlignment (N a) -> Title b (V a) (N a))
-> Lens
     (Title b (V a) (N a))
     (Title b (V a) (N a))
     (TextAlignment (N a))
     (TextAlignment (N a))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Title b (V a) (N a) -> TextAlignment (N a)
forall b (v :: * -> *) n. Title b v n -> TextAlignment n
tAlignment (\Title b (V a) (N a)
t TextAlignment (N a)
s -> Title b (V a) (N a)
t {tAlignment = s})

  -- | The gap between the axis and the title.
  --
  --   Default is 'mempty'.
  titleGap :: Lens' a (N a)
  titleGap = (Title b (V a) (N a) -> f (Title b (V a) (N a))) -> a -> f a
forall a b. HasTitle a b => Lens' a (Title b (V a) (N a))
Lens' a (Title b (V a) (N a))
title ((Title b (V a) (N a) -> f (Title b (V a) (N a))) -> a -> f a)
-> ((N a -> f (N a))
    -> Title b (V a) (N a) -> f (Title b (V a) (N a)))
-> (N a -> f (N a))
-> a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Title b (V a) (N a) -> N a)
-> (Title b (V a) (N a) -> N a -> Title b (V a) (N a))
-> Lens (Title b (V a) (N a)) (Title b (V a) (N a)) (N a) (N a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Title b (V a) (N a) -> N a
forall b (v :: * -> *) n. Title b v n -> n
tGap (\Title b (V a) (N a)
t N a
s -> Title b (V a) (N a)
t {tGap = s})

instance HasTitle (Title b v n) b where
  title :: Lens' (Title b v n) (Title b (V (Title b v n)) (N (Title b v n)))
title = (Title b v n -> f (Title b v n)) -> Title b v n -> f (Title b v n)
(Title b (V (Title b v n)) (N (Title b v n))
 -> f (Title b (V (Title b v n)) (N (Title b v n))))
-> Title b v n -> f (Title b v n)
forall a. a -> a
id

-- | Render the title and place it around the bounding box.
drawTitle
  :: TypeableFloat n
  => BoundingBox V2 n
  -> Title b V2 n
  -> QDiagram b V2 n Any
drawTitle :: forall n b.
TypeableFloat n =>
BoundingBox V2 n -> Title b V2 n -> QDiagram b V2 n Any
drawTitle BoundingBox V2 n
bb Title b V2 n
t
  | Title b V2 n
t Title b V2 n -> Getting Bool (Title b V2 n) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (Title b V2 n) Bool
forall a. HasVisibility a => Lens' a Bool
Lens' (Title b V2 n) Bool
hidden Bool -> Bool -> Bool
|| Getting All (Title b V2 n) String -> Title b V2 n -> Bool
forall s a. Getting All s a -> s -> Bool
nullOf Getting All (Title b V2 n) String
forall a b. HasTitle a b => Lens' a String
Lens' (Title b V2 n) String
titleText Title b V2 n
t = QDiagram b V2 n Any
forall a. Monoid a => a
mempty
  | Bool
otherwise = 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
                  (Title b V2 n
t Title b V2 n
-> Getting Placement (Title b V2 n) Placement -> Placement
forall s a. s -> Getting a s a -> a
^. Getting Placement (Title b V2 n) Placement
forall a b. HasTitle a b => Lens' a Placement
Lens' (Title b V2 n) Placement
titlePlacement)
                  (Title b V2 n
t Title b V2 n -> Getting n (Title b V2 n) n -> n
forall s a. s -> Getting a s a -> a
^. Getting n (Title b V2 n) n
(N (Title b V2 n) -> Const n (N (Title b V2 n)))
-> Title b V2 n -> Const n (Title b V2 n)
forall a b. HasTitle a b => Lens' a (N a)
Lens' (Title b V2 n) (N (Title b V2 n))
titleGap)
                  QDiagram b V2 n Any
tDia
  where
    tDia :: QDiagram b V2 n Any
tDia = Title b V2 n -> TextAlignment n -> String -> QDiagram b V2 n Any
forall b (v :: * -> *) n.
Title b v n -> TextAlignment n -> String -> QDiagram b v n Any
tTxtFun Title b V2 n
t (Title b V2 n
t Title b V2 n
-> Getting (TextAlignment n) (Title b V2 n) (TextAlignment n)
-> TextAlignment n
forall s a. s -> Getting a s a -> a
^. Getting (TextAlignment n) (Title b V2 n) (TextAlignment n)
(TextAlignment (N (Title b V2 n))
 -> Const (TextAlignment n) (TextAlignment (N (Title b V2 n))))
-> Title b V2 n -> Const (TextAlignment n) (Title b V2 n)
forall a b. HasTitle a b => Lens' a (TextAlignment (N a))
Lens' (Title b V2 n) (TextAlignment (N (Title b V2 n)))
titleAlignment) (Title b V2 n -> String
forall b (v :: * -> *) n. Title b v n -> String
tTxt Title b V2 n
t)
             # applyStyle (tStyle t)