{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveFunctor #-}
---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- PDF Font
---------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
module Graphics.PDF.Fonts.Type1(
      IsFont
    , GlyphSize
    , Type1Font(..)
    , AFMData
    , Type1FontStructure(..)
    , getAfmData
    , mkType1FontStructure
) where 

import Graphics.PDF.LowLevel.Types
import Graphics.PDF.Resources
import qualified Data.Map.Strict as M
import Graphics.PDF.Fonts.Font
-- import Graphics.PDF.Fonts.AFMParser
import Graphics.PDF.Fonts.Encoding
import Graphics.PDF.Fonts.FontTypes
import Graphics.PDF.Fonts.AFMParser (AFMFont, getFont, parseFont)
import Data.List

data Type1Font = Type1Font FontStructure (PDFReference EmbeddedFont) deriving Int -> Type1Font -> ShowS
[Type1Font] -> ShowS
Type1Font -> String
(Int -> Type1Font -> ShowS)
-> (Type1Font -> String)
-> ([Type1Font] -> ShowS)
-> Show Type1Font
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type1Font] -> ShowS
$cshowList :: [Type1Font] -> ShowS
show :: Type1Font -> String
$cshow :: Type1Font -> String
showsPrec :: Int -> Type1Font -> ShowS
$cshowsPrec :: Int -> Type1Font -> ShowS
Show

instance IsFont Type1Font where 
  getDescent :: Type1Font -> Int -> PDFFloat
getDescent (Type1Font FontStructure
fs PDFReference EmbeddedFont
_) Int
s = Int -> GlyphSize -> PDFFloat
trueSize Int
s (GlyphSize -> PDFFloat) -> GlyphSize -> PDFFloat
forall a b. (a -> b) -> a -> b
$ FontStructure -> GlyphSize
descent FontStructure
fs 
  getHeight :: Type1Font -> Int -> PDFFloat
getHeight (Type1Font FontStructure
fs PDFReference EmbeddedFont
_) Int
s = Int -> GlyphSize -> PDFFloat
trueSize Int
s (GlyphSize -> PDFFloat) -> GlyphSize -> PDFFloat
forall a b. (a -> b) -> a -> b
$ FontStructure -> GlyphSize
height FontStructure
fs 
  getKern :: Type1Font -> Int -> GlyphCode -> GlyphCode -> PDFFloat
getKern (Type1Font FontStructure
fs PDFReference EmbeddedFont
_) Int
s GlyphCode
a GlyphCode
b = Int -> GlyphSize -> PDFFloat
trueSize Int
s (GlyphSize -> PDFFloat) -> GlyphSize -> PDFFloat
forall a b. (a -> b) -> a -> b
$ GlyphSize -> GlyphPair -> Map GlyphPair GlyphSize -> GlyphSize
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault GlyphSize
0 (GlyphCode -> GlyphCode -> GlyphPair
GlyphPair GlyphCode
a GlyphCode
b) (FontStructure -> Map GlyphPair GlyphSize
kernMetrics FontStructure
fs)
  glyphWidth :: Type1Font -> Int -> GlyphCode -> PDFFloat
glyphWidth (Type1Font FontStructure
fs PDFReference EmbeddedFont
_) Int
s GlyphCode
a = Int -> GlyphSize -> PDFFloat
trueSize Int
s  (GlyphSize -> PDFFloat) -> GlyphSize -> PDFFloat
forall a b. (a -> b) -> a -> b
$ GlyphSize -> GlyphCode -> Map GlyphCode GlyphSize -> GlyphSize
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault GlyphSize
0 GlyphCode
a (FontStructure -> Map GlyphCode GlyphSize
widthData FontStructure
fs)
  charGlyph :: Type1Font -> Char -> GlyphCode
charGlyph (Type1Font FontStructure
fs PDFReference EmbeddedFont
_) Char
c = GlyphCode -> Char -> Map Char GlyphCode -> GlyphCode
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault GlyphCode
0 Char
c (FontStructure -> Map Char GlyphCode
encoding FontStructure
fs)
  name :: Type1Font -> String
name (Type1Font FontStructure
fs PDFReference EmbeddedFont
_) = FontStructure -> String
baseFont FontStructure
fs 
  hyphenGlyph :: Type1Font -> Maybe GlyphCode
hyphenGlyph (Type1Font FontStructure
fs PDFReference EmbeddedFont
_) = FontStructure -> Maybe GlyphCode
hyphen FontStructure
fs 
  spaceGlyph :: Type1Font -> GlyphCode
spaceGlyph (Type1Font FontStructure
fs PDFReference EmbeddedFont
_) = FontStructure -> GlyphCode
space FontStructure
fs

data AFMData = AFMData AFMFont deriving Int -> AFMData -> ShowS
[AFMData] -> ShowS
AFMData -> String
(Int -> AFMData -> ShowS)
-> (AFMData -> String) -> ([AFMData] -> ShowS) -> Show AFMData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AFMData] -> ShowS
$cshowList :: [AFMData] -> ShowS
show :: AFMData -> String
$cshow :: AFMData -> String
showsPrec :: Int -> AFMData -> ShowS
$cshowsPrec :: Int -> AFMData -> ShowS
Show
data Type1FontStructure = Type1FontStructure FontData FontStructure

getAfmData :: FilePath -> IO AFMData 
getAfmData :: String -> IO AFMData
getAfmData String
path = do  
    Just AFMFont
r <- Either ByteString String -> IO (Maybe AFMFont)
parseFont (String -> Either ByteString String
forall a b. b -> Either a b
Right String
path) 
    AFMData -> IO AFMData
forall (m :: * -> *) a. Monad m => a -> m a
return (AFMFont -> AFMData
AFMData AFMFont
r)

mkType1FontStructure :: FontData -> AFMData -> IO (Maybe Type1FontStructure)
mkType1FontStructure :: FontData -> AFMData -> IO (Maybe Type1FontStructure)
mkType1FontStructure FontData
pdfRef (AFMData AFMFont
f)  = do
  Map String Char
theEncoding <- Encodings -> IO (Map String Char)
getEncoding Encodings
AdobeStandardEncoding
  Maybe FontStructure
maybeFs <- Either ByteString AFMFont
-> Map String Char
-> Maybe (Map String GlyphCode)
-> IO (Maybe FontStructure)
getFont (AFMFont -> Either ByteString AFMFont
forall a b. b -> Either a b
Right AFMFont
f) Map String Char
theEncoding Maybe (Map String GlyphCode)
forall a. Maybe a
Nothing
  case Maybe FontStructure
maybeFs of 
    Just FontStructure
theFont -> 
      Maybe Type1FontStructure -> IO (Maybe Type1FontStructure)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Type1FontStructure -> IO (Maybe Type1FontStructure))
-> (Type1FontStructure -> Maybe Type1FontStructure)
-> Type1FontStructure
-> IO (Maybe Type1FontStructure)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type1FontStructure -> Maybe Type1FontStructure
forall a. a -> Maybe a
Just (Type1FontStructure -> IO (Maybe Type1FontStructure))
-> Type1FontStructure -> IO (Maybe Type1FontStructure)
forall a b. (a -> b) -> a -> b
$ FontData -> FontStructure -> Type1FontStructure
Type1FontStructure FontData
pdfRef FontStructure
theFont
    Maybe FontStructure
Nothing -> Maybe Type1FontStructure -> IO (Maybe Type1FontStructure)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Type1FontStructure
forall a. Maybe a
Nothing

 

instance PdfResourceObject Type1Font where
   toRsrc :: Type1Font -> AnyPdfObject
toRsrc (Type1Font FontStructure
f PDFReference EmbeddedFont
ref) =  
                PDFDictionary -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFDictionary -> AnyPdfObject)
-> ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)]
-> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary (Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$
                           [(String -> PDFName
PDFName String
"Type",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFName -> AnyPdfObject)
-> (String -> PDFName) -> String -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> AnyPdfObject) -> String -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ String
"Font")
                           , (String -> PDFName
PDFName String
"Subtype",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFName -> AnyPdfObject)
-> (String -> PDFName) -> String -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> AnyPdfObject) -> String -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ String
"Type1")
                           , (String -> PDFName
PDFName String
"BaseFont",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFName -> AnyPdfObject)
-> (String -> PDFName) -> String -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> AnyPdfObject) -> String -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ FontStructure -> String
baseFont FontStructure
f)
                           , (String -> PDFName
PDFName String
"FirstChar",PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (Int -> PDFInteger) -> Int -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> AnyPdfObject) -> Int -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ (GlyphCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GlyphCode
firstChar))
                           , (String -> PDFName
PDFName String
"LastChar",PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (Int -> PDFInteger) -> Int -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> AnyPdfObject) -> Int -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ (GlyphCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GlyphCode
lastChar))
                           , (String -> PDFName
PDFName String
"Widths",[PDFInteger] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject  ([PDFInteger] -> AnyPdfObject) -> [PDFInteger] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ [PDFInteger]
widths)
                           , (String -> PDFName
PDFName String
"FontDescriptor", PDFDictionary -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFDictionary
descriptor)
                           ] 
          where 
            codes :: [GlyphCode]
codes = ((GlyphCode, GlyphSize) -> GlyphCode)
-> [(GlyphCode, GlyphSize)] -> [GlyphCode]
forall a b. (a -> b) -> [a] -> [b]
map (GlyphCode, GlyphSize) -> GlyphCode
forall a b. (a, b) -> a
fst ([(GlyphCode, GlyphSize)] -> [GlyphCode])
-> (Map GlyphCode GlyphSize -> [(GlyphCode, GlyphSize)])
-> Map GlyphCode GlyphSize
-> [GlyphCode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map GlyphCode GlyphSize -> [(GlyphCode, GlyphSize)]
forall k a. Map k a -> [(k, a)]
M.toList (Map GlyphCode GlyphSize -> [GlyphCode])
-> Map GlyphCode GlyphSize -> [GlyphCode]
forall a b. (a -> b) -> a -> b
$ FontStructure -> Map GlyphCode GlyphSize
widthData FontStructure
f
            firstChar :: GlyphCode
firstChar = [GlyphCode] -> GlyphCode
forall a. [a] -> a
head ([GlyphCode] -> GlyphCode)
-> ([GlyphCode] -> [GlyphCode]) -> [GlyphCode] -> GlyphCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GlyphCode] -> [GlyphCode]
forall a. Ord a => [a] -> [a]
sort ([GlyphCode] -> GlyphCode) -> [GlyphCode] -> GlyphCode
forall a b. (a -> b) -> a -> b
$ [GlyphCode]
codes
            lastChar :: GlyphCode
lastChar = [GlyphCode] -> GlyphCode
forall a. [a] -> a
head ([GlyphCode] -> GlyphCode)
-> ([GlyphCode] -> [GlyphCode]) -> [GlyphCode] -> GlyphCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GlyphCode] -> [GlyphCode]
forall a. [a] -> [a]
reverse ([GlyphCode] -> [GlyphCode])
-> ([GlyphCode] -> [GlyphCode]) -> [GlyphCode] -> [GlyphCode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GlyphCode] -> [GlyphCode]
forall a. Ord a => [a] -> [a]
sort ([GlyphCode] -> GlyphCode) -> [GlyphCode] -> GlyphCode
forall a b. (a -> b) -> a -> b
$ [GlyphCode]
codes
            findWidth :: GlyphCode -> PDFInteger
findWidth GlyphCode
c = Int -> PDFInteger
PDFInteger (Int -> PDFInteger)
-> (GlyphSize -> Int) -> GlyphSize -> PDFInteger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlyphSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GlyphSize -> PDFInteger) -> GlyphSize -> PDFInteger
forall a b. (a -> b) -> a -> b
$ GlyphSize -> GlyphCode -> Map GlyphCode GlyphSize -> GlyphSize
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault GlyphSize
0 GlyphCode
c (FontStructure -> Map GlyphCode GlyphSize
widthData FontStructure
f)
            widths :: [PDFInteger]
widths = (GlyphCode -> PDFInteger) -> [GlyphCode] -> [PDFInteger]
forall a b. (a -> b) -> [a] -> [b]
map GlyphCode -> PDFInteger
findWidth [GlyphCode
firstChar .. GlyphCode
lastChar] 
            bbox :: [AnyPdfObject]
bbox = (PDFFloat -> AnyPdfObject) -> [PDFFloat] -> [AnyPdfObject]
forall a b. (a -> b) -> [a] -> [b]
map PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject ([PDFFloat] -> [AnyPdfObject])
-> (FontStructure -> [PDFFloat]) -> FontStructure -> [AnyPdfObject]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStructure -> [PDFFloat]
fontBBox (FontStructure -> [AnyPdfObject])
-> FontStructure -> [AnyPdfObject]
forall a b. (a -> b) -> a -> b
$ FontStructure
f 
            descriptor :: PDFDictionary
descriptor = Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary (Map PDFName AnyPdfObject -> PDFDictionary)
-> ([(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject)
-> [(PDFName, AnyPdfObject)]
-> PDFDictionary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PDFName, AnyPdfObject)] -> Map PDFName AnyPdfObject
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$ 
              [ (String -> PDFName
PDFName String
"Type",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFName -> AnyPdfObject)
-> (String -> PDFName) -> String -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> AnyPdfObject) -> String -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ String
"Font")
              , (String -> PDFName
PDFName String
"Subtype",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFName -> AnyPdfObject)
-> (String -> PDFName) -> String -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> AnyPdfObject) -> String -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ String
"Type1")
              , (String -> PDFName
PDFName String
"BaseFont",PDFName -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFName -> AnyPdfObject)
-> (String -> PDFName) -> String -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName (String -> AnyPdfObject) -> String -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ FontStructure -> String
baseFont FontStructure
f)
              , (String -> PDFName
PDFName String
"FontFile", PDFReference EmbeddedFont -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference EmbeddedFont
ref)
              , (String -> PDFName
PDFName String
"Flags",PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (FontStructure -> PDFInteger) -> FontStructure -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> PDFInteger)
-> (FontStructure -> Int) -> FontStructure -> PDFInteger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int)
-> (FontStructure -> Word32) -> FontStructure -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontStructure -> Word32
mkFlags (FontStructure -> AnyPdfObject) -> FontStructure -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ FontStructure
f)
              , (String -> PDFName
PDFName String
"FontBBox",[AnyPdfObject] -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject  ([AnyPdfObject] -> AnyPdfObject) -> [AnyPdfObject] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ [AnyPdfObject]
bbox)
              , (String -> PDFName
PDFName String
"ItalicAngle",PDFFloat -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFFloat -> AnyPdfObject) -> PDFFloat -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ FontStructure -> PDFFloat
italicAngle FontStructure
f)
              , (String -> PDFName
PDFName String
"Ascent",PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (GlyphSize -> PDFInteger) -> GlyphSize -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> PDFInteger)
-> (GlyphSize -> Int) -> GlyphSize -> PDFInteger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlyphSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GlyphSize -> AnyPdfObject) -> GlyphSize -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ FontStructure -> GlyphSize
ascent FontStructure
f)
              , (String -> PDFName
PDFName String
"Descent",PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (GlyphSize -> PDFInteger) -> GlyphSize -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> PDFInteger)
-> (GlyphSize -> Int) -> GlyphSize -> PDFInteger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlyphSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GlyphSize -> AnyPdfObject) -> GlyphSize -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ FontStructure -> GlyphSize
descent FontStructure
f)
              , (String -> PDFName
PDFName String
"CapHeight",PDFInteger -> AnyPdfObject
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject (PDFInteger -> AnyPdfObject)
-> (GlyphSize -> PDFInteger) -> GlyphSize -> AnyPdfObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger (Int -> PDFInteger)
-> (GlyphSize -> Int) -> GlyphSize -> PDFInteger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlyphSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GlyphSize -> AnyPdfObject) -> GlyphSize -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$ FontStructure -> GlyphSize
capHeight FontStructure
f)
                  ]