{- 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"