1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
{- This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Fountainhead.Metrics
( FontBBox(..)
, FontDescriptor(..)
, MetricsError(..)
, Number
, FontDescriptorFlag(..)
, collectMetrics
) where
import Data.ByteString (ByteString)
import Data.Text (Text)
import Graphics.Fountainhead.TrueType (findTableByTag)
import Graphics.Fountainhead.Parser
( ParseErrorBundle
, nameTableP
, parseFontDirectory
, parseTable
)
import qualified Text.Megaparsec as Megaparsec
type Number = Double
data FontDescriptorFlag
= FixedPitch
| Serif
| Symbolic
| Script
| Nonsymbolic
| Italic
| AllCap
| SmallCap
| ForceBold
deriving (Eq, Show)
instance Enum FontDescriptorFlag
where
toEnum 1 = FixedPitch
toEnum 2 = Serif
toEnum 3 = Symbolic
toEnum 4 = Script
toEnum 6 = Nonsymbolic
toEnum 7 = Italic
toEnum 17 = AllCap
toEnum 18 = SmallCap
toEnum 19 = ForceBold
toEnum _ = error "Font description flag is not supported."
fromEnum FixedPitch = 1
fromEnum Serif = 2
fromEnum Symbolic = 3
fromEnum Script = 4
fromEnum Nonsymbolic = 6
fromEnum Italic = 7
fromEnum AllCap = 17
fromEnum SmallCap = 18
fromEnum ForceBold = 19
data FontBBox = FontBBox Number Number Number Number
deriving (Eq, Show)
data FontDescriptor = FontDescriptor
{ fontName :: Text
, flags :: [FontDescriptorFlag]
, fullName :: Text
, familyName :: Text
, weight :: Text
, fontBBox :: FontBBox
, version :: Text
, notice :: Text
, encodingScheme :: Text
, isFixedPitch :: Bool
, ascender :: Number
, descender :: Number
} deriving (Eq, Show)
data MetricsError
= MetricsParseError ParseErrorBundle
| MetricsRequiredTableMissingError String
deriving Eq
instance Show MetricsError
where
show (MetricsParseError errorBundle) = Megaparsec.errorBundlePretty errorBundle
show (MetricsRequiredTableMissingError tableName) =
"Required table " <> tableName <> " is missing."
collectMetrics :: FilePath -> ByteString -> Either MetricsError FontDescriptor
collectMetrics fontFile ttfContents =
case parseFontDirectory fontFile ttfContents of
(_processedState, Left initialResult) -> Left
$ MetricsParseError initialResult
(processedState, Right initialResult)
| Just tableEntry <- findTableByTag "name" initialResult
, Right parsedNameTable <- parseTable tableEntry nameTableP processedState ->
pure $ FontDescriptor
{
}
| otherwise -> Left $ MetricsRequiredTableMissingError "name"
|
