module Diagrams.Backend.Cairo.Text
(
textLineBoundedIO
, textVisualBoundedIO
, 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
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)
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
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
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
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 a. a -> IO a
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