104 lines
2.8 KiB
Haskell
104 lines
2.8 KiB
Haskell
{- 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"
|