module Pdf.Content.FontInfo
(
FontInfo(..),
FISimple(..),
FontBaseEncoding(..),
SimpleFontEncoding(..),
FIComposite(..),
CIDFontWidths(..),
makeCIDFontWidths,
cidFontGetWidth,
fontInfoDecodeGlyphs
)
where
import Pdf.Core
import Pdf.Core.Util
import Pdf.Core.Object.Util
import Pdf.Core.Types
import Pdf.Content.UnicodeCMap
import Pdf.Content.Transform
import Pdf.Content.Processor (Glyph(..))
import Pdf.Content.GlyphList
import Pdf.Content.TexGlyphList
import Pdf.Content.FontDescriptor
import qualified Pdf.Content.Encoding.WinAnsi as WinAnsi
import qualified Pdf.Content.Encoding.MacRoman as MacRoman
import Data.List
import Data.Maybe
import Data.Word
import Data.Map (Map)
import qualified Data.Map as Map
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Vector as Vector
import Control.Monad
data FontInfo
= FontInfoSimple FISimple
| FontInfoComposite FIComposite
deriving (Int -> FontInfo -> ShowS
[FontInfo] -> ShowS
FontInfo -> String
(Int -> FontInfo -> ShowS)
-> (FontInfo -> String) -> ([FontInfo] -> ShowS) -> Show FontInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontInfo] -> ShowS
$cshowList :: [FontInfo] -> ShowS
show :: FontInfo -> String
$cshow :: FontInfo -> String
showsPrec :: Int -> FontInfo -> ShowS
$cshowsPrec :: Int -> FontInfo -> ShowS
Show)
data FISimple = FISimple {
FISimple -> Maybe UnicodeCMap
fiSimpleUnicodeCMap :: Maybe UnicodeCMap,
FISimple -> Maybe SimpleFontEncoding
fiSimpleEncoding :: Maybe SimpleFontEncoding,
FISimple -> Maybe (Int, Int, [Double])
fiSimpleWidths :: Maybe (Int, Int, [Double]),
FISimple -> Transform Double
fiSimpleFontMatrix :: Transform Double,
FISimple -> Maybe FontDescriptor
fiSimpleFontDescriptor :: Maybe FontDescriptor
}
deriving (Int -> FISimple -> ShowS
[FISimple] -> ShowS
FISimple -> String
(Int -> FISimple -> ShowS)
-> (FISimple -> String) -> ([FISimple] -> ShowS) -> Show FISimple
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FISimple] -> ShowS
$cshowList :: [FISimple] -> ShowS
show :: FISimple -> String
$cshow :: FISimple -> String
showsPrec :: Int -> FISimple -> ShowS
$cshowsPrec :: Int -> FISimple -> ShowS
Show)
data FontBaseEncoding
= FontBaseEncodingWinAnsi
| FontBaseEncodingMacRoman
deriving (Int -> FontBaseEncoding -> ShowS
[FontBaseEncoding] -> ShowS
FontBaseEncoding -> String
(Int -> FontBaseEncoding -> ShowS)
-> (FontBaseEncoding -> String)
-> ([FontBaseEncoding] -> ShowS)
-> Show FontBaseEncoding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontBaseEncoding] -> ShowS
$cshowList :: [FontBaseEncoding] -> ShowS
show :: FontBaseEncoding -> String
$cshow :: FontBaseEncoding -> String
showsPrec :: Int -> FontBaseEncoding -> ShowS
$cshowsPrec :: Int -> FontBaseEncoding -> ShowS
Show)
data SimpleFontEncoding = SimpleFontEncoding {
SimpleFontEncoding -> FontBaseEncoding
simpleFontBaseEncoding :: FontBaseEncoding,
SimpleFontEncoding -> [(Word8, ByteString)]
simpleFontDifferences :: [(Word8, ByteString)]
}
deriving (Int -> SimpleFontEncoding -> ShowS
[SimpleFontEncoding] -> ShowS
SimpleFontEncoding -> String
(Int -> SimpleFontEncoding -> ShowS)
-> (SimpleFontEncoding -> String)
-> ([SimpleFontEncoding] -> ShowS)
-> Show SimpleFontEncoding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleFontEncoding] -> ShowS
$cshowList :: [SimpleFontEncoding] -> ShowS
show :: SimpleFontEncoding -> String
$cshow :: SimpleFontEncoding -> String
showsPrec :: Int -> SimpleFontEncoding -> ShowS
$cshowsPrec :: Int -> SimpleFontEncoding -> ShowS
Show)
data FIComposite = FIComposite {
FIComposite -> Maybe UnicodeCMap
fiCompositeUnicodeCMap :: Maybe UnicodeCMap,
FIComposite -> CIDFontWidths
fiCompositeWidths :: CIDFontWidths,
FIComposite -> Double
fiCompositeDefaultWidth :: Double,
FIComposite -> Maybe FontDescriptor
fiCompositeFontDescriptor :: Maybe FontDescriptor
}
deriving (Int -> FIComposite -> ShowS
[FIComposite] -> ShowS
FIComposite -> String
(Int -> FIComposite -> ShowS)
-> (FIComposite -> String)
-> ([FIComposite] -> ShowS)
-> Show FIComposite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FIComposite] -> ShowS
$cshowList :: [FIComposite] -> ShowS
show :: FIComposite -> String
$cshow :: FIComposite -> String
showsPrec :: Int -> FIComposite -> ShowS
$cshowsPrec :: Int -> FIComposite -> ShowS
Show)
data CIDFontWidths = CIDFontWidths {
CIDFontWidths -> Map Int Double
cidFontWidthsChars :: Map Int Double,
CIDFontWidths -> [(Int, Int, Double)]
cidFontWidthsRanges :: [(Int, Int, Double)]
}
deriving (Int -> CIDFontWidths -> ShowS
[CIDFontWidths] -> ShowS
CIDFontWidths -> String
(Int -> CIDFontWidths -> ShowS)
-> (CIDFontWidths -> String)
-> ([CIDFontWidths] -> ShowS)
-> Show CIDFontWidths
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CIDFontWidths] -> ShowS
$cshowList :: [CIDFontWidths] -> ShowS
show :: CIDFontWidths -> String
$cshow :: CIDFontWidths -> String
showsPrec :: Int -> CIDFontWidths -> ShowS
$cshowsPrec :: Int -> CIDFontWidths -> ShowS
Show)
instance Monoid CIDFontWidths where
mempty :: CIDFontWidths
mempty = CIDFontWidths :: Map Int Double -> [(Int, Int, Double)] -> CIDFontWidths
CIDFontWidths {
cidFontWidthsChars :: Map Int Double
cidFontWidthsChars = Map Int Double
forall a. Monoid a => a
mempty,
cidFontWidthsRanges :: [(Int, Int, Double)]
cidFontWidthsRanges = [(Int, Int, Double)]
forall a. Monoid a => a
mempty
}
CIDFontWidths
w1 mappend :: CIDFontWidths -> CIDFontWidths -> CIDFontWidths
`mappend` CIDFontWidths
w2 = CIDFontWidths :: Map Int Double -> [(Int, Int, Double)] -> CIDFontWidths
CIDFontWidths {
cidFontWidthsChars :: Map Int Double
cidFontWidthsChars = CIDFontWidths -> Map Int Double
cidFontWidthsChars CIDFontWidths
w1
Map Int Double -> Map Int Double -> Map Int Double
forall a. Monoid a => a -> a -> a
`mappend` CIDFontWidths -> Map Int Double
cidFontWidthsChars CIDFontWidths
w2,
cidFontWidthsRanges :: [(Int, Int, Double)]
cidFontWidthsRanges = CIDFontWidths -> [(Int, Int, Double)]
cidFontWidthsRanges CIDFontWidths
w1
[(Int, Int, Double)]
-> [(Int, Int, Double)] -> [(Int, Int, Double)]
forall a. Monoid a => a -> a -> a
`mappend` CIDFontWidths -> [(Int, Int, Double)]
cidFontWidthsRanges CIDFontWidths
w2
}
instance Semigroup CIDFontWidths where
<> :: CIDFontWidths -> CIDFontWidths -> CIDFontWidths
(<>) = CIDFontWidths -> CIDFontWidths -> CIDFontWidths
forall a. Monoid a => a -> a -> a
mappend
getGlyphYCoordinates :: FontInfo -> Int -> (Double, Double)
getGlyphYCoordinates :: FontInfo -> Int -> (Double, Double)
getGlyphYCoordinates (FontInfoComposite FIComposite
fi) =
(Double, Double) -> Int -> (Double, Double)
forall a b. a -> b -> a
const ((Double, Double) -> Int -> (Double, Double))
-> (Double, Double) -> Int -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> Maybe (Double, Double) -> (Double, Double)
forall a. a -> Maybe a -> a
fromMaybe (Double
0,Double
1) (Maybe (Double, Double) -> (Double, Double))
-> Maybe (Double, Double) -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe (Double, Double)) -> Maybe (Double, Double)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (Double, Double)) -> Maybe (Double, Double))
-> Maybe (Maybe (Double, Double)) -> Maybe (Double, Double)
forall a b. (a -> b) -> a -> b
$ (FontDescriptor -> Maybe (Double, Double))
-> Maybe FontDescriptor -> Maybe (Maybe (Double, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> FontDescriptor -> Maybe (Double, Double)
fdYCoordinates Double
1000) (Maybe FontDescriptor -> Maybe (Maybe (Double, Double)))
-> Maybe FontDescriptor -> Maybe (Maybe (Double, Double))
forall a b. (a -> b) -> a -> b
$ FIComposite -> Maybe FontDescriptor
fiCompositeFontDescriptor FIComposite
fi
getGlyphYCoordinates (FontInfoSimple FISimple
fi) =
(Double, Double) -> Int -> (Double, Double)
forall a b. a -> b -> a
const ((Double, Double) -> Int -> (Double, Double))
-> (Double, Double) -> Int -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> Maybe (Double, Double) -> (Double, Double)
forall a. a -> Maybe a -> a
fromMaybe (Double
0,Double
1) (Maybe (Double, Double) -> (Double, Double))
-> Maybe (Double, Double) -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe (Double, Double)) -> Maybe (Double, Double)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (Double, Double)) -> Maybe (Double, Double))
-> Maybe (Maybe (Double, Double)) -> Maybe (Double, Double)
forall a b. (a -> b) -> a -> b
$ (FontDescriptor -> Maybe (Double, Double))
-> Maybe FontDescriptor -> Maybe (Maybe (Double, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> FontDescriptor -> Maybe (Double, Double)
fdYCoordinates Double
1000) (Maybe FontDescriptor -> Maybe (Maybe (Double, Double)))
-> Maybe FontDescriptor -> Maybe (Maybe (Double, Double))
forall a b. (a -> b) -> a -> b
$ FISimple -> Maybe FontDescriptor
fiSimpleFontDescriptor FISimple
fi
fdYCoordinates :: Double -> FontDescriptor -> Maybe (Double, Double)
fdYCoordinates :: Double -> FontDescriptor -> Maybe (Double, Double)
fdYCoordinates Double
scaling FontDescriptor
fd =
Maybe (Double, Double)
-> ((Double, Double) -> Maybe (Double, Double))
-> Maybe (Double, Double)
-> Maybe (Double, Double)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (Double, Double)
cap (Double, Double) -> Maybe (Double, Double)
forall a. a -> Maybe a
Just (Maybe (Double, Double) -> Maybe (Double, Double))
-> Maybe (Double, Double) -> Maybe (Double, Double)
forall a b. (a -> b) -> a -> b
$
Maybe (Double, Double)
-> ((Double, Double) -> Maybe (Double, Double))
-> Maybe (Double, Double)
-> Maybe (Double, Double)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (Double, Double)
descAsc (Double, Double) -> Maybe (Double, Double)
forall a. a -> Maybe a
Just (Maybe (Double, Double) -> Maybe (Double, Double))
-> Maybe (Double, Double) -> Maybe (Double, Double)
forall a b. (a -> b) -> a -> b
$
(Rectangle Double -> (Double, Double))
-> Maybe (Rectangle Double) -> Maybe (Double, Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rectangle Double -> (Double, Double)
bbox (Maybe (Rectangle Double) -> Maybe (Double, Double))
-> Maybe (Rectangle Double) -> Maybe (Double, Double)
forall a b. (a -> b) -> a -> b
$ FontDescriptor -> Maybe (Rectangle Double)
fdFontBBox FontDescriptor
fd
where
bbox :: Rectangle Double -> (Double, Double)
bbox (Rectangle Double
_ Double
b Double
_ Double
t) = (Double
b Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
scaling, Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
scaling)
descAsc :: Maybe (Double, Double)
descAsc = (,) (Double -> Double -> (Double, Double))
-> Maybe Double -> Maybe (Double -> (Double, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Double -> Double) -> Maybe Double -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
scaling) (Maybe Double -> Maybe Double) -> Maybe Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ FontDescriptor -> Maybe Double
fdDescent FontDescriptor
fd) Maybe (Double -> (Double, Double))
-> Maybe Double -> Maybe (Double, Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Double -> Double) -> Maybe Double -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
scaling) (Maybe Double -> Maybe Double) -> Maybe Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ FontDescriptor -> Maybe Double
fdAscent FontDescriptor
fd)
cap :: Maybe (Double, Double)
cap = (,) (Double -> Double -> (Double, Double))
-> Maybe Double -> Maybe (Double -> (Double, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
0.0) Maybe (Double -> (Double, Double))
-> Maybe Double -> Maybe (Double, Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Double -> Double) -> Maybe Double -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
scaling) (Maybe Double -> Maybe Double) -> Maybe Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ FontDescriptor -> Maybe Double
fdCapHeight FontDescriptor
fd)
simpleFontEncodingDecode :: SimpleFontEncoding -> Word8 -> Maybe Text
simpleFontEncodingDecode :: SimpleFontEncoding -> Word8 -> Maybe Text
simpleFontEncodingDecode SimpleFontEncoding
enc Word8
code =
case Word8 -> [(Word8, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Word8
code (SimpleFontEncoding -> [(Word8, ByteString)]
simpleFontDifferences SimpleFontEncoding
enc) of
Maybe ByteString
Nothing ->
case SimpleFontEncoding -> FontBaseEncoding
simpleFontBaseEncoding SimpleFontEncoding
enc of
FontBaseEncoding
FontBaseEncodingWinAnsi -> Word8 -> Map Word8 Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word8
code Map Word8 Text
WinAnsi.encoding
FontBaseEncoding
FontBaseEncodingMacRoman -> Word8 -> Map Word8 Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word8
code Map Word8 Text
MacRoman.encoding
Just ByteString
glyphName ->
case ByteString -> Map ByteString Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
glyphName Map ByteString Char
adobeGlyphList of
Just Char
c -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack [Char
c]
Maybe Char
Nothing ->
case ByteString -> Map ByteString Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
glyphName Map ByteString Char
texGlyphList of
Maybe Char
Nothing-> Maybe Text
forall a. Maybe a
Nothing
Just Char
c -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack [Char
c]
makeCIDFontWidths :: Array -> Either String CIDFontWidths
makeCIDFontWidths :: Array -> Either String CIDFontWidths
makeCIDFontWidths Array
vals = CIDFontWidths -> [Object] -> Maybe CIDFontWidths
go CIDFontWidths
forall a. Monoid a => a
mempty (Array -> [Object]
forall a. Vector a -> [a]
Vector.toList Array
vals)
Maybe CIDFontWidths -> String -> Either String CIDFontWidths
forall a. Maybe a -> String -> Either String a
`notice` (String
"Can't parse CIDFont width " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Array -> String
forall a. Show a => a -> String
show Array
vals)
where
go :: CIDFontWidths -> [Object] -> Maybe CIDFontWidths
go CIDFontWidths
res [] = CIDFontWidths -> Maybe CIDFontWidths
forall (m :: * -> *) a. Monad m => a -> m a
return CIDFontWidths
res
go CIDFontWidths
res (x1 :: Object
x1@Number{} : x2 :: Object
x2@Number{} : x3 :: Object
x3@Number{} : [Object]
xs) = do
Int
n1 <- Object -> Maybe Int
intValue Object
x1
Int
n2 <- Object -> Maybe Int
intValue Object
x2
Double
n3 <- Object -> Maybe Double
realValue Object
x3
CIDFontWidths -> [Object] -> Maybe CIDFontWidths
go CIDFontWidths
res {cidFontWidthsRanges :: [(Int, Int, Double)]
cidFontWidthsRanges = (Int
n1, Int
n2, Double
n3) (Int, Int, Double) -> [(Int, Int, Double)] -> [(Int, Int, Double)]
forall a. a -> [a] -> [a]
: CIDFontWidths -> [(Int, Int, Double)]
cidFontWidthsRanges CIDFontWidths
res} [Object]
xs
go CIDFontWidths
res (Object
x : Array Array
arr : [Object]
xs) = do
Int
n <- Object -> Maybe Int
intValue Object
x
[Double]
ws <- [Object] -> (Object -> Maybe Double) -> Maybe [Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Array -> [Object]
forall a. Vector a -> [a]
Vector.toList Array
arr) Object -> Maybe Double
realValue
CIDFontWidths -> [Object] -> Maybe CIDFontWidths
go CIDFontWidths
res {cidFontWidthsChars :: Map Int Double
cidFontWidthsChars = [(Int, Double)] -> Map Int Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Int] -> [Double] -> [(Int, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
n ..] [Double]
ws)
Map Int Double -> Map Int Double -> Map Int Double
forall a. Monoid a => a -> a -> a
`mappend` CIDFontWidths -> Map Int Double
cidFontWidthsChars CIDFontWidths
res} [Object]
xs
go CIDFontWidths
_ [Object]
_ = Maybe CIDFontWidths
forall a. Maybe a
Nothing
cidFontGetWidth :: CIDFontWidths -> Int -> Maybe Double
cidFontGetWidth :: CIDFontWidths -> Int -> Maybe Double
cidFontGetWidth CIDFontWidths
w Int
code =
case Int -> Map Int Double -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
code (CIDFontWidths -> Map Int Double
cidFontWidthsChars CIDFontWidths
w) of
Just Double
width -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
width
Maybe Double
Nothing -> case ((Int, Int, Double) -> Bool)
-> [(Int, Int, Double)] -> Maybe (Int, Int, Double)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Int
start, Int
end, Double
_) -> Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
start Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
end)
(CIDFontWidths -> [(Int, Int, Double)]
cidFontWidthsRanges CIDFontWidths
w) of
Just (Int
_, Int
_, Double
width) -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
width
Maybe (Int, Int, Double)
_ -> Maybe Double
forall a. Maybe a
Nothing
fontInfoDecodeGlyphs :: FontInfo -> ByteString -> [(Glyph, Double)]
fontInfoDecodeGlyphs :: FontInfo -> ByteString -> [(Glyph, Double)]
fontInfoDecodeGlyphs fInfo :: FontInfo
fInfo@(FontInfoSimple FISimple
fi) = \ByteString
bs ->
((Word8 -> (Glyph, Double)) -> [Word8] -> [(Glyph, Double)])
-> [Word8] -> (Word8 -> (Glyph, Double)) -> [(Glyph, Double)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Word8 -> (Glyph, Double)) -> [Word8] -> [(Glyph, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> [Word8]
BS.unpack ByteString
bs) ((Word8 -> (Glyph, Double)) -> [(Glyph, Double)])
-> (Word8 -> (Glyph, Double)) -> [(Glyph, Double)]
forall a b. (a -> b) -> a -> b
$ \Word8
c ->
let code :: Int
code = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c
txt :: Maybe Text
txt =
case FISimple -> Maybe UnicodeCMap
fiSimpleUnicodeCMap FISimple
fi of
Maybe UnicodeCMap
Nothing ->
case FISimple -> Maybe SimpleFontEncoding
fiSimpleEncoding FISimple
fi of
Maybe SimpleFontEncoding
Nothing ->
case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ([Word8] -> ByteString
BS.pack [Word8
c]) of
Right Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
Either UnicodeException Text
_ -> Maybe Text
forall a. Maybe a
Nothing
Just SimpleFontEncoding
enc ->
case SimpleFontEncoding -> Word8 -> Maybe Text
simpleFontEncodingDecode SimpleFontEncoding
enc Word8
c of
Just Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
Maybe Text
Nothing ->
case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ([Word8] -> ByteString
BS.pack [Word8
c]) of
Right Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
Either UnicodeException Text
_ -> Maybe Text
forall a. Maybe a
Nothing
Just UnicodeCMap
toUnicode ->
case UnicodeCMap -> Int -> Maybe Text
unicodeCMapDecodeGlyph UnicodeCMap
toUnicode Int
code of
Just Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
Maybe Text
Nothing ->
case FISimple -> Maybe SimpleFontEncoding
fiSimpleEncoding FISimple
fi of
Maybe SimpleFontEncoding
Nothing -> Maybe Text
forall a. Maybe a
Nothing
Just SimpleFontEncoding
enc ->
case SimpleFontEncoding -> Word8 -> Maybe Text
simpleFontEncodingDecode SimpleFontEncoding
enc Word8
c of
Just Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
Maybe Text
Nothing ->
case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ([Word8] -> ByteString
BS.pack [Word8
c]) of
Right Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
Either UnicodeException Text
_ -> Maybe Text
forall a. Maybe a
Nothing
width :: Double
width =
case FISimple -> Maybe (Int, Int, [Double])
fiSimpleWidths FISimple
fi of
Maybe (Int, Int, [Double])
Nothing -> Double
0
Just (Int
firstChar, Int
lastChar, [Double]
widths) ->
if Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
firstChar Bool -> Bool -> Bool
&& Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
lastChar
Bool -> Bool -> Bool
&& (Int
code Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
firstChar) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
widths
then let Vector Double
w Double
_ = Transform Double -> Vector Double -> Vector Double
forall a. Num a => Transform a -> Vector a -> Vector a
transform (FISimple -> Transform Double
fiSimpleFontMatrix FISimple
fi) (Vector Double -> Vector Double) -> Vector Double -> Vector Double
forall a b. (a -> b) -> a -> b
$
Double -> Double -> Vector Double
forall a. a -> a -> Vector a
Vector ([Double]
widths [Double] -> Int -> Double
forall a. [a] -> Int -> a
!! (Int
code Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
firstChar)) Double
0
in Double
w
else Double
0
(Double
yBottom, Double
yTop) = FontInfo -> Int -> (Double, Double)
getGlyphYCoordinates FontInfo
fInfo Int
code
in (Glyph :: Int -> Vector Double -> Vector Double -> Maybe Text -> Glyph
Glyph {
glyphCode :: Int
glyphCode = Int
code,
glyphTopLeft :: Vector Double
glyphTopLeft = Double -> Double -> Vector Double
forall a. a -> a -> Vector a
Vector Double
0 Double
yBottom,
glyphBottomRight :: Vector Double
glyphBottomRight = Double -> Double -> Vector Double
forall a. a -> a -> Vector a
Vector Double
width Double
yTop,
glyphText :: Maybe Text
glyphText = Maybe Text
txt
}, Double
width)
fontInfoDecodeGlyphs fInfo :: FontInfo
fInfo@(FontInfoComposite FIComposite
fi) = \ByteString
bs ->
case FIComposite -> Maybe UnicodeCMap
fiCompositeUnicodeCMap FIComposite
fi of
Maybe UnicodeCMap
Nothing ->
[Word8] -> [(Glyph, Double)]
tryDecode2byte ([Word8] -> [(Glyph, Double)]) -> [Word8] -> [(Glyph, Double)]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
bs
Just UnicodeCMap
toUnicode ->
let getWidth :: Int -> Double
getWidth = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (FIComposite -> Double
fiCompositeDefaultWidth FIComposite
fi)
(Maybe Double -> Double) -> (Int -> Maybe Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIDFontWidths -> Int -> Maybe Double
cidFontGetWidth (FIComposite -> CIDFontWidths
fiCompositeWidths FIComposite
fi)
in (Int -> Double)
-> UnicodeCMap -> FontInfo -> ByteString -> [(Glyph, Double)]
cmapDecodeString Int -> Double
getWidth UnicodeCMap
toUnicode FontInfo
fInfo ByteString
bs
where
tryDecode2byte :: [Word8] -> [(Glyph, Double)]
tryDecode2byte (Word8
b1:Word8
b2:[Word8]
rest) =
let code :: Int
code = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
255 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2
width :: Double
width = (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000) (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (FIComposite -> Double
fiCompositeDefaultWidth FIComposite
fi)
(Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ CIDFontWidths -> Int -> Maybe Double
cidFontGetWidth (FIComposite -> CIDFontWidths
fiCompositeWidths FIComposite
fi) Int
code
txt :: Maybe Text
txt =
case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ([Word8] -> ByteString
BS.pack [Word8
b1, Word8
b2]) of
Right Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
Either UnicodeException Text
_ -> Maybe Text
forall a. Maybe a
Nothing
(Double
yBottom, Double
yTop) = FontInfo -> Int -> (Double, Double)
getGlyphYCoordinates FontInfo
fInfo Int
code
g :: Glyph
g = Glyph :: Int -> Vector Double -> Vector Double -> Maybe Text -> Glyph
Glyph {
glyphCode :: Int
glyphCode = Int
code,
glyphTopLeft :: Vector Double
glyphTopLeft = Double -> Double -> Vector Double
forall a. a -> a -> Vector a
Vector Double
0 Double
yBottom,
glyphBottomRight :: Vector Double
glyphBottomRight = Double -> Double -> Vector Double
forall a. a -> a -> Vector a
Vector Double
width Double
yTop,
glyphText :: Maybe Text
glyphText = Maybe Text
txt
}
in (Glyph
g, Double
width) (Glyph, Double) -> [(Glyph, Double)] -> [(Glyph, Double)]
forall a. a -> [a] -> [a]
: [Word8] -> [(Glyph, Double)]
tryDecode2byte [Word8]
rest
tryDecode2byte [Word8]
_ = []
cmapDecodeString
:: (Int -> Double)
-> UnicodeCMap
-> FontInfo
-> ByteString
-> [(Glyph, Double)]
cmapDecodeString :: (Int -> Double)
-> UnicodeCMap -> FontInfo -> ByteString -> [(Glyph, Double)]
cmapDecodeString Int -> Double
getWidth UnicodeCMap
cmap FontInfo
fInfo ByteString
str = ByteString -> [(Glyph, Double)]
go ByteString
str
where
go :: ByteString -> [(Glyph, Double)]
go ByteString
s =
case UnicodeCMap -> ByteString -> Maybe (Int, ByteString)
unicodeCMapNextGlyph UnicodeCMap
cmap ByteString
s of
Maybe (Int, ByteString)
Nothing -> []
Just (Int
g, ByteString
rest) ->
let width :: Double
width = Int -> Double
getWidth Int
g Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000
(Double
yBottom, Double
yTop) = FontInfo -> Int -> (Double, Double)
getGlyphYCoordinates FontInfo
fInfo Int
g
glyph :: Glyph
glyph = Glyph :: Int -> Vector Double -> Vector Double -> Maybe Text -> Glyph
Glyph {
glyphCode :: Int
glyphCode = Int
g,
glyphTopLeft :: Vector Double
glyphTopLeft = Double -> Double -> Vector Double
forall a. a -> a -> Vector a
Vector Double
0 Double
yBottom,
glyphBottomRight :: Vector Double
glyphBottomRight = Double -> Double -> Vector Double
forall a. a -> a -> Vector a
Vector Double
width Double
yTop,
glyphText :: Maybe Text
glyphText = UnicodeCMap -> Int -> Maybe Text
unicodeCMapDecodeGlyph UnicodeCMap
cmap Int
g
}
in (Glyph
glyph, Double
width) (Glyph, Double) -> [(Glyph, Double)] -> [(Glyph, Double)]
forall a. a -> [a] -> [a]
: ByteString -> [(Glyph, Double)]
go ByteString
rest