{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
module Graphics.PDF.Fonts.Type1(
IsFont
, GlyphSize
, Type1Font(..)
, AFMData
, Type1FontStructure(..)
, readAfmData
, parseAfmData
, 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.Encoding
import Graphics.PDF.Fonts.FontTypes
import Graphics.PDF.Fonts.AFMParser (AFMFont, fontToStructure, parseAfm)
import qualified Data.ByteString as B
import Data.List
import Data.Bifunctor (Bifunctor(second))
import Text.Parsec.Error (ParseError)
data Type1Font = Type1Font FontStructure (PDFReference EmbeddedFont) deriving Int -> Type1Font -> ShowS
[Type1Font] -> ShowS
Type1Font -> String
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 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 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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 = 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
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
readAfmData :: FilePath -> IO (Either ParseError AFMData)
readAfmData :: String -> IO (Either ParseError AFMData)
readAfmData String
path = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second AFMFont -> AFMData
AFMData forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString -> Either ParseError AFMFont
parseAfm String
path forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
B.readFile String
path
parseAfmData :: B.ByteString -> Either ParseError AFMData
parseAfmData :: ByteString -> Either ParseError AFMData
parseAfmData ByteString
bs = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second AFMFont -> AFMData
AFMData forall a b. (a -> b) -> a -> b
$ String -> ByteString -> Either ParseError AFMFont
parseAfm String
"<bytestring>" ByteString
bs
mkType1FontStructure :: FontData -> AFMData -> IO Type1FontStructure
mkType1FontStructure :: FontData -> AFMData -> IO Type1FontStructure
mkType1FontStructure FontData
pdfRef (AFMData AFMFont
f) = do
Map String Char
theEncoding <- Encodings -> IO (Map String Char)
getEncoding Encodings
AdobeStandardEncoding
let theFont :: FontStructure
theFont = AFMFont
-> Map String Char -> Maybe (Map String GlyphCode) -> FontStructure
fontToStructure AFMFont
f Map String Char
theEncoding forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FontData -> FontStructure -> Type1FontStructure
Type1FontStructure FontData
pdfRef FontStructure
theFont
instance PdfResourceObject Type1Font where
toRsrc :: Type1Font -> AnyPdfObject
toRsrc (Type1Font FontStructure
f PDFReference EmbeddedFont
ref) =
forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
[(String -> PDFName
PDFName String
"Type",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"Font")
, (String -> PDFName
PDFName String
"Subtype",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"Type1")
, (String -> PDFName
PDFName String
"BaseFont",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ FontStructure -> String
baseFont FontStructure
f)
, (String -> PDFName
PDFName String
"FirstChar",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral GlyphCode
firstChar))
, (String -> PDFName
PDFName String
"LastChar",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral GlyphCode
lastChar))
, (String -> PDFName
PDFName String
"Widths",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ [PDFInteger]
widths)
, (String -> PDFName
PDFName String
"FontDescriptor", forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFDictionary
descriptor)
]
where
codes :: [GlyphCode]
codes = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ FontStructure -> Map GlyphCode GlyphSize
widthData FontStructure
f
firstChar :: GlyphCode
firstChar = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ [GlyphCode]
codes
lastChar :: GlyphCode
lastChar = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ [GlyphCode]
codes
findWidth :: GlyphCode -> PDFInteger
findWidth GlyphCode
c = Int -> PDFInteger
PDFInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ 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 = forall a b. (a -> b) -> [a] -> [b]
map GlyphCode -> PDFInteger
findWidth [GlyphCode
firstChar .. GlyphCode
lastChar]
bbox :: [AnyPdfObject]
bbox = forall a b. (a -> b) -> [a] -> [b]
map forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
.FontStructure -> [PDFFloat]
fontBBox forall a b. (a -> b) -> a -> b
$ FontStructure
f
descriptor :: PDFDictionary
descriptor = Map PDFName AnyPdfObject -> PDFDictionary
PDFDictionary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
[ (String -> PDFName
PDFName String
"Type",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"Font")
, (String -> PDFName
PDFName String
"Subtype",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ String
"Type1")
, (String -> PDFName
PDFName String
"BaseFont",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PDFName
PDFName forall a b. (a -> b) -> a -> b
$ FontStructure -> String
baseFont FontStructure
f)
, (String -> PDFName
PDFName String
"FontFile", forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject PDFReference EmbeddedFont
ref)
, (String -> PDFName
PDFName String
"Flags",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontStructure -> Word32
mkFlags forall a b. (a -> b) -> a -> b
$ FontStructure
f)
, (String -> PDFName
PDFName String
"FontBBox",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ [AnyPdfObject]
bbox)
, (String -> PDFName
PDFName String
"ItalicAngle",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall a b. (a -> b) -> a -> b
$ FontStructure -> PDFFloat
italicAngle FontStructure
f)
, (String -> PDFName
PDFName String
"Ascent",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ FontStructure -> GlyphSize
ascent FontStructure
f)
, (String -> PDFName
PDFName String
"Descent",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ FontStructure -> GlyphSize
descent FontStructure
f)
, (String -> PDFName
PDFName String
"CapHeight",forall a. (PdfObject a, PdfLengthInfo a) => a -> AnyPdfObject
AnyPdfObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PDFInteger
PDFInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ FontStructure -> GlyphSize
capHeight FontStructure
f)
]