summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Graphics/Fountainhead/Dumper.hs57
-rw-r--r--src/Graphics/Fountainhead/Parser.hs13
-rw-r--r--src/Graphics/Fountainhead/TrueType.hs18
-rw-r--r--src/Graphics/Fountainhead/Type.hs7
4 files changed, 70 insertions, 25 deletions
diff --git a/src/Graphics/Fountainhead/Dumper.hs b/src/Graphics/Fountainhead/Dumper.hs
index f09469d..e5bf6e7 100644
--- a/src/Graphics/Fountainhead/Dumper.hs
+++ b/src/Graphics/Fountainhead/Dumper.hs
@@ -32,7 +32,9 @@ import GHC.Records (HasField(..))
import Graphics.Fountainhead.TrueType
( CmapTable(..)
, FontDirectory(..)
+ , FontDirectionHint(..)
, HeadTable(..)
+ , HheaTable(..)
, OffsetSubtable(..)
, TableDirectory(..)
, CmapEncoding(..)
@@ -46,12 +48,13 @@ import Graphics.Fountainhead.Parser
, parseTable
, cmapTableP
, headTableP
+ , hheaTableP
)
-import Graphics.Fountainhead.Type (ttfEpoch)
+import Graphics.Fountainhead.Type (Fixed32(..), ttfEpoch)
import Data.Foldable (Foldable(..))
import Data.Maybe (fromMaybe)
import Data.Time (LocalTime(..), NominalDiffTime, diffLocalTime, midnight)
-import Data.Bits (Bits(setBit))
+import Data.Bits (Bits(..))
type ParseErrorOrDump
= Either (Megaparsec.ParseErrorBundle ByteString Void) Text.Builder.Builder
@@ -106,15 +109,38 @@ dumpOffsetTable directory
<> justifyNumber 9 (getField @"length" table)
<> newlineBuilder
+dumpFixed32 :: Fixed32 -> Text.Builder.Builder
+dumpFixed32 (Fixed32 word)
+ = Text.Builder.decimal (shiftR word 16)
+ <> Text.Builder.singleton '.'
+ <> Text.Builder.decimal (word .&. 0xff00)
+
+dumpHhea :: HheaTable -> Text.Builder.Builder
+dumpHhea HheaTable{..}
+ = dumpCaption "'hhea' Table - Font Header"
+ <> " 'hhea' version: " <> dumpFixed32 version <> newlineBuilder
+ <> " yAscender: " <> Text.Builder.decimal ascent <> newlineBuilder
+ <> " yDescender: " <> Text.Builder.decimal descent <> newlineBuilder
+ <> " yLineGap: " <> Text.Builder.decimal lineGap <> newlineBuilder
+ <> " advanceWidthMax: " <> Text.Builder.decimal advanceWidthMax <> newlineBuilder
+ <> " minLeftSideBearing: " <> Text.Builder.decimal minLeftSideBearing <> newlineBuilder
+ <> " minRightSideBearing: " <> Text.Builder.decimal minRightSideBearing <> newlineBuilder
+ <> " xMaxExtent: " <> Text.Builder.decimal xMaxExtent <> newlineBuilder
+ <> " caretSlopeRise: " <> Text.Builder.decimal caretSlopeRise <> newlineBuilder
+ <> " caretSlopeRun: " <> Text.Builder.decimal caretSlopeRun <> newlineBuilder
+ <> " reserved0: 0" <> newlineBuilder
+ <> " reserved1: 0" <> newlineBuilder
+ <> " reserved2: 0" <> newlineBuilder
+ <> " reserved3: 0" <> newlineBuilder
+ <> " reserved4: 0" <> newlineBuilder
+ <> " metricDataFormat: " <> Text.Builder.decimal metricDataFormat <> newlineBuilder
+ <> " numberOfHMetrics: " <> Text.Builder.decimal numOfLongHorMetrics <> newlineBuilder
+
dumpHead :: HeadTable -> Text.Builder.Builder
dumpHead HeadTable{..}
= dumpCaption "'head' Table - Font Header"
- {- version
- <> lowestRecPPEM
- <> indexToLocFormat
- <> glyphDataFormat
- <> fontRevision
- <> fontDirectionHint -}
+ <> " head version: " <> dumpFixed32 version <> newlineBuilder
+ <> " fontRevision: " <> dumpFixed32 fontRevision <> newlineBuilder
<> " checkSumAdjustment: " <> paddedHexadecimal checkSumAdjustment <> newlineBuilder
<> " magicNumber: " <> paddedHexadecimal magicNumber <> newlineBuilder
<> " flags: 0x" <> halfPaddedHexadecimal flags <> newlineBuilder
@@ -126,10 +152,22 @@ dumpHead HeadTable{..}
<> " xMax: " <> Text.Builder.decimal xMax <> newlineBuilder
<> " yMax: " <> Text.Builder.decimal yMax <> newlineBuilder
<> " macStyle bits: " <> "0x" <> dumpFontStyle macStyle <> newlineBuilder
+ <> " lowestRecPPEM " <> Text.Builder.decimal lowestRecPPEM <> newlineBuilder
+ <> " fontDirectionHint " <> dumpFontDirectionHint fontDirectionHint <> newlineBuilder
+ <> " indexToLocFormat " <> Text.Builder.decimal indexToLocFormat <> newlineBuilder
+ <> " glyphDataFormat " <> Text.Builder.decimal glyphDataFormat <> newlineBuilder
+
+dumpFontDirectionHint :: FontDirectionHint -> Text.Builder.Builder
+dumpFontDirectionHint = \case
+ MixedDirectionalGlyphs -> "0"
+ StronglyLeftToRightGlyphs -> "1"
+ LeftToRightGlyphsWithNeutrals -> "2"
+ StronglyRightToLeftGlyphs -> "-1"
+ RightToLeftGlyphsWithNeutrals -> "-2"
dumpFontStyle :: FontStyle -> Text.Builder.Builder
dumpFontStyle FontStyle{..} = halfPaddedHexadecimal
- $ foldr (go . fst) (0 :: Int)
+ $ foldr (go . fst) (zeroBits :: Int)
$ filter snd
$ zip [0..] [bold, italic, underline, outline, shadow, condensed, extended]
where
@@ -257,6 +295,7 @@ dumpTables processedState directory@FontDirectory{..}
case getField @"tag" tableEntry of
"cmap" -> Just $ dumpCmap <$> parseTable tableEntry cmapTableP processedState
"head" -> Just $ dumpHead <$> parseTable tableEntry headTableP processedState
+ "hhea" -> Just $ dumpHhea <$> parseTable tableEntry hheaTableP processedState
_ -> Nothing
dumpTrueType :: ByteString -> FilePath -> ParseErrorOrDump
diff --git a/src/Graphics/Fountainhead/Parser.hs b/src/Graphics/Fountainhead/Parser.hs
index 02d7a29..f39cbda 100644
--- a/src/Graphics/Fountainhead/Parser.hs
+++ b/src/Graphics/Fountainhead/Parser.hs
@@ -38,7 +38,7 @@ module Graphics.Fountainhead.Parser
) where
import Control.Applicative (Alternative(..))
-import Control.Monad (foldM)
+import Control.Monad (foldM, void)
import Data.Bits (Bits(..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
@@ -260,9 +260,9 @@ hheaTableP = HheaTable
<*> Megaparsec.Binary.int16be
<*> Megaparsec.Binary.int16be
<*> Megaparsec.Binary.word16be
- <*> Megaparsec.Binary.word16be
- <*> Megaparsec.Binary.word16be
- <*> Megaparsec.Binary.word16be
+ <*> Megaparsec.Binary.int16be
+ <*> Megaparsec.Binary.int16be
+ <*> Megaparsec.Binary.int16be
<*> Megaparsec.Binary.int16be
<*> Megaparsec.Binary.int16be
<*> Megaparsec.Binary.int16be
@@ -423,12 +423,13 @@ deviceRecordP size = do
hdmxTableP :: Parser HdmxTable
hdmxTableP = do
- Megaparsec.chunk $ ByteString.pack [0, 0]
+ void $ Megaparsec.chunk $ ByteString.pack [0, 0]
numberOfDeviceRecords <- fromIntegral <$> Megaparsec.Binary.int16be
sizeOfDeviceRecord <- fromIntegral <$> Megaparsec.Binary.int32be
records' <- Megaparsec.count numberOfDeviceRecords
$ deviceRecordP sizeOfDeviceRecord
- Megaparsec.eof >> pure (HdmxTable 0 records')
+ Megaparsec.eof
+ pure $ HdmxTable 0 records'
-- * Glyph outline table
diff --git a/src/Graphics/Fountainhead/TrueType.hs b/src/Graphics/Fountainhead/TrueType.hs
index 16c95b1..0a0bde9 100644
--- a/src/Graphics/Fountainhead/TrueType.hs
+++ b/src/Graphics/Fountainhead/TrueType.hs
@@ -86,7 +86,7 @@ import Data.List.NonEmpty (NonEmpty(..))
import Data.Time (LocalTime(..))
import Data.Vector (Vector)
import Data.Word (Word8, Word16, Word32)
-import Graphics.Fountainhead.Type (F2Dot14(..), Fixed32(..))
+import Graphics.Fountainhead.Type (F2Dot14(..), Fixed32(..), FWord, UFWord)
-- * Font directory
@@ -164,16 +164,16 @@ data MaxpTable = OpenMaxp OpenMaxpTable | TrueMaxp TrueMaxpTable
data HheaTable = HheaTable
{ version :: Fixed32 -- ^ 0x00010000 (1.0).
- , ascent :: Int16 -- ^ Distance from baseline of highest ascender.
- , descent :: Int16 -- ^ Distance from baseline of lowest descender.
- , lineGap :: Int16 -- ^ Typographic line gap.
- , advanceWidthMax :: Word16 -- ^ Must be consistent with horizontal metrics.
- , minLeftSideBearing :: Word16 -- ^ Must be consistent with horizontal metrics.
- , minRightSideBearing :: Word16 -- ^ Must be consistent with horizontal metrics.
- , xMaxExtent :: Word16 -- ^ max(lsb + (xMax-xMin)).
+ , ascent :: FWord -- ^ Distance from baseline of highest ascender.
+ , descent :: FWord -- ^ Distance from baseline of lowest descender.
+ , lineGap :: FWord -- ^ Typographic line gap.
+ , advanceWidthMax :: UFWord -- ^ Must be consistent with horizontal metrics.
+ , minLeftSideBearing :: FWord -- ^ Must be consistent with horizontal metrics.
+ , minRightSideBearing :: FWord -- ^ Must be consistent with horizontal metrics.
+ , xMaxExtent :: FWord -- ^ max(lsb + (xMax-xMin)).
, caretSlopeRise :: Int16 -- ^ used to calculate the slope of the caret (rise/run) set to 1 for vertical caret.
, caretSlopeRun :: Int16 -- ^ 0 for vertical.
- , caretOffset :: Int16 -- ^ Set value to 0 for non-slanted fonts.
+ , caretOffset :: FWord -- ^ Set value to 0 for non-slanted fonts.
, metricDataFormat :: Int16 -- ^ 0 for current format.
, numOfLongHorMetrics :: Word16 -- ^ Number of advance widths in metrics table.
} deriving (Eq, Show)
diff --git a/src/Graphics/Fountainhead/Type.hs b/src/Graphics/Fountainhead/Type.hs
index 118df6b..06274dc 100644
--- a/src/Graphics/Fountainhead/Type.hs
+++ b/src/Graphics/Fountainhead/Type.hs
@@ -6,11 +6,13 @@
module Graphics.Fountainhead.Type
( F2Dot14(..)
, Fixed32(..)
+ , FWord
+ , UFWord
, ttfEpoch
) where
import Data.Int (Int16)
-import Data.Word (Word32)
+import Data.Word (Word16, Word32)
import Data.Time (Day(..))
import Data.Time.Calendar.OrdinalDate (fromOrdinalDate)
@@ -20,5 +22,8 @@ newtype Fixed32 = Fixed32 Word32
newtype F2Dot14 = F2Dot14 Int16
deriving (Eq, Show)
+type FWord = Int16
+type UFWord = Word16
+
ttfEpoch :: Day
ttfEpoch = fromOrdinalDate 1904 1
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-26 21:33:43 +0000