{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}

module Graphics.SVGFonts.Text
       ( -- * Setting text as a path using a font.
         TextOpts(..)
       , Spacing(..)

       , horizontalAdvances
       , isKern
       , characterStrings'

       , PreparedText(..)
       , prepare
       , draw_glyphs
       , shift_glyphs

       , svgText
       , svgText_raw
       , svgText_modifyPreglyphs
       , svgText_fitRect
       , svgText_fitRect_stretchySpace

       , textSVG
       ) where

import Control.Arrow (second)

import Data.Default.Class
import Diagrams.Prelude hiding (font, text, width, height, envelope)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import qualified Data.Text as T

import Graphics.SVGFonts.Fonts (lin)
import Graphics.SVGFonts.ReadFont
import Graphics.SVGFonts.CharReference (characterStrings)
import Graphics.SVGFonts.PathInRect (PathInRect(..), drop_rect, fit_height)

import System.IO.Unsafe (unsafePerformIO)

data TextOpts n = TextOpts
  { TextOpts n -> PreparedFont n
textFont   :: PreparedFont n
  , TextOpts n -> Spacing
spacing    :: Spacing
  , TextOpts n -> Bool
underline  :: Bool
  }

instance (Read n, RealFloat n) => Default (TextOpts n) where
  def :: TextOpts n
def = PreparedFont n -> Spacing -> Bool -> TextOpts n
forall n. PreparedFont n -> Spacing -> Bool -> TextOpts n
TextOpts (IO (PreparedFont n) -> PreparedFont n
forall a. IO a -> a
unsafePerformIO IO (PreparedFont n)
forall n. (Read n, RealFloat n) => IO (PreparedFont n)
lin) Spacing
KERN Bool
False

data PreparedText n = PreparedText
  { PreparedText n -> n
fontTop :: n  -- ^ y position of font top.
  , PreparedText n -> n
fontBottom :: n
  -- ^ y position of font bottom
  -- (usually negative unless the characters are fully above baseline).
  , PreparedText n -> [(String, n)]
preglyphs :: [(String, n)]
  -- Ligatures/singleton characters along with their advances (widths).
  }

-- | Break text into preglyphs (= ligatures and singleton characters) and
-- compute their advances.
prepare :: (RealFloat n) => TextOpts n -> String -> PreparedText n
prepare :: TextOpts n -> String -> PreparedText n
prepare TextOpts{Spacing
spacing :: Spacing
spacing :: forall n. TextOpts n -> Spacing
spacing, textFont :: forall n. TextOpts n -> PreparedFont n
textFont=(FontData n
fontD, OutlineMap n
_)} String
text =
  n -> n -> [(String, n)] -> PreparedText n
forall n. n -> n -> [(String, n)] -> PreparedText n
PreparedText (n
bottom n -> n -> n
forall a. Num a => a -> a -> a
+ FontData n -> n
forall n. RealFloat n => FontData n -> n
bbox_dy FontData n
fontD) n
bottom ([String] -> [n] -> [(String, n)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
preglyphs [n]
advances)
  where
    bottom :: n
bottom = FontData n -> n
forall n. FontData n -> n
bbox_ly FontData n
fontD
    preglyphs :: [String]
preglyphs = FontData n -> String -> [String]
forall n. FontData n -> String -> [String]
characterStrings' FontData n
fontD String
text
    advances :: [n]
advances = [String] -> FontData n -> Bool -> [n]
forall n. RealFloat n => [String] -> FontData n -> Bool -> [n]
horizontalAdvances [String]
preglyphs FontData n
fontD (Spacing -> Bool
isKern Spacing
spacing)

-- | Create a path (glyph) for each preglyph.
draw_glyphs :: (RealFloat n) => TextOpts n -> [(String, n)] -> [Path V2 n]
draw_glyphs :: TextOpts n -> [(String, n)] -> [Path V2 n]
draw_glyphs TextOpts{Bool
underline :: Bool
underline :: forall n. TextOpts n -> Bool
underline, textFont :: forall n. TextOpts n -> PreparedFont n
textFont=(FontData n
fontD, OutlineMap n
outl)} [(String, n)]
preglyphs =
  ((String, n) -> Path V2 n) -> [(String, n)] -> [Path V2 n]
forall a b. (a -> b) -> [a] -> [b]
map (String, n) -> Path V2 n
polygonChar [(String, n)]
preglyphs
  where
    ulinePos :: n
ulinePos = FontData n -> n
forall n. FontData n -> n
underlinePosition FontData n
fontD
    ulineThickness :: n
ulineThickness = FontData n -> n
forall n. FontData n -> n
underlineThickness FontData n
fontD

    polygonChar :: (String, n) -> Path V2 n
polygonChar (String
ch, n
a) = Path V2 n -> Maybe (Path V2 n) -> Path V2 n
forall a. a -> Maybe a -> a
fromMaybe Path V2 n
forall a. Monoid a => a
mempty (String -> OutlineMap n -> Maybe (Path V2 n)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
ch OutlineMap n
outl) Path V2 n -> Path V2 n -> Path V2 n
forall a. Semigroup a => a -> a -> a
<> n -> Path V2 n
underlineChar n
a
    underlineChar :: n -> Path V2 n
underlineChar n
a
      | Bool
underline = n -> Path V2 n -> Path V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX (n
an -> n -> n
forall a. Fractional a => a -> a -> a
/n
2) (Path V2 n -> Path V2 n) -> Path V2 n -> Path V2 n
forall a b. (a -> b) -> a -> b
$ n -> Path V2 n -> Path V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
n -> t -> t
translateY n
ulinePos (n -> n -> Path V2 n
forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect n
a n
ulineThickness)
      | Bool
otherwise = Path V2 n
forall a. Monoid a => a
mempty

-- | Position glyphs according to their advances.
shift_glyphs :: (RealFloat n) => [(n, Path V2 n)] -> [Path V2 n]
shift_glyphs :: [(n, Path V2 n)] -> [Path V2 n]
shift_glyphs ([(n, Path V2 n)] -> ([n], [Path V2 n])
forall a b. [(a, b)] -> ([a], [b])
unzip -> ([n]
advs, [Path V2 n]
glyphs)) = (n -> Path V2 n -> Path V2 n) -> [n] -> [Path V2 n] -> [Path V2 n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> Path V2 n -> Path V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX [n]
hor_positions [Path V2 n]
glyphs
  where hor_positions :: [n]
hor_positions = (n -> n -> n) -> n -> [n] -> [n]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl n -> n -> n
forall a. Num a => a -> a -> a
(+) n
0 [n]
advs

-- | Simply render path from text.
svgText_raw :: (RealFloat n) => TextOpts n -> String -> Path V2 n
svgText_raw :: TextOpts n -> String -> Path V2 n
svgText_raw TextOpts n
topts String
text = PathInRect n -> Path V2 n
forall n. RealFloat n => PathInRect n -> Path V2 n
drop_rect(PathInRect n -> Path V2 n) -> PathInRect n -> Path V2 n
forall a b. (a -> b) -> a -> b
$ TextOpts n -> String -> PathInRect n
forall n. RealFloat n => TextOpts n -> String -> PathInRect n
svgText TextOpts n
topts String
text

-- | Render 'PathInRect' from text. The enclosing rectangle, computed from the
-- font, is kept, to be able to e.g. correctly position lines of text one above other.
svgText :: (RealFloat n) => TextOpts n -> String -> PathInRect n
svgText :: TextOpts n -> String -> PathInRect n
svgText TextOpts n
topts String
text = n -> n -> n -> n -> Path V2 n -> PathInRect n
forall n. n -> n -> n -> n -> Path V2 n -> PathInRect n
PathInRect n
0 n
fontBottom ([n] -> n
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [n]
advs) n
fontTop(Path V2 n -> PathInRect n) -> Path V2 n -> PathInRect n
forall a b. (a -> b) -> a -> b
$
  [Path V2 n] -> Path V2 n
forall a. Monoid a => [a] -> a
mconcat([Path V2 n] -> Path V2 n) -> [Path V2 n] -> Path V2 n
forall a b. (a -> b) -> a -> b
$ [(n, Path V2 n)] -> [Path V2 n]
forall n. RealFloat n => [(n, Path V2 n)] -> [Path V2 n]
shift_glyphs([(n, Path V2 n)] -> [Path V2 n])
-> [(n, Path V2 n)] -> [Path V2 n]
forall a b. (a -> b) -> a -> b
$ [n] -> [Path V2 n] -> [(n, Path V2 n)]
forall a b. [a] -> [b] -> [(a, b)]
zip [n]
advs [Path V2 n]
glyphs
  where
    PreparedText{n
fontTop :: n
fontTop :: forall n. PreparedText n -> n
fontTop, n
fontBottom :: n
fontBottom :: forall n. PreparedText n -> n
fontBottom, [(String, n)]
preglyphs :: [(String, n)]
preglyphs :: forall n. PreparedText n -> [(String, n)]
preglyphs} = TextOpts n -> String -> PreparedText n
forall n. RealFloat n => TextOpts n -> String -> PreparedText n
prepare TextOpts n
topts String
text
    advs :: [n]
advs = ((String, n) -> n) -> [(String, n)] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (String, n) -> n
forall a b. (a, b) -> b
snd [(String, n)]
preglyphs
    glyphs :: [Path V2 n]
glyphs = TextOpts n -> [(String, n)] -> [Path V2 n]
forall n. RealFloat n => TextOpts n -> [(String, n)] -> [Path V2 n]
draw_glyphs TextOpts n
topts [(String, n)]
preglyphs

-- | Like 'svgText' but preglyphs can be modified using the given monad before
-- 'draw_glyphs' is called. Simple examples of this function's specializations are e.g.
-- 'svgText_fitRect' and 'svgText_fitRect_stretchySpace'.
svgText_modifyPreglyphs :: (RealFloat n, Monad m) =>
  TextOpts n -> (PreparedText n -> m [(String, n)]) -> String -> m (PathInRect n)
svgText_modifyPreglyphs :: TextOpts n
-> (PreparedText n -> m [(String, n)])
-> String
-> m (PathInRect n)
svgText_modifyPreglyphs TextOpts n
topts PreparedText n -> m [(String, n)]
modif String
text = do
  [(String, n)]
preglyphs <- PreparedText n -> m [(String, n)]
modif PreparedText n
prep
  let advs :: [n]
advs = ((String, n) -> n) -> [(String, n)] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (String, n) -> n
forall a b. (a, b) -> b
snd [(String, n)]
preglyphs
      glyphs :: [Path V2 n]
glyphs = TextOpts n -> [(String, n)] -> [Path V2 n]
forall n. RealFloat n => TextOpts n -> [(String, n)] -> [Path V2 n]
draw_glyphs TextOpts n
topts [(String, n)]
preglyphs
  PathInRect n -> m (PathInRect n)
forall (m :: * -> *) a. Monad m => a -> m a
return(PathInRect n -> m (PathInRect n))
-> PathInRect n -> m (PathInRect n)
forall a b. (a -> b) -> a -> b
$ n -> n -> n -> n -> Path V2 n -> PathInRect n
forall n. n -> n -> n -> n -> Path V2 n -> PathInRect n
PathInRect n
0 n
fontBottom ([n] -> n
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [n]
advs) n
fontTop(Path V2 n -> PathInRect n) -> Path V2 n -> PathInRect n
forall a b. (a -> b) -> a -> b
$
    [Path V2 n] -> Path V2 n
forall a. Monoid a => [a] -> a
mconcat([Path V2 n] -> Path V2 n) -> [Path V2 n] -> Path V2 n
forall a b. (a -> b) -> a -> b
$ [(n, Path V2 n)] -> [Path V2 n]
forall n. RealFloat n => [(n, Path V2 n)] -> [Path V2 n]
shift_glyphs([(n, Path V2 n)] -> [Path V2 n])
-> [(n, Path V2 n)] -> [Path V2 n]
forall a b. (a -> b) -> a -> b
$ [n] -> [Path V2 n] -> [(n, Path V2 n)]
forall a b. [a] -> [b] -> [(a, b)]
zip [n]
advs [Path V2 n]
glyphs
  where
    prep :: PreparedText n
prep@PreparedText{n
fontTop :: n
fontTop :: forall n. PreparedText n -> n
fontTop, n
fontBottom :: n
fontBottom :: forall n. PreparedText n -> n
fontBottom} = TextOpts n -> String -> PreparedText n
forall n. RealFloat n => TextOpts n -> String -> PreparedText n
prepare TextOpts n
topts String
text

-- | Like 'svgText' but a rectangle is provided, into which the text will
-- fit. The text is scaled according to the height of the rectengle. The glyphs
-- are interleaved with even spaces to fit the width of the rectangle. The text
-- must have at least two characters for correct functionality.
svgText_fitRect :: forall n. (RealFloat n) =>
  TextOpts n -> (n, n) -> String -> (PathInRect n)
svgText_fitRect :: TextOpts n -> (n, n) -> String -> PathInRect n
svgText_fitRect TextOpts n
topts (n
desired_width, n
desired_height) String
text =
  n -> PathInRect n -> PathInRect n
forall n. RealFloat n => n -> PathInRect n -> PathInRect n
fit_height n
desired_height(PathInRect n -> PathInRect n) -> PathInRect n -> PathInRect n
forall a b. (a -> b) -> a -> b
$ Identity (PathInRect n) -> PathInRect n
forall a. Identity a -> a
runIdentity(Identity (PathInRect n) -> PathInRect n)
-> Identity (PathInRect n) -> PathInRect n
forall a b. (a -> b) -> a -> b
$ TextOpts n
-> (PreparedText n -> Identity [(String, n)])
-> String
-> Identity (PathInRect n)
forall n (m :: * -> *).
(RealFloat n, Monad m) =>
TextOpts n
-> (PreparedText n -> m [(String, n)])
-> String
-> m (PathInRect n)
svgText_modifyPreglyphs TextOpts n
topts PreparedText n -> Identity [(String, n)]
modif String
text
  where
    modif :: PreparedText n -> Identity [(String, n)]
    modif :: PreparedText n -> Identity [(String, n)]
modif PreparedText{n
fontTop :: n
fontTop :: forall n. PreparedText n -> n
fontTop, n
fontBottom :: n
fontBottom :: forall n. PreparedText n -> n
fontBottom, [(String, n)]
preglyphs :: [(String, n)]
preglyphs :: forall n. PreparedText n -> [(String, n)]
preglyphs} =
      [(String, n)] -> Identity [(String, n)]
forall (m :: * -> *) a. Monad m => a -> m a
return([(String, n)] -> Identity [(String, n)])
-> [(String, n)] -> Identity [(String, n)]
forall a b. (a -> b) -> a -> b
$ ((String, n) -> (String, n)) -> [(String, n)] -> [(String, n)]
forall a b. (a -> b) -> [a] -> [b]
map ((n -> n) -> (String, n) -> (String, n)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (n -> n -> n
forall a. Num a => a -> a -> a
+ n
addition)) ([(String, n)] -> [(String, n)]
forall a. [a] -> [a]
init [(String, n)]
preglyphs) [(String, n)] -> [(String, n)] -> [(String, n)]
forall a. [a] -> [a] -> [a]
++ [[(String, n)] -> (String, n)
forall a. [a] -> a
last [(String, n)]
preglyphs]
      where
        scale_ :: n
scale_ = n
desired_height n -> n -> n
forall a. Fractional a => a -> a -> a
/ (n
fontTop n -> n -> n
forall a. Num a => a -> a -> a
- n
fontBottom)

        advs :: [n]
advs = ((String, n) -> n) -> [(String, n)] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (String, n) -> n
forall a b. (a, b) -> b
snd [(String, n)]
preglyphs

        width :: n
width = [n] -> n
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([n] -> [n]
forall a. [a] -> [a]
init [n]
advs)
        desired_width' :: n
desired_width' = n
desired_width n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
scale_ n -> n -> n
forall a. Num a => a -> a -> a
- [n] -> n
forall a. [a] -> a
last [n]
advs

        addition :: n
addition = (n
desired_width' n -> n -> n
forall a. Num a => a -> a -> a
- n
width) n -> n -> n
forall a. Fractional a => a -> a -> a
/ Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([n] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [n]
advs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Like 'svgText_fitRect' but space characters are stretched @k@ times more
-- than others for @svgText_fitRect_stretchySpace opts (w, h) k text@.
svgText_fitRect_stretchySpace :: forall n. (RealFloat n) =>
  TextOpts n -> (n, n) -> n -> String -> (PathInRect n)
svgText_fitRect_stretchySpace :: TextOpts n -> (n, n) -> n -> String -> PathInRect n
svgText_fitRect_stretchySpace
  TextOpts n
topts
  (n
desired_width, n
desired_height)
  n
space_flexibility
  String
text
  =
  n -> PathInRect n -> PathInRect n
forall n. RealFloat n => n -> PathInRect n -> PathInRect n
fit_height n
desired_height(PathInRect n -> PathInRect n) -> PathInRect n -> PathInRect n
forall a b. (a -> b) -> a -> b
$ Identity (PathInRect n) -> PathInRect n
forall a. Identity a -> a
runIdentity(Identity (PathInRect n) -> PathInRect n)
-> Identity (PathInRect n) -> PathInRect n
forall a b. (a -> b) -> a -> b
$ TextOpts n
-> (PreparedText n -> Identity [(String, n)])
-> String
-> Identity (PathInRect n)
forall n (m :: * -> *).
(RealFloat n, Monad m) =>
TextOpts n
-> (PreparedText n -> m [(String, n)])
-> String
-> m (PathInRect n)
svgText_modifyPreglyphs TextOpts n
topts PreparedText n -> Identity [(String, n)]
modif String
text
  where
    modif :: PreparedText n -> Identity [(String, n)]
    modif :: PreparedText n -> Identity [(String, n)]
modif PreparedText{n
fontTop :: n
fontTop :: forall n. PreparedText n -> n
fontTop, n
fontBottom :: n
fontBottom :: forall n. PreparedText n -> n
fontBottom, [(String, n)]
preglyphs :: [(String, n)]
preglyphs :: forall n. PreparedText n -> [(String, n)]
preglyphs} =
      [(String, n)] -> Identity [(String, n)]
forall (m :: * -> *) a. Monad m => a -> m a
return([(String, n)] -> Identity [(String, n)])
-> [(String, n)] -> Identity [(String, n)]
forall a b. (a -> b) -> a -> b
$ [(String, n)]
scaled_preglyphs' [(String, n)] -> [(String, n)] -> [(String, n)]
forall a. [a] -> [a] -> [a]
++ [(String, n)
last_preglyph]
      where
        scale_ :: n
scale_ = n
desired_height n -> n -> n
forall a. Fractional a => a -> a -> a
/ (n
fontTop n -> n -> n
forall a. Num a => a -> a -> a
- n
fontBottom)

        scaled_preglyphs :: [(String, n)]
scaled_preglyphs = [(String, n)] -> [(String, n)]
forall a. [a] -> [a]
init [(String, n)]
preglyphs
        last_preglyph :: (String, n)
last_preglyph = [(String, n)] -> (String, n)
forall a. [a] -> a
last [(String, n)]
preglyphs

        width :: n
width = [n] -> n
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum([n] -> n) -> [n] -> n
forall a b. (a -> b) -> a -> b
$ ((String, n) -> n) -> [(String, n)] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (String, n) -> n
forall a b. (a, b) -> b
snd [(String, n)]
scaled_preglyphs
        desired_width' :: n
desired_width' = n
desired_width n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
scale_ n -> n -> n
forall a. Num a => a -> a -> a
- (String, n) -> n
forall a b. (a, b) -> b
snd (String, n)
last_preglyph

        width_diff :: n
width_diff = n
desired_width' n -> n -> n
forall a. Num a => a -> a -> a
- n
width

        weight :: String -> n
weight String
" " = n
space_flexibility
        weight String
_ = n
1

        weights :: [n]
weights = (String -> n) -> [String] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map String -> n
weight([String] -> [n]) -> [String] -> [n]
forall a b. (a -> b) -> a -> b
$ ((String, n) -> String) -> [(String, n)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, n) -> String
forall a b. (a, b) -> a
fst([(String, n)] -> [String]) -> [(String, n)] -> [String]
forall a b. (a -> b) -> a -> b
$ [(String, n)] -> [(String, n)]
forall a. [a] -> [a]
init [(String, n)]
preglyphs
        additions :: [n]
additions = (n -> n) -> [n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (n -> n -> n
forall a. Num a => a -> a -> a
*n
coef) [n]
weights
          where coef :: n
coef = n
width_diff n -> n -> n
forall a. Fractional a => a -> a -> a
/ [n] -> n
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [n]
weights

        scaled_preglyphs' :: [(String, n)]
scaled_preglyphs' =
          (n -> (String, n) -> (String, n))
-> [n] -> [(String, n)] -> [(String, n)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\n
add (String
c, n
adv) -> (String
c, n
adv n -> n -> n
forall a. Num a => a -> a -> a
+ n
add)) [n]
additions [(String, n)]
scaled_preglyphs

characterStrings' :: FontData n -> String -> [String]
characterStrings' :: FontData n -> String -> [String]
characterStrings' FontData n
fontD = \String
text -> (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String]) -> [Text] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [Text]
characterStrings String
text [String]
ligatures
  where ligatures :: [String]
ligatures = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
1) (Int -> Bool) -> (String -> Int) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([String] -> [String])
-> (FontData n -> [String]) -> FontData n -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String (String, n, String) -> [String]
forall k a. Map k a -> [k]
Map.keys (Map String (String, n, String) -> [String])
-> (FontData n -> Map String (String, n, String))
-> FontData n
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontData n -> Map String (String, n, String)
forall n. FontData n -> SvgGlyphs n
fontDataGlyphs(FontData n -> [String]) -> FontData n -> [String]
forall a b. (a -> b) -> a -> b
$ FontData n
fontD


-- | See <http://en.wikipedia.org/wiki/Kerning>
--
data Spacing = HADV -- ^ Every glyph has a unique horiz. advance
                    --
                    --  <<diagrams/src_Graphics_SVGFonts_ReadFont_textHADV.svg#diagram=textHADV&width=400>>
             | KERN -- ^ Recommended, same as HADV but sometimes overridden by kerning:
                    -- As You can see there is less space between \"A\" and \"V\":
                    --
                    --   <<diagrams/src_Graphics_SVGFonts_ReadFont_textKern.svg#diagram=textKern&width=400>>
             deriving Int -> Spacing -> ShowS
[Spacing] -> ShowS
Spacing -> String
(Int -> Spacing -> ShowS)
-> (Spacing -> String) -> ([Spacing] -> ShowS) -> Show Spacing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Spacing] -> ShowS
$cshowList :: [Spacing] -> ShowS
show :: Spacing -> String
$cshow :: Spacing -> String
showsPrec :: Int -> Spacing -> ShowS
$cshowsPrec :: Int -> Spacing -> ShowS
Show


isKern :: Spacing -> Bool
isKern :: Spacing -> Bool
isKern Spacing
KERN = Bool
True
isKern Spacing
_    = Bool
False


-- | Horizontal advances of characters inside a string.
-- A character is stored with a string (because of ligatures like \"ffi\").
horizontalAdvances :: RealFloat n => [String] -> FontData n -> Bool -> [n]
horizontalAdvances :: [String] -> FontData n -> Bool -> [n]
horizontalAdvances []          FontData n
_  Bool
_       = []
horizontalAdvances [String
ch]        FontData n
fd Bool
_       = [String -> FontData n -> n
forall n. String -> FontData n -> n
horizontalAdvance String
ch FontData n
fd]
horizontalAdvances (String
ch0:String
ch1:[String]
s) FontData n
fd Bool
kerning =
  ((String -> FontData n -> n
forall n. String -> FontData n -> n
horizontalAdvance String
ch0 FontData n
fd) n -> n -> n
forall a. Num a => a -> a -> a
- (Kern n -> n
ka (FontData n -> Kern n
forall n. FontData n -> Kern n
fontDataKerning FontData n
fd)))
  n -> [n] -> [n]
forall a. a -> [a] -> [a]
: ([String] -> FontData n -> Bool -> [n]
forall n. RealFloat n => [String] -> FontData n -> Bool -> [n]
horizontalAdvances (String
ch1String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
s) FontData n
fd Bool
kerning)
  where ka :: Kern n -> n
ka Kern n
kern | Bool
kerning   = (String -> String -> Kern n -> Bool -> n
forall n. RealFloat n => String -> String -> Kern n -> Bool -> n
kernAdvance String
ch0 String
ch1 Kern n
kern Bool
True) n -> n -> n
forall a. Num a => a -> a -> a
+ (String -> String -> Kern n -> Bool -> n
forall n. RealFloat n => String -> String -> Kern n -> Bool -> n
kernAdvance String
ch0 String
ch1 Kern n
kern Bool
False)
                | Bool
otherwise = n
0


------------------------ Backward Compatibility Layer ------------------------

textSVG :: (Read n, RealFloat n) => String -> n -> Path V2 n
textSVG :: String -> n -> Path V2 n
textSVG String
text n
height = PathInRect n -> Path V2 n
forall n. RealFloat n => PathInRect n -> Path V2 n
drop_rect(PathInRect n -> Path V2 n) -> PathInRect n -> Path V2 n
forall a b. (a -> b) -> a -> b
$ n -> PathInRect n -> PathInRect n
forall n. RealFloat n => n -> PathInRect n -> PathInRect n
fit_height n
height(PathInRect n -> PathInRect n) -> PathInRect n -> PathInRect n
forall a b. (a -> b) -> a -> b
$ TextOpts n -> String -> PathInRect n
forall n. RealFloat n => TextOpts n -> String -> PathInRect n
svgText TextOpts n
forall a. Default a => a
def String
text