-- |
-- Module      :  Diagrams.Backend.Cairo.Text
-- Copyright   :  (c) 2015 Diagrams-cairo team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- This module provides convenience functions for querying information
-- from cairo.  In particular, this provides utilities for information
-- about fonts, and creating text primitives with bounds based on the
-- font being used. To render text with automatically determined
-- envelopes, use 'textLineBounded', 'textLineBoundedIO',
-- 'textVisualBounded', or 'textVisualBoundedIO'.
--
-- Many of these functions take a 'Style' 'V2' 'Double' parameter,
-- determining the style to apply to the text before rendering /
-- querying information about the text.  These 'Style' 'V2' 'Double'
-- parameters can be created a variety of ways, but the most direct
-- will likely be by applying style-transforming functions such as
-- 'font', 'fontSize', 'fontSlant', and 'fontWeight' to 'mempty'.
-- This works because there are instances of 'HasStyle' and 'Monoid'
-- for @'Style' v@.

module Diagrams.Backend.Cairo.Text
       (
         -- | These create diagrams instantiated with extent-based envelopes.
         textLineBoundedIO
       , textVisualBoundedIO

         -- * Utilities
       , queryCairo, unsafeCairo
       ) where

import           Diagrams.Backend.Cairo.Internal
import qualified Diagrams.BoundingBox            as BB
import           Diagrams.Prelude                hiding (height, view)
import           Diagrams.TwoD.Text              hiding (font)

import qualified Graphics.Rendering.Cairo        as C
import qualified Graphics.Rendering.Pango        as P

import           System.IO.Unsafe

-- | Executes a cairo action on a dummy, zero-size image surface, in order to
--   query things like font information.
queryCairo :: C.Render a -> IO a
queryCairo :: forall a. Render a -> IO a
queryCairo Render a
c = Format -> Int -> Int -> (Surface -> IO a) -> IO a
forall a. Format -> Int -> Int -> (Surface -> IO a) -> IO a
C.withImageSurface Format
C.FormatA1 Int
0 Int
0 (Surface -> Render a -> IO a
forall (m :: * -> *) a. MonadIO m => Surface -> Render a -> m a
`C.renderWith` Render a
c)

-- | Unsafely invokes 'queryCairo' using 'unsafePerformIO'.
unsafeCairo :: C.Render a -> a
unsafeCairo :: forall a. Render a -> a
unsafeCairo = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> (Render a -> IO a) -> Render a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Render a -> IO a
forall a. Render a -> IO a
queryCairo

-- | Creates text diagrams with their envelopes set such that using
--   @'vcat' . map ('textLineBounded' style)@ stacks them in the way that
--   the font designer intended.  Pango refers to this as logical extents.
textLineBoundedIO :: Style V2 Double -> Text Double -> IO (Diagram Cairo)
textLineBoundedIO :: Style V2 Double -> Text Double -> IO (Diagram Cairo)
textLineBoundedIO = ((PangoRectangle, PangoRectangle) -> PangoRectangle)
-> Style V2 Double -> Text Double -> IO (Diagram Cairo)
textLineIO (PangoRectangle, PangoRectangle) -> PangoRectangle
forall a b. (a, b) -> a
fst

-- | Creates a text diagram with its envelope set to enclose the glyphs of the text,
--   including leading (though not trailing) whitespace.
textVisualBoundedIO :: Style V2 Double -> Text Double -> IO (Diagram Cairo)
textVisualBoundedIO :: Style V2 Double -> Text Double -> IO (Diagram Cairo)
textVisualBoundedIO = ((PangoRectangle, PangoRectangle) -> PangoRectangle)
-> Style V2 Double -> Text Double -> IO (Diagram Cairo)
textLineIO (PangoRectangle, PangoRectangle) -> PangoRectangle
forall a b. (a, b) -> b
snd

-- | Abstract common code from @textLineBoundedIO@ and @textVisualBoundedIO@
-- textLineIO :: ((a,a) -> a) -> Style V2 Double -> Text Double -> IO (Diagram Cairo)
textLineIO :: ((P.PangoRectangle,P.PangoRectangle) -> P.PangoRectangle) -> Style V2 Double -> Text Double -> IO (Diagram Cairo)
textLineIO :: ((PangoRectangle, PangoRectangle) -> PangoRectangle)
-> Style V2 Double -> Text Double -> IO (Diagram Cairo)
textLineIO (PangoRectangle, PangoRectangle) -> PangoRectangle
pick Style V2 Double
sty Text Double
txt = do
    PangoLayout
layout <- Render PangoLayout -> IO PangoLayout
forall a. Render a -> IO a
queryCairo (Render PangoLayout -> IO PangoLayout)
-> Render PangoLayout -> IO PangoLayout
forall a b. (a -> b) -> a -> b
$ Style V2 Double -> Text Double -> Render PangoLayout
layoutStyledText Style V2 Double
sty Text Double
txt
    P.PangoRectangle Double
x Double
y  Double
w Double
h <- (PangoRectangle, PangoRectangle) -> PangoRectangle
pick ((PangoRectangle, PangoRectangle) -> PangoRectangle)
-> IO (PangoRectangle, PangoRectangle) -> IO PangoRectangle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PangoLayout -> IO (PangoRectangle, PangoRectangle)
P.layoutGetExtents PangoLayout
layout
    let bb :: BoundingBox V2 Double
bb = Point V2 Double -> Point V2 Double -> BoundingBox V2 Double
forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
Point v n -> Point v n -> BoundingBox v n
BB.fromCorners (Double -> Double -> Point V2 Double
forall n. n -> n -> P2 n
mkP2 Double
x Double
y) (Double -> Double -> Point V2 Double
forall n. n -> n -> P2 n
mkP2 (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
h))
    QDiagram Cairo V2 Double Any -> IO (QDiagram Cairo V2 Double Any)
forall (m :: * -> *) a. Monad m => a -> m a
return (QDiagram Cairo V2 Double Any -> IO (QDiagram Cairo V2 Double Any))
-> QDiagram Cairo V2 Double Any
-> IO (QDiagram Cairo V2 Double Any)
forall a b. (a -> b) -> a -> b
$ Prim Cairo V2 Double
-> Envelope V2 Double
-> Trace V2 Double
-> SubMap Cairo V2 Double Any
-> Query V2 Double Any
-> QDiagram Cairo V2 Double 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 Double -> Prim Cairo (V (Text Double)) (N (Text Double))
forall p b.
(Transformable p, Typeable p, Renderable p b) =>
p -> Prim b (V p) (N p)
Prim Text Double
txt) (BoundingBox V2 Double
-> Envelope (V (BoundingBox V2 Double)) (N (BoundingBox V2 Double))
forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope BoundingBox V2 Double
bb) Trace V2 Double
forall a. Monoid a => a
mempty SubMap Cairo V2 Double Any
forall a. Monoid a => a
mempty Query V2 Double Any
forall a. Monoid a => a
mempty