{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}
module Diagrams.Backend.Rasterific.Text
( texterific'
, texterific
, fromFontStyle
, textBoundingBox
) where
import Graphics.Text.TrueType hiding (BoundingBox)
import Diagrams.Prelude
import Diagrams.TwoD.Text hiding (Font)
import Data.FileEmbed (embedDir)
import Data.ByteString (ByteString)
import Data.ByteString.Lazy (fromStrict)
textBoundingBox :: RealFloat n => Font -> PointSize -> String -> BoundingBox V2 n
textBoundingBox :: forall n.
RealFloat n =>
Font -> PointSize -> String -> BoundingBox V2 n
textBoundingBox Font
f PointSize
p String
s = forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
Point v n -> Point v n -> BoundingBox v n
fromCorners
(forall n. n -> n -> P2 n
mkP2 (n
2forall a. Num a => a -> a -> a
*(BoundingBox -> Float) -> BoundingBox -> n
r2f BoundingBox -> Float
_xMin BoundingBox
bb) ((BoundingBox -> Float) -> BoundingBox -> n
r2f BoundingBox -> Float
_yMin BoundingBox
bb))
(forall n. n -> n -> P2 n
mkP2 ((BoundingBox -> Float) -> BoundingBox -> n
r2f BoundingBox -> Float
_xMax BoundingBox
bb forall a. Num a => a -> a -> a
+ (BoundingBox -> Float) -> BoundingBox -> n
r2f BoundingBox -> Float
_xMin BoundingBox
bb) ((BoundingBox -> Float) -> BoundingBox -> n
r2f BoundingBox -> Float
_yMax BoundingBox
bb))
where
r2f :: (BoundingBox -> Float) -> BoundingBox -> n
r2f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Real a, Fractional b) => a -> b
realToFrac
bb :: BoundingBox
bb = Font -> Dpi -> PointSize -> String -> BoundingBox
stringBoundingBox Font
f Dpi
96 PointSize
p String
s
texterific' :: (TypeableFloat n, Renderable (Text n) b)
=> FontSlant -> FontWeight -> String -> QDiagram b V2 n Any
texterific' :: forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
FontSlant -> FontWeight -> String -> QDiagram b V2 n Any
texterific' FontSlant
fs FontWeight
fw String
s = forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
recommendFillColor forall a. Num a => Colour a
black forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a n. (N a ~ n, Typeable n, Num n, HasStyle a) => n -> a -> a
fontSizeL n
1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasStyle a => FontSlant -> a -> a
fontSlant FontSlant
fs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasStyle a => FontWeight -> a -> a
fontWeight FontWeight
fw
forall a b. (a -> b) -> a -> b
$ 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 (forall p b.
(Transformable p, Typeable p, Renderable p b) =>
p -> Prim b (V p) (N p)
Prim forall a b. (a -> b) -> a -> b
$ forall n. T2 n -> TextAlignment n -> String -> Text n
Text forall a. Monoid a => a
mempty forall n. TextAlignment n
BaselineText String
s)
(forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope BoundingBox V2 n
bb)
(forall a. Traced a => a -> Trace (V a) (N a)
getTrace BoundingBox V2 n
bb)
forall a. Monoid a => a
mempty
(forall t m. HasQuery t m => t -> Query (V t) (N t) m
getQuery BoundingBox V2 n
bb)
where
bb :: BoundingBox V2 n
bb = forall n.
RealFloat n =>
Font -> PointSize -> String -> BoundingBox V2 n
textBoundingBox Font
fnt (Float -> PointSize
PointSize Float
1) String
s
fnt :: Font
fnt = FontSlant -> FontWeight -> Font
fromFontStyle FontSlant
fs FontWeight
fw
texterific :: (TypeableFloat n, Renderable (Text n) b) => String -> QDiagram b V2 n Any
texterific :: forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
String -> QDiagram b V2 n Any
texterific String
s = forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
FontSlant -> FontWeight -> String -> QDiagram b V2 n Any
texterific' FontSlant
FontSlantNormal FontWeight
FontWeightNormal String
s
fromFontStyle :: FontSlant -> FontWeight -> Font
fromFontStyle :: FontSlant -> FontWeight -> Font
fromFontStyle FontSlant
FontSlantItalic FontWeight
FontWeightBold = Font
openSansBoldItalic
fromFontStyle FontSlant
FontSlantOblique FontWeight
FontWeightBold = Font
openSansBoldItalic
fromFontStyle FontSlant
FontSlantNormal FontWeight
FontWeightBold = Font
openSansBold
fromFontStyle FontSlant
FontSlantItalic FontWeight
FontWeightNormal = Font
openSansItalic
fromFontStyle FontSlant
FontSlantOblique FontWeight
FontWeightNormal = Font
openSansItalic
fromFontStyle FontSlant
_ FontWeight
_ = Font
openSansRegular
fonts :: [(FilePath,ByteString)]
fonts :: [(String, ByteString)]
fonts = $(embedDir "fonts")
staticFont :: String -> Font
staticFont :: String -> Font
staticFont String
nm = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
nm [(String, ByteString)]
fonts of
Maybe ByteString
Nothing -> forall a. HasCallStack => String -> a
error (String
"Font not found: " forall a. [a] -> [a] -> [a]
++ String
nm)
Just ByteString
f -> case ByteString -> Either String Font
decodeFont (ByteString -> ByteString
fromStrict ByteString
f) of
Right Font
r -> Font
r
Left String
e -> forall a. HasCallStack => String -> a
error String
e
openSansRegular :: Font
openSansRegular :: Font
openSansRegular = String -> Font
staticFont String
"OpenSans-Regular.ttf"
openSansBold :: Font
openSansBold :: Font
openSansBold = String -> Font
staticFont String
"OpenSans-Bold.ttf"
openSansItalic :: Font
openSansItalic :: Font
openSansItalic = String -> Font
staticFont String
"OpenSans-Italic.ttf"
openSansBoldItalic :: Font
openSansBoldItalic :: Font
openSansBoldItalic = String -> Font
staticFont String
"OpenSans-BoldItalic.ttf"