content: {-# LANGUAGE ConstraintKinds            #-}
  {-# LANGUAGE DeriveDataTypeable         #-}
  {-# LANGUAGE FlexibleContexts           #-}
  {-# LANGUAGE FlexibleInstances          #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE MultiParamTypeClasses      #-}
  {-# LANGUAGE TypeFamilies               #-}
  {-# LANGUAGE TypeOperators              #-}
  {-# 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
  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 t (Text tt a s) = Text (t <> tt <> t') a s
      where t' = scaling (1 / avgScale t)
  
  instance Floating n => HasOrigin (Text n) where
    moveOriginTo p = translate (origin .-. p)
  
  instance Floating n => Renderable (Text n) NullBackend where
    render _ _ = 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 a = recommendFillColor black
             -- See Note [recommendFillColor]
           . recommendFontSize (local 1)
             -- See Note [recommendFontSize]
           . mkText' 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' a t = mkQD (Prim $ Text mempty a t)
                     (pointEnvelope origin)
                     mempty
                     mempty
                     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 = alignedText 0.5 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 = alignedText 0 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 w h = mkText (BoxAlignedText w 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 = mkText 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, Semigroup, Eq)
  
  _Font :: Iso' Font String
  _Font = iso getFont (Font . Last)
  
  instance AttributeClass Font
  
  -- | Extract the font family name from a @Font@ attribute.
  getFont :: Font -> String
  getFont (Font (Last f)) = f
  
  -- | Specify a font family to be used for all text within a diagram.
  font :: HasStyle a => String -> a -> a
  font = applyAttr . Font . Last
  
  -- | Lens onto the font name of a style.
  _font :: Lens' (Style v n) (Maybe String)
  _font = atAttr . mapping _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, Semigroup)
  
  -- not sure why this can't be derived
  instance Functor FontSize where
    fmap f (FontSize (Recommend (Last a))) = FontSize (Recommend (Last (f a)))
    fmap f (FontSize (Commit (Last a)))    = FontSize (Commit (Last (f a)))
  
  _FontSize :: Iso' (FontSize n) (Recommend n)
  _FontSize = iso getter setter
    where getter (FontSize (Recommend (Last a))) = Recommend a
          getter (FontSize (Commit    (Last a))) = Commit a
          setter (Recommend a) = FontSize $ Recommend (Last a)
          setter (Commit    a) = FontSize $ Commit (Last 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 = mapping _FontSize
  
  type FontSizeM n = Measured n (FontSize n)
  
  instance Typeable n => AttributeClass (FontSize n)
  
  instance Num n => Default (FontSizeM n) where
    def = FontSize . Recommend . Last <$> local 1
  
  -- | Extract the size from a @FontSize@ attribute.
  getFontSize :: FontSize n -> n
  getFontSize (FontSize (Recommend (Last s))) = s
  getFontSize (FontSize (Commit (Last s)))    = 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 = applyMAttr . fmap (FontSize . Commit . 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 = applyMAttr . fmap (FontSize . Recommend . Last)
  
  -- | A convenient synonym for 'fontSize (Global w)'.
  fontSizeG :: (N a ~ n, Typeable n, Num n, HasStyle a) => n -> a -> a
  fontSizeG = fontSize . global
  
  -- | A convenient synonym for 'fontSize (Normalized w)'.
  fontSizeN :: (N a ~ n, Typeable n, Num n, HasStyle a) => n -> a -> a
  fontSizeN = fontSize . normalized
  
  -- | A convenient synonym for 'fontSize (Output w)'.
  fontSizeO :: (N a ~ n, Typeable n, HasStyle a) => n -> a -> a
  fontSizeO = fontSize . output
  
  -- | A convenient sysnonym for 'fontSize (Local w)'.
  fontSizeL :: (N a ~ n, Typeable n, Num n, HasStyle a) => n -> a -> a
  fontSizeL = fontSize . local
  
  -- | Apply a 'FontSize' attribute.
  fontSizeM :: (N a ~ n, Typeable n, HasStyle a) => FontSizeM n -> a -> a
  fontSizeM = applyMAttr
  
  _fontSizeR :: (Typeable n, OrderedField n) => Lens' (Style v n) (Measured n (Recommend n))
  _fontSizeR = atMAttr . anon def (const False) . _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 = _fontSizeR . mapping committed
  
  _fontSizeU :: (Typeable n) => Lens' (Style v n) (Maybe n)
  _fontSizeU = atAttr . mapping (_FontSize . 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 (Eq, Show, Typeable, Ord)
  
  instance AttributeClass FontSlant where
  instance Semigroup FontSlant where
    _ <> b = b
  
  instance Default FontSlant where
    def = FontSlantNormal
  
  -- | Extract the font slant from a 'FontSlantA' attribute.
  getFontSlant :: FontSlant -> FontSlant
  getFontSlant = 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 = applyAttr
  
  -- | Lens onto the font slant in a style.
  _fontSlant :: Lens' (Style v n) FontSlant
  _fontSlant = atAttr . non def
  
  -- | Set all text in italics.
  italic :: HasStyle a => a -> a
  italic = fontSlant FontSlantItalic
  
  -- | Set all text using an oblique slant.
  oblique :: HasStyle a => a -> a
  oblique = 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 (Eq,
                Ord, Show, Typeable)
  
  instance AttributeClass FontWeight
  
  -- | Last semigroup structure
  instance Semigroup FontWeight where
    _ <> b = b
  
  instance Default FontWeight where
    def = FontWeightNormal
  
  -- | Extract the font weight.
  getFontWeight :: FontWeight -> FontWeight
  getFontWeight = 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 = applyAttr
  
  -- | Set all text using a bold font weight.
  bold :: HasStyle a => a -> a
  bold = fontWeight FontWeightBold
  
  -- | Set all text using a thin font weight.
  thinWeight :: HasStyle a => a -> a
  thinWeight = fontWeight FontWeightThin
  
  -- | Set all text using a extra light font weight.
  ultraLight :: HasStyle a => a -> a
  ultraLight = fontWeight FontWeightUltraLight
  
  -- | Set all text using a light font weight.
  light :: HasStyle a => a -> a
  light = fontWeight FontWeightLight
  
  -- | Set all text using a medium font weight.
  mediumWeight :: HasStyle a => a -> a
  mediumWeight = fontWeight FontWeightMedium
  
  -- | Set all text using a semi-bold font weight.
  semiBold :: HasStyle a => a -> a
  semiBold = fontWeight FontWeightSemiBold
  
  -- | Set all text using an ultra-bold font weight.
  ultraBold :: HasStyle a => a -> a
  ultraBold = fontWeight FontWeightUltraBold
  
  -- | Set all text using a heavy/black font weight.
  heavy :: HasStyle a => a -> a
  heavy = fontWeight FontWeightHeavy
  
  -- | Set all text to be bolder than the inherited font weight.
  bolder :: HasStyle a => a -> a
  bolder = fontWeight FontWeightBolder
  
  -- | Set all text to be lighter than the inherited font weight.
  lighter :: HasStyle a => a -> a
  lighter = fontWeight FontWeightLighter
  
  -- | Lens onto the font weight in a style.
  _fontWeight :: Lens' (Style v n) FontWeight
  _fontWeight = atAttr . non def
  