module Diagrams.SVG.Fonts.ReadFont
(
FontData(..)
, FontFace(..)
, Kern(..)
, KernDir(..)
, FontContent(..)
, parseBBox
, kernMap
, horizontalAdvance
, OutlineMap
, PreparedFont
) where
import Data.Char (isSpace)
import Data.List (intersect, sortBy)
import Data.List.Split (splitOn, splitWhen)
import qualified Data.HashMap.Strict as H
import Data.Maybe (catMaybes, fromJust, fromMaybe,
isJust, isNothing, maybeToList)
import qualified Data.Text as T
import Data.Text (Text(..), pack, unpack, empty, words)
import Data.Text.Read (double)
import Data.Vector (Vector)
import qualified Data.Vector as V
import Diagrams.Path
import Diagrams.Prelude hiding (font)
import Diagrams.SVG.Fonts.CharReference (charsFromFullName)
import Diagrams.SVG.Path
import Diagrams.SVG.Tree
kernMap :: [Kern n] -> KernMaps n
kernMap :: forall n. [Kern n] -> KernMaps n
kernMap [Kern n]
kernlist = forall n.
[KernDir]
-> HashMap Text [Int]
-> HashMap Text [Int]
-> HashMap Text [Int]
-> HashMap Text [Int]
-> Vector n
-> KernMaps n
KernMaps [] forall k v. HashMap k v
H.empty forall k v. HashMap k v
H.empty forall k v. HashMap k v
H.empty forall k v. HashMap k v
H.empty forall a. Vector a
V.empty
where
transformChars :: [[[Char]]] -> HashMap [Char] [a]
transformChars [[[Char]]]
chars = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {b}. ([Char], b) -> ([Char], b)
ch forall a b. (a -> b) -> a -> b
$ forall {a} {a}. Eq a => [(a, [a])] -> [(a, [a])]
multiSet forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\([Char]
x,a
y) -> ([Char]
x,[a
y])) forall a b. (a -> b) -> a -> b
$ forall {a} {t}. Ord a => (t -> a) -> [t] -> [t]
sort forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall {b} {a}. (Num b, Enum b) => [[a]] -> [[(a, b)]]
addIndex [[[Char]]]
chars
ch :: ([Char], b) -> ([Char], b)
ch ([Char]
x,b
y) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
x = ([Char]
"",b
y)
| Bool
otherwise = ([Char]
x,b
y)
addIndex :: [[a]] -> [[(a, b)]]
addIndex [[a]]
qs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\b
x [a]
y -> (forall a b. (a -> b) -> [a] -> [b]
map (\a
z -> (a
z,b
x)) [a]
y)) [b
0..] [[a]]
qs
sort :: (t -> a) -> [t] -> [t]
sort t -> a
f [t]
xs = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\t
x t
y -> forall a. Ord a => a -> a -> Ordering
compare (t -> a
f t
x) (t -> a
f t
y) ) [t]
xs
multiSet :: [(a, [a])] -> [(a, [a])]
multiSet [] = []
multiSet ((a, [a])
a:[]) = [(a, [a])
a]
multiSet ((a, [a])
a:(a, [a])
b:[(a, [a])]
bs) | forall a b. (a, b) -> a
fst (a, [a])
a forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> a
fst (a, [a])
b = [(a, [a])] -> [(a, [a])]
multiSet ( (forall a b. (a, b) -> a
fst (a, [a])
a, (forall a b. (a, b) -> b
snd (a, [a])
a) forall a. [a] -> [a] -> [a]
++ (forall a b. (a, b) -> b
snd (a, [a])
b)) forall a. a -> [a] -> [a]
: [(a, [a])]
bs)
| Bool
otherwise = (a, [a])
a forall a. a -> [a] -> [a]
: ([(a, [a])] -> [(a, [a])]
multiSet ((a, [a])
bforall a. a -> [a] -> [a]
:[(a, [a])]
bs))
fname :: [Char] -> [Char]
fname [Char]
f = forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
"/") (forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [Char]
"." [Char]
f))
parseBBox :: (Read n, RealFloat n) => Maybe Text -> [n]
parseBBox :: forall n. (Read n, RealFloat n) => Maybe Text -> [n]
parseBBox Maybe Text
bbox = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((forall a b. (a -> b) -> [a] -> [b]
map Text -> n
convertToN) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words) Maybe Text
bbox
where convertToN :: Text -> n
convertToN = forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Double
0) forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader Double
double
horizontalAdvance :: RealFloat n => Text -> FontData b n -> n
horizontalAdvance :: forall n b. RealFloat n => Text -> FontData b n -> n
horizontalAdvance Text
ch FontData b n
fontD
| forall a. Maybe a -> Bool
isJust Maybe (Maybe Text, n, Maybe Text)
char = (\(Maybe Text
a,n
b,Maybe Text
c) -> n
b) (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Maybe Text, n, Maybe Text)
char)
| Bool
otherwise = forall b n. FontData b n -> n
fontDataHorizontalAdvance FontData b n
fontD
where char :: Maybe (Maybe Text, n, Maybe Text)
char = (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
ch (forall b n. FontData b n -> SvgGlyphs n
fontDataGlyphs FontData b n
fontD))
type OutlineMap n = H.HashMap Text (Path V2 n)
type ErrorMap = H.HashMap Text Text
type PreparedFont b n = (FontData b n, OutlineMap n)
outlineMap :: (Read n, Show n, RealFloat n) =>
FontData b n -> (OutlineMap n, ErrorMap)
outlineMap :: forall n b.
(Read n, Show n, RealFloat n) =>
FontData b n -> (OutlineMap n, ErrorMap)
outlineMap FontData b n
fontData =
( forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList [(Text
ch, Path V2 n
outl) | (Text
ch, Right Path V2 n
outl) <- [(Text, Either Text (Path V2 n))]
allOutlines]
, forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList [(Text
ch, Text
err) | (Text
ch, Left Text
err) <- [(Text, Either Text (Path V2 n))]
allOutlines]
)
where
allUnicodes :: [Text]
allUnicodes = forall k v. HashMap k v -> [k]
H.keys (forall b n. FontData b n -> SvgGlyphs n
fontDataGlyphs FontData b n
fontData)
outlines :: Text -> m (Path V2 n)
outlines Text
ch = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall n. (RealFloat n, Show n) => [PathCommand n] -> [Path V2 n]
commandsToPaths (forall n. RealFloat n => Text -> SvgGlyphs n -> [PathCommand n]
commandsFromChar Text
ch (forall b n. FontData b n -> SvgGlyphs n
fontDataGlyphs FontData b n
fontData))
allOutlines :: [(Text, Either Text (Path V2 n))]
allOutlines = [(Text
ch, forall {m :: * -> *}. Monad m => Text -> m (Path V2 n)
outlines Text
ch) | Text
ch <- [Text]
allUnicodes]
prepareFont :: (Read n, Show n, RealFloat n) =>
FontData b n -> (PreparedFont b n, ErrorMap)
prepareFont :: forall n b.
(Read n, Show n, RealFloat n) =>
FontData b n -> (PreparedFont b n, ErrorMap)
prepareFont FontData b n
fontData = ((FontData b n
fontData, OutlineMap n
outlines), ErrorMap
errs)
where
(OutlineMap n
outlines, ErrorMap
errs) = forall n b.
(Read n, Show n, RealFloat n) =>
FontData b n -> (OutlineMap n, ErrorMap)
outlineMap FontData b n
fontData
commandsFromChar :: RealFloat n => Text -> SvgGlyphs n -> [PathCommand n]
commandsFromChar :: forall n. RealFloat n => Text -> SvgGlyphs n -> [PathCommand n]
commandsFromChar Text
ch SvgGlyphs n
glyph = case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
ch SvgGlyphs n
glyph of
Maybe (Maybe Text, n, Maybe Text)
Nothing -> []