{-# 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
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)
                  ]