-- |
-- 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
    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 x y  w h <- pick <$> P.layoutGetExtents layout
    let 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))
    return $ mkQD (Prim txt) (getEnvelope bb) mempty mempty mempty