{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
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 v = Title
{ tVisible :: Bool
, tTxt :: String
, tTxtFun :: TextAlignment Double -> String -> Diagram v
, tStyle :: Style v Double
, tPlacement :: Placement
, tAlignment :: TextAlignment Double
, tGap :: Double
} deriving Typeable
instance Default (Title V2) where
def = Title
{ tVisible = True
, tTxt = ""
, tTxtFun = mkText
, tStyle = mempty # fontSize (output 11)
, tPlacement = midAbove
, tAlignment = BoxAlignedText 0.5 0
, tGap = 20
}
instance Default (Title V3) where
def = Title
{ tVisible = True
, tTxt = ""
, tTxtFun = mempty
, tStyle = mempty # fontSize (output 11)
, tPlacement = midAbove
, tAlignment = BoxAlignedText 0.5 0
, tGap = 20
}
type instance V (Title v) = v
type instance N (Title v) = Double
instance HasVisibility (Title v) where
visible = lens tVisible (\t b -> t {tVisible = b})
instance HasGap (Title v) where
gap = lens tGap (\t g -> t {tGap = g})
instance HasPlacement (Title v) where
placement = titlePlacement
class HasTitle a where
title :: Lens' a (Title (V a))
titleText :: Lens' a String
titleText = title . lens tTxt (\t s -> t {tTxt = s})
titleStyle :: Lens' a (Style (V a) Double)
titleStyle = title . lens tStyle (\t s -> t {tStyle = s})
titlePlacement :: Lens' a Placement
titlePlacement = title . lens tPlacement (\t s -> t {tPlacement = s})
titleTextFunction :: Lens' a (TextAlignment Double -> String -> Diagram (V a))
titleTextFunction = title . lens tTxtFun (\t s -> t {tTxtFun = s})
titleAlignment :: Lens' a (TextAlignment Double)
titleAlignment = title . lens tAlignment (\t s -> t {tAlignment = s})
titleGap :: Lens' a Double
titleGap = title . lens tGap (\t s -> t {tGap = s})
instance HasTitle (Title v) where
title = id
drawTitle
:: BoundingBox V2 Double
-> Title V2
-> Diagram V2
drawTitle bb t
| t ^. hidden || nullOf titleText t = mempty
| otherwise = placeAgainst
bb
(t ^. titlePlacement)
(t ^. titleGap)
tDia
where
tDia = tTxtFun t (t ^. titleAlignment) (tTxt t)
# applyStyle (tStyle t)