{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Text
-- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Very basic text primitives along with associated attributes.
--
-----------------------------------------------------------------------------

module Diagrams.TwoD.Text (
  -- * Creating text diagrams
    Text(..), TextAlignment(..)
  , text, topLeftText, alignedText, baselineText
  , mkText, mkText'

  -- * Text attributes

  -- ** Font family
  , Font(..), _Font
  , getFont, font, _font

  -- ** Font size
  , FontSize(..), _FontSize
  , fontSize, recommendFontSize
  , fontSizeN, fontSizeO, fontSizeL, fontSizeG
  , getFontSize, fontSizeM
  , _fontSizeR, _fontSize, _fontSizeU

  -- ** Font slant
  , FontSlant(..)
  , getFontSlant, fontSlant, italic, oblique, _fontSlant

  -- ** Font weight
  , FontWeight(..)
  , getFontWeight, fontWeight, bold, bolder, lighter, _fontWeight
  , thinWeight, ultraLight, light, mediumWeight, heavy, semiBold, ultraBold

  ) where

import           Control.Lens             hiding (transform)
import           Diagrams.Attributes      (committed)
import           Diagrams.Core
import           Diagrams.Core.Envelope   (pointEnvelope)
import           Diagrams.TwoD.Attributes (recommendFillColor)
import           Diagrams.TwoD.Types

import           Data.Colour              hiding (over)
import           Data.Default.Class
import           Data.Monoid.Recommend
import           Data.Semigroup
import           Data.Typeable

import           Linear.Affine

------------------------------------------------------------
-- Text diagrams
------------------------------------------------------------

-- | A 'Text' primitive consists of the string contents, text alignment
--   and the transformation to be applied. The transformation is scale
--   invarient, the average scale of the transform should always be 1.
--   All text scaling is obtained from the 'FontSize' attribute.
--
--   This constructor should not be used directly. Use 'text',
--   'alignedText' or 'baselineText'.
data Text n = Text (T2 n) (TextAlignment n) String
  deriving Typeable

type instance V (Text n) = V2
type instance N (Text n) = n

instance Floating n => Transformable (Text n) where
  transform :: Transformation (V (Text n)) (N (Text n)) -> Text n -> Text n
transform Transformation (V (Text n)) (N (Text n))
t (Text T2 n
tt TextAlignment n
a String
s) = T2 n -> TextAlignment n -> String -> Text n
forall n. T2 n -> TextAlignment n -> String -> Text n
Text (Transformation (V (Text n)) (N (Text n))
T2 n
t T2 n -> T2 n -> T2 n
forall a. Semigroup a => a -> a -> a
<> T2 n
tt T2 n -> T2 n -> T2 n
forall a. Semigroup a => a -> a -> a
<> T2 n
t') TextAlignment n
a String
s
    where t' :: T2 n
t' = n -> T2 n
forall (v :: * -> *) n.
(Additive v, Fractional n) =>
n -> Transformation v n
scaling (n
1 n -> n -> n
forall a. Fractional a => a -> a -> a
/ T2 n -> n
forall (v :: * -> *) n.
(Additive v, Traversable v, Floating n) =>
Transformation v n -> n
avgScale Transformation (V (Text n)) (N (Text n))
T2 n
t)

instance Floating n => HasOrigin (Text n) where
  moveOriginTo :: Point (V (Text n)) (N (Text n)) -> Text n -> Text n
moveOriginTo Point (V (Text n)) (N (Text n))
p = Vn (Text n) -> Text n -> Text n
forall t. Transformable t => Vn t -> t -> t
translate (Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin Point V2 n -> Point V2 n -> Diff (Point V2) n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point (V (Text n)) (N (Text n))
Point V2 n
p)

instance Floating n => Renderable (Text n) NullBackend where
  render :: NullBackend
-> Text n -> Render NullBackend (V (Text n)) (N (Text n))
render NullBackend
_ Text n
_ = Render NullBackend (V (Text n)) (N (Text n))
forall a. Monoid a => a
mempty

-- | @TextAlignment@ specifies the alignment of the text's origin.
data TextAlignment n = BaselineText | BoxAlignedText n n

-- | Make a text from a 'TextAlignment', recommending a fill colour of
--   'black' and 'fontSize' of @'local' 1@.
mkText :: (TypeableFloat n, Renderable (Text n) b)
  => TextAlignment n -> String -> QDiagram b V2 n Any
mkText :: TextAlignment n -> String -> QDiagram b V2 n Any
mkText TextAlignment n
a = Colour Double -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
recommendFillColor Colour Double
forall a. Num a => Colour a
black
           -- See Note [recommendFillColor]
         (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> (String -> QDiagram b V2 n Any) -> String -> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measure n -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
recommendFontSize (n -> Measure n
forall n. Num n => n -> Measure n
local n
1)
           -- See Note [recommendFontSize]
         (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> (String -> QDiagram b V2 n Any) -> String -> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' TextAlignment n
a

-- | Make a text from a 'TextAlignment' without any default size or fill
--   colour. This is useful is you want to recommend your own using
--   'recommendFillColor' or 'recommendFontSize'.
mkText' :: (TypeableFloat n, Renderable (Text n) b)
  => TextAlignment n -> String -> QDiagram b V2 n Any
mkText' :: TextAlignment n -> String -> QDiagram b V2 n Any
mkText' TextAlignment n
a String
t = Prim b V2 n
-> Envelope V2 n
-> Trace V2 n
-> SubMap b V2 n Any
-> Query V2 n Any
-> QDiagram b V2 n Any
forall b (v :: * -> *) n m.
Prim b v n
-> Envelope v n
-> Trace v n
-> SubMap b v n m
-> Query v n m
-> QDiagram b v n m
mkQD (Text n -> Prim b (V (Text n)) (N (Text n))
forall p b.
(Transformable p, Typeable p, Renderable p b) =>
p -> Prim b (V p) (N p)
Prim (Text n -> Prim b (V (Text n)) (N (Text n)))
-> Text n -> Prim b (V (Text n)) (N (Text n))
forall a b. (a -> b) -> a -> b
$ T2 n -> TextAlignment n -> String -> Text n
forall n. T2 n -> TextAlignment n -> String -> Text n
Text T2 n
forall a. Monoid a => a
mempty TextAlignment n
a String
t)
                   (Point V2 n -> Envelope V2 n
forall n (v :: * -> *).
(Fractional n, Metric v) =>
Point v n -> Envelope v n
pointEnvelope Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin)
                   Trace V2 n
forall a. Monoid a => a
mempty
                   SubMap b V2 n Any
forall a. Monoid a => a
mempty
                   Query V2 n Any
forall a. Monoid a => a
mempty


-- ~~~~ Note [recommendFillColor]

-- The reason we "recommend" a fill color of black instead of setting
-- it directly (or instead of simply not specifying a fill color at
-- all) was originally to support the SVG backend, though it is
-- actually in some sense the "right thing" to do, and other backends
-- we add later may conceivably need it as well.  The cairo backend
-- defaults happen to be to use a transparent fill for paths and a
-- black fill for text.  The SVG standard, however, specifies a
-- default fill of black for everything (both text and paths).  In
-- order to correctly render paths with no fill set, the SVG backend
-- must therefore explicitly set the fill to transparent -- but this
-- meant that it was also drawing text with a transparent fill.  The
-- solution is that we now explicitly inform all backends that the
-- *default* ("recommended") fill color for text should be black; an
-- absence of fill specification now consistently means to use a
-- "transparent" fill no matter what the primitive.  The reason we
-- need the special recommend/commit distinction is because if the
-- user explicitly sets a fill color later it should override this
-- recommendation; normally, the innermost occurrence of an attribute
-- would override all outer occurrences.

-- ~~~~ Note [recommendFontSize]
-- The reason we "recommend" a font size is so any local scales get
-- recorded.

-- | Create a primitive text diagram from the given string, with center
--   alignment, equivalent to @'alignedText' 0.5 0.5@.
--
--   Note that it /takes up no space/, as text size information is not
--   available.
text :: (TypeableFloat n, Renderable (Text n) b) => String -> QDiagram b V2 n Any
text :: String -> QDiagram b V2 n Any
text = n -> n -> String -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
n -> n -> String -> QDiagram b V2 n Any
alignedText n
0.5 n
0.5

-- | Create a primitive text diagram from the given string, origin at
--   the top left corner of the text's bounding box, equivalent to
--   @'alignedText' 0 1@.
--
--   Note that it /takes up no space/.
topLeftText :: (TypeableFloat n, Renderable (Text n) b) => String -> QDiagram b V2 n Any
topLeftText :: String -> QDiagram b V2 n Any
topLeftText = n -> n -> String -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
n -> n -> String -> QDiagram b V2 n Any
alignedText n
0 n
1

-- | Create a primitive text diagram from the given string, with the
--   origin set to a point interpolated within the bounding box.  The
--   first parameter varies from 0 (left) to 1 (right), and the second
--   parameter from 0 (bottom) to 1 (top). Some backends do not
--   implement this and instead snap to closest corner or the center.
--
--   The height of this box is determined by the font's potential ascent
--   and descent, rather than the height of the particular string.
--
--   Note that it /takes up no space/.
alignedText :: (TypeableFloat n, Renderable (Text n) b)
  => n -> n -> String -> QDiagram b V2 n Any
alignedText :: n -> n -> String -> QDiagram b V2 n Any
alignedText n
w n
h = 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 (n -> n -> TextAlignment n
forall n. n -> n -> TextAlignment n
BoxAlignedText n
w n
h)

-- | Create a primitive text diagram from the given string, with the
--   origin set to be on the baseline, at the beginning (although not
--   bounding).  This is the reference point of showText in the Cairo
--   graphics library.
--
--   Note that it /takes up no space/.
baselineText :: (TypeableFloat n, Renderable (Text n) b)
  => String -> QDiagram b V2 n Any
baselineText :: String -> QDiagram b V2 n Any
baselineText = 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 TextAlignment n
forall n. TextAlignment n
BaselineText

------------------------------------------------------------
-- Text attributes
------------------------------------------------------------

--------------------------------------------------
-- Font family

-- | The @Font@ attribute specifies the name of a font family.  Inner
--   @Font@ attributes override outer ones.
newtype Font = Font (Last String)
  deriving (Typeable, b -> Font -> Font
NonEmpty Font -> Font
Font -> Font -> Font
(Font -> Font -> Font)
-> (NonEmpty Font -> Font)
-> (forall b. Integral b => b -> Font -> Font)
-> Semigroup Font
forall b. Integral b => b -> Font -> Font
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Font -> Font
$cstimes :: forall b. Integral b => b -> Font -> Font
sconcat :: NonEmpty Font -> Font
$csconcat :: NonEmpty Font -> Font
<> :: Font -> Font -> Font
$c<> :: Font -> Font -> Font
Semigroup, Font -> Font -> Bool
(Font -> Font -> Bool) -> (Font -> Font -> Bool) -> Eq Font
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Font -> Font -> Bool
$c/= :: Font -> Font -> Bool
== :: Font -> Font -> Bool
$c== :: Font -> Font -> Bool
Eq)

_Font :: Iso' Font String
_Font :: p String (f String) -> p Font (f Font)
_Font = (Font -> String) -> (String -> Font) -> Iso Font Font String String
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Font -> String
getFont (Last String -> Font
Font (Last String -> Font) -> (String -> Last String) -> String -> Font
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Last String
forall a. a -> Last a
Last)

instance AttributeClass Font

-- | Extract the font family name from a @Font@ attribute.
getFont :: Font -> String
getFont :: Font -> String
getFont (Font (Last String
f)) = String
f

-- | Specify a font family to be used for all text within a diagram.
font :: HasStyle a => String -> a -> a
font :: String -> a -> a
font = Font -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr (Font -> a -> a) -> (String -> Font) -> String -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last String -> Font
Font (Last String -> Font) -> (String -> Last String) -> String -> Font
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Last String
forall a. a -> Last a
Last

-- | Lens onto the font name of a style.
_font :: Lens' (Style v n) (Maybe String)
_font :: (Maybe String -> f (Maybe String)) -> Style v n -> f (Style v n)
_font = (Maybe Font -> f (Maybe Font)) -> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr ((Maybe Font -> f (Maybe Font)) -> Style v n -> f (Style v n))
-> ((Maybe String -> f (Maybe String))
    -> Maybe Font -> f (Maybe Font))
-> (Maybe String -> f (Maybe String))
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso Font Font String String
-> Iso (Maybe Font) (Maybe Font) (Maybe String) (Maybe String)
forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping AnIso Font Font String String
Iso Font Font String String
_Font

--------------------------------------------------
-- Font size

-- | The @FontSize@ attribute specifies the size of a font's
--   em-square.  Inner @FontSize@ attributes override outer ones.
newtype FontSize n = FontSize (Recommend (Last n))
  deriving (Typeable, b -> FontSize n -> FontSize n
NonEmpty (FontSize n) -> FontSize n
FontSize n -> FontSize n -> FontSize n
(FontSize n -> FontSize n -> FontSize n)
-> (NonEmpty (FontSize n) -> FontSize n)
-> (forall b. Integral b => b -> FontSize n -> FontSize n)
-> Semigroup (FontSize n)
forall b. Integral b => b -> FontSize n -> FontSize n
forall n. NonEmpty (FontSize n) -> FontSize n
forall n. FontSize n -> FontSize n -> FontSize n
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall n b. Integral b => b -> FontSize n -> FontSize n
stimes :: b -> FontSize n -> FontSize n
$cstimes :: forall n b. Integral b => b -> FontSize n -> FontSize n
sconcat :: NonEmpty (FontSize n) -> FontSize n
$csconcat :: forall n. NonEmpty (FontSize n) -> FontSize n
<> :: FontSize n -> FontSize n -> FontSize n
$c<> :: forall n. FontSize n -> FontSize n -> FontSize n
Semigroup)

-- not sure why this can't be derived
instance Functor FontSize where
  fmap :: (a -> b) -> FontSize a -> FontSize b
fmap a -> b
f (FontSize (Recommend (Last a
a))) = Recommend (Last b) -> FontSize b
forall n. Recommend (Last n) -> FontSize n
FontSize (Last b -> Recommend (Last b)
forall a. a -> Recommend a
Recommend (b -> Last b
forall a. a -> Last a
Last (a -> b
f a
a)))
  fmap a -> b
f (FontSize (Commit (Last a
a)))    = Recommend (Last b) -> FontSize b
forall n. Recommend (Last n) -> FontSize n
FontSize (Last b -> Recommend (Last b)
forall a. a -> Recommend a
Commit (b -> Last b
forall a. a -> Last a
Last (a -> b
f a
a)))

_FontSize :: Iso' (FontSize n) (Recommend n)
_FontSize :: p (Recommend n) (f (Recommend n))
-> p (FontSize n) (f (FontSize n))
_FontSize = (FontSize n -> Recommend n)
-> (Recommend n -> FontSize n)
-> Iso (FontSize n) (FontSize n) (Recommend n) (Recommend n)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso FontSize n -> Recommend n
forall a. FontSize a -> Recommend a
getter Recommend n -> FontSize n
forall n. Recommend n -> FontSize n
setter
  where getter :: FontSize a -> Recommend a
getter (FontSize (Recommend (Last a
a))) = a -> Recommend a
forall a. a -> Recommend a
Recommend a
a
        getter (FontSize (Commit    (Last a
a))) = a -> Recommend a
forall a. a -> Recommend a
Commit a
a
        setter :: Recommend n -> FontSize n
setter (Recommend n
a) = Recommend (Last n) -> FontSize n
forall n. Recommend (Last n) -> FontSize n
FontSize (Recommend (Last n) -> FontSize n)
-> Recommend (Last n) -> FontSize n
forall a b. (a -> b) -> a -> b
$ Last n -> Recommend (Last n)
forall a. a -> Recommend a
Recommend (n -> Last n
forall a. a -> Last a
Last n
a)
        setter (Commit    n
a) = Recommend (Last n) -> FontSize n
forall n. Recommend (Last n) -> FontSize n
FontSize (Recommend (Last n) -> FontSize n)
-> Recommend (Last n) -> FontSize n
forall a b. (a -> b) -> a -> b
$ Last n -> Recommend (Last n)
forall a. a -> Recommend a
Commit (n -> Last n
forall a. a -> Last a
Last n
a)
      -- = iso (\(FontSize a) -> a) FontSize . mapping _Wrapped
      -- once we depend on monoid-extras-0.4

_FontSizeM :: Iso' (FontSizeM n) (Measured n (Recommend n))
_FontSizeM :: p (Measured n (Recommend n)) (f (Measured n (Recommend n)))
-> p (FontSizeM n) (f (FontSizeM n))
_FontSizeM = AnIso (FontSize n) (FontSize n) (Recommend n) (Recommend n)
-> Iso
     (FontSizeM n)
     (FontSizeM n)
     (Measured n (Recommend n))
     (Measured n (Recommend n))
forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping AnIso (FontSize n) (FontSize n) (Recommend n) (Recommend n)
forall n. Iso' (FontSize n) (Recommend n)
_FontSize

type FontSizeM n = Measured n (FontSize n)

instance Typeable n => AttributeClass (FontSize n)

instance Num n => Default (FontSizeM n) where
  def :: FontSizeM n
def = Recommend (Last n) -> FontSize n
forall n. Recommend (Last n) -> FontSize n
FontSize (Recommend (Last n) -> FontSize n)
-> (n -> Recommend (Last n)) -> n -> FontSize n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last n -> Recommend (Last n)
forall a. a -> Recommend a
Recommend (Last n -> Recommend (Last n))
-> (n -> Last n) -> n -> Recommend (Last n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Last n
forall a. a -> Last a
Last (n -> FontSize n) -> Measured n n -> FontSizeM n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> n -> Measured n n
forall n. Num n => n -> Measure n
local n
1

-- | Extract the size from a @FontSize@ attribute.
getFontSize :: FontSize n -> n
getFontSize :: FontSize n -> n
getFontSize (FontSize (Recommend (Last n
s))) = n
s
getFontSize (FontSize (Commit (Last n
s)))    = n
s

-- | Set the font size, that is, the size of the font's em-square as
--   measured within the current local vector space. The default size
--   is @local 1@ (which is applied by 'recommendFontSize').
fontSize :: (N a ~ n, Typeable n, HasStyle a) => Measure n -> a -> a
fontSize :: Measure n -> a -> a
fontSize = Measured n (FontSize n) -> a -> a
forall a d n.
(AttributeClass a, N d ~ n, HasStyle d) =>
Measured n a -> d -> d
applyMAttr (Measured n (FontSize n) -> a -> a)
-> (Measure n -> Measured n (FontSize n)) -> Measure n -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> FontSize n) -> Measure n -> Measured n (FontSize n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Recommend (Last n) -> FontSize n
forall n. Recommend (Last n) -> FontSize n
FontSize (Recommend (Last n) -> FontSize n)
-> (n -> Recommend (Last n)) -> n -> FontSize n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last n -> Recommend (Last n)
forall a. a -> Recommend a
Commit (Last n -> Recommend (Last n))
-> (n -> Last n) -> n -> Recommend (Last n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Last n
forall a. a -> Last a
Last)

-- | 'Recommend' a font size. Any use of 'fontSize' above this will
--   overwrite any recommended size. This should only be used with
--   'mkText'', other text functions already has a recommended font
--   size so this will be ignored.
recommendFontSize :: (N a ~ n, Typeable n, HasStyle a) => Measure n -> a -> a
recommendFontSize :: Measure n -> a -> a
recommendFontSize = Measured n (FontSize n) -> a -> a
forall a d n.
(AttributeClass a, N d ~ n, HasStyle d) =>
Measured n a -> d -> d
applyMAttr (Measured n (FontSize n) -> a -> a)
-> (Measure n -> Measured n (FontSize n)) -> Measure n -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> FontSize n) -> Measure n -> Measured n (FontSize n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Recommend (Last n) -> FontSize n
forall n. Recommend (Last n) -> FontSize n
FontSize (Recommend (Last n) -> FontSize n)
-> (n -> Recommend (Last n)) -> n -> FontSize n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last n -> Recommend (Last n)
forall a. a -> Recommend a
Recommend (Last n -> Recommend (Last n))
-> (n -> Last n) -> n -> Recommend (Last n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Last n
forall a. a -> Last a
Last)

-- | A convenient synonym for 'fontSize (Global w)'.
fontSizeG :: (N a ~ n, Typeable n, Num n, HasStyle a) => n -> a -> a
fontSizeG :: n -> a -> a
fontSizeG = Measure n -> a -> a
forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
fontSize (Measure n -> a -> a) -> (n -> Measure n) -> n -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Measure n
forall n. Num n => n -> Measure n
global

-- | A convenient synonym for 'fontSize (Normalized w)'.
fontSizeN :: (N a ~ n, Typeable n, Num n, HasStyle a) => n -> a -> a
fontSizeN :: n -> a -> a
fontSizeN = Measure n -> a -> a
forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
fontSize (Measure n -> a -> a) -> (n -> Measure n) -> n -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Measure n
forall n. Num n => n -> Measure n
normalized

-- | A convenient synonym for 'fontSize (Output w)'.
fontSizeO :: (N a ~ n, Typeable n, HasStyle a) => n -> a -> a
fontSizeO :: n -> a -> a
fontSizeO = Measure n -> a -> a
forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
fontSize (Measure n -> a -> a) -> (n -> Measure n) -> n -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Measure n
forall n. n -> Measure n
output

-- | A convenient sysnonym for 'fontSize (Local w)'.
fontSizeL :: (N a ~ n, Typeable n, Num n, HasStyle a) => n -> a -> a
fontSizeL :: n -> a -> a
fontSizeL = Measure n -> a -> a
forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
fontSize (Measure n -> a -> a) -> (n -> Measure n) -> n -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Measure n
forall n. Num n => n -> Measure n
local

-- | Apply a 'FontSize' attribute.
fontSizeM :: (N a ~ n, Typeable n, HasStyle a) => FontSizeM n -> a -> a
fontSizeM :: FontSizeM n -> a -> a
fontSizeM = FontSizeM n -> a -> a
forall a d n.
(AttributeClass a, N d ~ n, HasStyle d) =>
Measured n a -> d -> d
applyMAttr

_fontSizeR :: (Typeable n, OrderedField n) => Lens' (Style v n) (Measured n (Recommend n))
_fontSizeR :: Lens' (Style v n) (Measured n (Recommend n))
_fontSizeR = (Maybe (Measured n (FontSize n))
 -> f (Maybe (Measured n (FontSize n))))
-> Style v n -> f (Style v n)
forall a n (v :: * -> *).
(AttributeClass a, Typeable n) =>
Lens' (Style v n) (Maybe (Measured n a))
atMAttr ((Maybe (Measured n (FontSize n))
  -> f (Maybe (Measured n (FontSize n))))
 -> Style v n -> f (Style v n))
-> ((Measured n (Recommend n) -> f (Measured n (Recommend n)))
    -> Maybe (Measured n (FontSize n))
    -> f (Maybe (Measured n (FontSize n))))
-> (Measured n (Recommend n) -> f (Measured n (Recommend n)))
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measured n (FontSize n)
-> (Measured n (FontSize n) -> Bool)
-> Iso' (Maybe (Measured n (FontSize n))) (Measured n (FontSize n))
forall a. a -> (a -> Bool) -> Iso' (Maybe a) a
anon Measured n (FontSize n)
forall a. Default a => a
def (Bool -> Measured n (FontSize n) -> Bool
forall a b. a -> b -> a
const Bool
False) ((Measured n (FontSize n) -> f (Measured n (FontSize n)))
 -> Maybe (Measured n (FontSize n))
 -> f (Maybe (Measured n (FontSize n))))
-> ((Measured n (Recommend n) -> f (Measured n (Recommend n)))
    -> Measured n (FontSize n) -> f (Measured n (FontSize n)))
-> (Measured n (Recommend n) -> f (Measured n (Recommend n)))
-> Maybe (Measured n (FontSize n))
-> f (Maybe (Measured n (FontSize n)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Measured n (Recommend n) -> f (Measured n (Recommend n)))
-> Measured n (FontSize n) -> f (Measured n (FontSize n))
forall n. Iso' (FontSizeM n) (Measured n (Recommend n))
_FontSizeM

-- | Lens to commit a font size. This is *not* a valid lens (see
--   'commited'.
_fontSize :: (Typeable n, OrderedField n) => Lens' (Style v n) (Measure n)
_fontSize :: Lens' (Style v n) (Measure n)
_fontSize = (Measured n (Recommend n) -> f (Measured n (Recommend n)))
-> Style v n -> f (Style v n)
forall n (v :: * -> *).
(Typeable n, OrderedField n) =>
Lens' (Style v n) (Measured n (Recommend n))
_fontSizeR ((Measured n (Recommend n) -> f (Measured n (Recommend n)))
 -> Style v n -> f (Style v n))
-> ((Measure n -> f (Measure n))
    -> Measured n (Recommend n) -> f (Measured n (Recommend n)))
-> (Measure n -> f (Measure n))
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso (Recommend n) (Recommend n) n n
-> Iso
     (Measured n (Recommend n))
     (Measured n (Recommend n))
     (Measure n)
     (Measure n)
forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping AnIso (Recommend n) (Recommend n) n n
forall a b. Iso (Recommend a) (Recommend b) a b
committed

_fontSizeU :: (Typeable n) => Lens' (Style v n) (Maybe n)
_fontSizeU :: Lens' (Style v n) (Maybe n)
_fontSizeU = (Maybe (FontSize n) -> f (Maybe (FontSize n)))
-> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr ((Maybe (FontSize n) -> f (Maybe (FontSize n)))
 -> Style v n -> f (Style v n))
-> ((Maybe n -> f (Maybe n))
    -> Maybe (FontSize n) -> f (Maybe (FontSize n)))
-> (Maybe n -> f (Maybe n))
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso (FontSize n) (FontSize n) n n
-> Iso
     (Maybe (FontSize n)) (Maybe (FontSize n)) (Maybe n) (Maybe n)
forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping (Exchange n n (Recommend n) (Identity (Recommend n))
-> Exchange n n (FontSize n) (Identity (FontSize n))
forall n. Iso' (FontSize n) (Recommend n)
_FontSize (Exchange n n (Recommend n) (Identity (Recommend n))
 -> Exchange n n (FontSize n) (Identity (FontSize n)))
-> (Exchange n n n (Identity n)
    -> Exchange n n (Recommend n) (Identity (Recommend n)))
-> AnIso (FontSize n) (FontSize n) n n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exchange n n n (Identity n)
-> Exchange n n (Recommend n) (Identity (Recommend n))
forall a b. Iso (Recommend a) (Recommend b) a b
committed)

--------------------------------------------------
-- Font slant

-- | The @FontSlantA@ attribute specifies the slant (normal, italic,
--   or oblique) that should be used for all text within a diagram.
--   Inner @FontSlantA@ attributes override outer ones.
data FontSlant = FontSlantNormal
               | FontSlantItalic
               | FontSlantOblique
  deriving (FontSlant -> FontSlant -> Bool
(FontSlant -> FontSlant -> Bool)
-> (FontSlant -> FontSlant -> Bool) -> Eq FontSlant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontSlant -> FontSlant -> Bool
$c/= :: FontSlant -> FontSlant -> Bool
== :: FontSlant -> FontSlant -> Bool
$c== :: FontSlant -> FontSlant -> Bool
Eq, Int -> FontSlant -> ShowS
[FontSlant] -> ShowS
FontSlant -> String
(Int -> FontSlant -> ShowS)
-> (FontSlant -> String)
-> ([FontSlant] -> ShowS)
-> Show FontSlant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontSlant] -> ShowS
$cshowList :: [FontSlant] -> ShowS
show :: FontSlant -> String
$cshow :: FontSlant -> String
showsPrec :: Int -> FontSlant -> ShowS
$cshowsPrec :: Int -> FontSlant -> ShowS
Show, Typeable, Eq FontSlant
Eq FontSlant
-> (FontSlant -> FontSlant -> Ordering)
-> (FontSlant -> FontSlant -> Bool)
-> (FontSlant -> FontSlant -> Bool)
-> (FontSlant -> FontSlant -> Bool)
-> (FontSlant -> FontSlant -> Bool)
-> (FontSlant -> FontSlant -> FontSlant)
-> (FontSlant -> FontSlant -> FontSlant)
-> Ord FontSlant
FontSlant -> FontSlant -> Bool
FontSlant -> FontSlant -> Ordering
FontSlant -> FontSlant -> FontSlant
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontSlant -> FontSlant -> FontSlant
$cmin :: FontSlant -> FontSlant -> FontSlant
max :: FontSlant -> FontSlant -> FontSlant
$cmax :: FontSlant -> FontSlant -> FontSlant
>= :: FontSlant -> FontSlant -> Bool
$c>= :: FontSlant -> FontSlant -> Bool
> :: FontSlant -> FontSlant -> Bool
$c> :: FontSlant -> FontSlant -> Bool
<= :: FontSlant -> FontSlant -> Bool
$c<= :: FontSlant -> FontSlant -> Bool
< :: FontSlant -> FontSlant -> Bool
$c< :: FontSlant -> FontSlant -> Bool
compare :: FontSlant -> FontSlant -> Ordering
$ccompare :: FontSlant -> FontSlant -> Ordering
$cp1Ord :: Eq FontSlant
Ord)

instance AttributeClass FontSlant where
instance Semigroup FontSlant where
  FontSlant
_ <> :: FontSlant -> FontSlant -> FontSlant
<> FontSlant
b = FontSlant
b

instance Default FontSlant where
  def :: FontSlant
def = FontSlant
FontSlantNormal

-- | Extract the font slant from a 'FontSlantA' attribute.
getFontSlant :: FontSlant -> FontSlant
getFontSlant :: FontSlant -> FontSlant
getFontSlant = FontSlant -> FontSlant
forall a. a -> a
id

-- | Specify the slant (normal, italic, or oblique) that should be
--   used for all text within a diagram.  See also 'italic' and
--   'oblique' for useful special cases.
fontSlant :: HasStyle a => FontSlant -> a -> a
fontSlant :: FontSlant -> a -> a
fontSlant = FontSlant -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr

-- | Lens onto the font slant in a style.
_fontSlant :: Lens' (Style v n) FontSlant
_fontSlant :: (FontSlant -> f FontSlant) -> Style v n -> f (Style v n)
_fontSlant = (Maybe FontSlant -> f (Maybe FontSlant))
-> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr ((Maybe FontSlant -> f (Maybe FontSlant))
 -> Style v n -> f (Style v n))
-> ((FontSlant -> f FontSlant)
    -> Maybe FontSlant -> f (Maybe FontSlant))
-> (FontSlant -> f FontSlant)
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontSlant -> Iso' (Maybe FontSlant) FontSlant
forall a. Eq a => a -> Iso' (Maybe a) a
non FontSlant
forall a. Default a => a
def

-- | Set all text in italics.
italic :: HasStyle a => a -> a
italic :: a -> a
italic = FontSlant -> a -> a
forall a. HasStyle a => FontSlant -> a -> a
fontSlant FontSlant
FontSlantItalic

-- | Set all text using an oblique slant.
oblique :: HasStyle a => a -> a
oblique :: a -> a
oblique = FontSlant -> a -> a
forall a. HasStyle a => FontSlant -> a -> a
fontSlant FontSlant
FontSlantOblique

--------------------------------------------------
-- Font weight

-- | The @FontWeightA@ attribute specifies the weight (normal or bold)
--   that should be used for all text within a diagram.  Inner
--   @FontWeightA@ attributes override outer ones.
data FontWeight = FontWeightNormal
                | FontWeightBold
                | FontWeightBolder
                | FontWeightLighter
                | FontWeightThin
                | FontWeightUltraLight
                | FontWeightLight
                | FontWeightMedium
                | FontWeightSemiBold
                | FontWeightUltraBold
                | FontWeightHeavy
    deriving (FontWeight -> FontWeight -> Bool
(FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> Bool) -> Eq FontWeight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontWeight -> FontWeight -> Bool
$c/= :: FontWeight -> FontWeight -> Bool
== :: FontWeight -> FontWeight -> Bool
$c== :: FontWeight -> FontWeight -> Bool
Eq,
              Eq FontWeight
Eq FontWeight
-> (FontWeight -> FontWeight -> Ordering)
-> (FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> FontWeight)
-> (FontWeight -> FontWeight -> FontWeight)
-> Ord FontWeight
FontWeight -> FontWeight -> Bool
FontWeight -> FontWeight -> Ordering
FontWeight -> FontWeight -> FontWeight
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FontWeight -> FontWeight -> FontWeight
$cmin :: FontWeight -> FontWeight -> FontWeight
max :: FontWeight -> FontWeight -> FontWeight
$cmax :: FontWeight -> FontWeight -> FontWeight
>= :: FontWeight -> FontWeight -> Bool
$c>= :: FontWeight -> FontWeight -> Bool
> :: FontWeight -> FontWeight -> Bool
$c> :: FontWeight -> FontWeight -> Bool
<= :: FontWeight -> FontWeight -> Bool
$c<= :: FontWeight -> FontWeight -> Bool
< :: FontWeight -> FontWeight -> Bool
$c< :: FontWeight -> FontWeight -> Bool
compare :: FontWeight -> FontWeight -> Ordering
$ccompare :: FontWeight -> FontWeight -> Ordering
$cp1Ord :: Eq FontWeight
Ord, Int -> FontWeight -> ShowS
[FontWeight] -> ShowS
FontWeight -> String
(Int -> FontWeight -> ShowS)
-> (FontWeight -> String)
-> ([FontWeight] -> ShowS)
-> Show FontWeight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontWeight] -> ShowS
$cshowList :: [FontWeight] -> ShowS
show :: FontWeight -> String
$cshow :: FontWeight -> String
showsPrec :: Int -> FontWeight -> ShowS
$cshowsPrec :: Int -> FontWeight -> ShowS
Show, Typeable)

instance AttributeClass FontWeight

-- | Last semigroup structure
instance Semigroup FontWeight where
  FontWeight
_ <> :: FontWeight -> FontWeight -> FontWeight
<> FontWeight
b = FontWeight
b

instance Default FontWeight where
  def :: FontWeight
def = FontWeight
FontWeightNormal

-- | Extract the font weight.
getFontWeight :: FontWeight -> FontWeight
getFontWeight :: FontWeight -> FontWeight
getFontWeight = FontWeight -> FontWeight
forall a. a -> a
id

-- | Specify the weight (normal, bolder, lighter or bold) that should be
--   used for all text within a diagram.  See also 'bold'
--   for a useful special case.
fontWeight :: HasStyle a => FontWeight -> a -> a
fontWeight :: FontWeight -> a -> a
fontWeight = FontWeight -> a -> a
forall a d. (AttributeClass a, HasStyle d) => a -> d -> d
applyAttr

-- | Set all text using a bold font weight.
bold :: HasStyle a => a -> a
bold :: a -> a
bold = FontWeight -> a -> a
forall a. HasStyle a => FontWeight -> a -> a
fontWeight FontWeight
FontWeightBold

-- | Set all text using a thin font weight.
thinWeight :: HasStyle a => a -> a
thinWeight :: a -> a
thinWeight = FontWeight -> a -> a
forall a. HasStyle a => FontWeight -> a -> a
fontWeight FontWeight
FontWeightThin

-- | Set all text using a extra light font weight.
ultraLight :: HasStyle a => a -> a
ultraLight :: a -> a
ultraLight = FontWeight -> a -> a
forall a. HasStyle a => FontWeight -> a -> a
fontWeight FontWeight
FontWeightUltraLight

-- | Set all text using a light font weight.
light :: HasStyle a => a -> a
light :: a -> a
light = FontWeight -> a -> a
forall a. HasStyle a => FontWeight -> a -> a
fontWeight FontWeight
FontWeightLight

-- | Set all text using a medium font weight.
mediumWeight :: HasStyle a => a -> a
mediumWeight :: a -> a
mediumWeight = FontWeight -> a -> a
forall a. HasStyle a => FontWeight -> a -> a
fontWeight FontWeight
FontWeightMedium

-- | Set all text using a semi-bold font weight.
semiBold :: HasStyle a => a -> a
semiBold :: a -> a
semiBold = FontWeight -> a -> a
forall a. HasStyle a => FontWeight -> a -> a
fontWeight FontWeight
FontWeightSemiBold

-- | Set all text using an ultra-bold font weight.
ultraBold :: HasStyle a => a -> a
ultraBold :: a -> a
ultraBold = FontWeight -> a -> a
forall a. HasStyle a => FontWeight -> a -> a
fontWeight FontWeight
FontWeightUltraBold

-- | Set all text using a heavy/black font weight.
heavy :: HasStyle a => a -> a
heavy :: a -> a
heavy = FontWeight -> a -> a
forall a. HasStyle a => FontWeight -> a -> a
fontWeight FontWeight
FontWeightHeavy

-- | Set all text to be bolder than the inherited font weight.
bolder :: HasStyle a => a -> a
bolder :: a -> a
bolder = FontWeight -> a -> a
forall a. HasStyle a => FontWeight -> a -> a
fontWeight FontWeight
FontWeightBolder

-- | Set all text to be lighter than the inherited font weight.
lighter :: HasStyle a => a -> a
lighter :: a -> a
lighter = FontWeight -> a -> a
forall a. HasStyle a => FontWeight -> a -> a
fontWeight FontWeight
FontWeightLighter

-- | Lens onto the font weight in a style.
_fontWeight :: Lens' (Style v n) FontWeight
_fontWeight :: (FontWeight -> f FontWeight) -> Style v n -> f (Style v n)
_fontWeight = (Maybe FontWeight -> f (Maybe FontWeight))
-> Style v n -> f (Style v n)
forall a (v :: * -> *) n.
AttributeClass a =>
Lens' (Style v n) (Maybe a)
atAttr ((Maybe FontWeight -> f (Maybe FontWeight))
 -> Style v n -> f (Style v n))
-> ((FontWeight -> f FontWeight)
    -> Maybe FontWeight -> f (Maybe FontWeight))
-> (FontWeight -> f FontWeight)
-> Style v n
-> f (Style v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontWeight -> Iso' (Maybe FontWeight) FontWeight
forall a. Eq a => a -> Iso' (Maybe a) a
non FontWeight
forall a. Default a => a
def