{-# 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(..)
    , 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.AFMParser
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
(Int -> Type1Font -> ShowS)
-> (Type1Font -> String)
-> ([Type1Font] -> ShowS)
-> Show Type1Font
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Type1Font -> ShowS
showsPrec :: Int -> Type1Font -> ShowS
$cshow :: Type1Font -> String
show :: Type1Font -> String
$cshowList :: [Type1Font] -> ShowS
showList :: [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
$cshowsPrec :: Int -> AFMData -> ShowS
showsPrec :: Int -> AFMData -> ShowS
$cshow :: AFMData -> String
show :: AFMData -> String
$cshowList :: [AFMData] -> ShowS
showList :: [AFMData] -> ShowS
Show
data Type1FontStructure = Type1FontStructure FontData FontStructure

readAfmData :: FilePath -> IO (Either ParseError AFMData)
readAfmData :: String -> IO (Either ParseError AFMData)
readAfmData String
path = (AFMFont -> AFMData)
-> Either ParseError AFMFont -> Either ParseError AFMData
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second AFMFont -> AFMData
AFMData (Either ParseError AFMFont -> Either ParseError AFMData)
-> (ByteString -> Either ParseError AFMFont)
-> ByteString
-> Either ParseError AFMData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString -> Either ParseError AFMFont
parseAfm String
path (ByteString -> Either ParseError AFMData)
-> IO ByteString -> IO (Either ParseError AFMData)
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 = (AFMFont -> AFMData)
-> Either ParseError AFMFont -> Either ParseError AFMData
forall b c a. (b -> c) -> Either a b -> Either a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second AFMFont -> AFMData
AFMData (Either ParseError AFMFont -> Either ParseError AFMData)
-> Either ParseError AFMFont -> Either ParseError 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 Maybe (Map String GlyphCode)
forall a. Maybe a
Nothing
  Type1FontStructure -> IO Type1FontStructure
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type1FontStructure -> IO Type1FontStructure)
-> Type1FontStructure -> IO Type1FontStructure
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) =  
                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
. [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> AnyPdfObject)
-> [(PDFName, AnyPdfObject)] -> AnyPdfObject
forall a b. (a -> b) -> a -> b
$
                           [String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Type" (String -> PDFName
PDFName (String -> PDFName) -> String -> PDFName
forall a b. (a -> b) -> a -> b
$ String
"Font")
                           , String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Subtype" (String -> PDFName
PDFName (String -> PDFName) -> String -> PDFName
forall a b. (a -> b) -> a -> b
$ String
"Type1")
                           , String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"BaseFont" (String -> PDFName
PDFName (String -> PDFName) -> String -> PDFName
forall a b. (a -> b) -> a -> b
$ FontStructure -> String
baseFont FontStructure
f)
                           , String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"FirstChar" (Int -> PDFInteger
PDFInteger (Int -> PDFInteger) -> Int -> PDFInteger
forall a b. (a -> b) -> a -> b
$ GlyphCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GlyphCode
firstChar)
                           , String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"LastChar" (Int -> PDFInteger
PDFInteger (Int -> PDFInteger) -> Int -> PDFInteger
forall a b. (a -> b) -> a -> b
$ GlyphCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral GlyphCode
lastChar)
                           , String -> [PDFInteger] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Widths" [PDFInteger]
widths
                           , String -> PDFDictionary -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"FontDescriptor" 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. HasCallStack => [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. HasCallStack => [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] 
            descriptor :: PDFDictionary
descriptor = [(PDFName, AnyPdfObject)] -> PDFDictionary
dictFromList ([(PDFName, AnyPdfObject)] -> PDFDictionary)
-> [(PDFName, AnyPdfObject)] -> PDFDictionary
forall a b. (a -> b) -> a -> b
$
              [ String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Type" (String -> PDFName
PDFName (String -> PDFName) -> String -> PDFName
forall a b. (a -> b) -> a -> b
$ String
"Font")
              , String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Subtype" (String -> PDFName
PDFName (String -> PDFName) -> String -> PDFName
forall a b. (a -> b) -> a -> b
$ String
"Type1")
              , String -> PDFName -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"BaseFont" (String -> PDFName
PDFName (String -> PDFName) -> String -> PDFName
forall a b. (a -> b) -> a -> b
$ FontStructure -> String
baseFont FontStructure
f)
              , String -> PDFReference EmbeddedFont -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"FontFile" PDFReference EmbeddedFont
ref
              , String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Flags" (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 -> PDFInteger) -> FontStructure -> PDFInteger
forall a b. (a -> b) -> a -> b
$ FontStructure
f)
              , String -> [PDFFloat] -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"FontBBox" (FontStructure -> [PDFFloat]
fontBBox FontStructure
f)
              , String -> PDFFloat -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"ItalicAngle" (FontStructure -> PDFFloat
italicAngle FontStructure
f)
              , String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Ascent" (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
$ FontStructure -> GlyphSize
ascent FontStructure
f)
              , String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"Descent" (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
$ FontStructure -> GlyphSize
descent FontStructure
f)
              , String -> PDFInteger -> (PDFName, AnyPdfObject)
forall a.
(PdfObject a, PdfLengthInfo a) =>
String -> a -> (PDFName, AnyPdfObject)
entry String
"CapHeight" (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
$ FontStructure -> GlyphSize
capHeight FontStructure
f)
                  ]