{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE StandaloneDeriving #-}
---------------------------------------------------------
-- |
-- 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.Font(
      IsFont(..)
    , GlyphSize
    , FontSize 
    , PDFFont(..)
    , AnyFont(..)
    , FontStructure
    , EmbeddedFont
    , FontData
    , emptyFontStructure
    , fontSize
    , trueSize
    , readFontData
) where 

import Graphics.PDF.LowLevel.Types
import Graphics.PDF.Resources
import qualified Data.Map.Strict as M
import qualified Data.ByteString as B
import Graphics.PDF.Fonts.FontTypes

emptyFontStructure :: FontStructure
emptyFontStructure :: FontStructure
emptyFontStructure = FS :: String
-> GlyphSize
-> GlyphSize
-> GlyphSize
-> Map GlyphCode GlyphSize
-> Map GlyphPair GlyphSize
-> Maybe GlyphCode
-> GlyphCode
-> Map Char GlyphCode
-> [PDFFloat]
-> PDFFloat
-> GlyphSize
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> FontStructure
FS { baseFont :: String
baseFont = String
""
                        , descent :: GlyphSize
descent = GlyphSize
0
                        , ascent :: GlyphSize
ascent  = GlyphSize
0
                        , height :: GlyphSize
height = GlyphSize
0
                        , widthData :: Map GlyphCode GlyphSize
widthData = Map GlyphCode GlyphSize
forall k a. Map k a
M.empty
                        , kernMetrics :: Map GlyphPair GlyphSize
kernMetrics = Map GlyphPair GlyphSize
forall k a. Map k a
M.empty
                        , hyphen :: Maybe GlyphCode
hyphen = Maybe GlyphCode
forall a. Maybe a
Nothing
                        , space :: GlyphCode
space = GlyphCode
0
                        , encoding :: Map Char GlyphCode
encoding = Map Char GlyphCode
forall k a. Map k a
M.empty
                        , fontBBox :: [PDFFloat]
fontBBox = []
                        , italicAngle :: PDFFloat
italicAngle = PDFFloat
0
                        , capHeight :: GlyphSize
capHeight = GlyphSize
0
                        , fixedPitch :: Bool
fixedPitch = Bool
False
                        , serif :: Bool
serif = Bool
False
                        , symbolic :: Bool
symbolic = Bool
False
                        , script :: Bool
script = Bool
False
                        , nonSymbolic :: Bool
nonSymbolic = Bool
False
                        , italic :: Bool
italic = Bool
False
                        , allCap :: Bool
allCap = Bool
False
                        , smallCap :: Bool
smallCap = Bool
False
                        , forceBold :: Bool
forceBold = Bool
False
                        }

class IsFont f where
    {-
    Font descriptions
    -}
    name :: f -> String
    {-
    Font metrics
    -}
    getDescent :: f -> FontSize -> PDFFloat
    getHeight :: f -> FontSize -> PDFFloat
    {-
    Glyph metrics
    -}
    getKern :: f -> FontSize -> GlyphCode -> GlyphCode  -> PDFFloat
    glyphWidth :: f -> FontSize -> GlyphCode  -> PDFFloat
    {-
    Font convertions
    -}
    hyphenGlyph :: f -> Maybe GlyphCode
    spaceGlyph :: f -> GlyphCode
    charGlyph :: f -> Char  -> GlyphCode 

data AnyFont = forall f. (IsFont f,PdfResourceObject f,Show f) => AnyFont f

deriving instance Show AnyFont

instance PdfResourceObject AnyFont where
   toRsrc :: AnyFont -> AnyPdfObject
toRsrc (AnyFont f
f) = f -> AnyPdfObject
forall a. PdfResourceObject a => a -> AnyPdfObject
toRsrc f
f

instance IsFont AnyFont where 
    name :: AnyFont -> String
name (AnyFont f
f) = f -> String
forall f. IsFont f => f -> String
name f
f 
    getDescent :: AnyFont -> Int -> PDFFloat
getDescent (AnyFont f
f) = f -> Int -> PDFFloat
forall f. IsFont f => f -> Int -> PDFFloat
getDescent f
f
    getHeight :: AnyFont -> Int -> PDFFloat
getHeight (AnyFont f
f) = f -> Int -> PDFFloat
forall f. IsFont f => f -> Int -> PDFFloat
getHeight f
f
    {-
    Font metrics
    -}
    getKern :: AnyFont -> Int -> GlyphCode -> GlyphCode -> PDFFloat
getKern (AnyFont f
f) = f -> Int -> GlyphCode -> GlyphCode -> PDFFloat
forall f.
IsFont f =>
f -> Int -> GlyphCode -> GlyphCode -> PDFFloat
getKern f
f
    glyphWidth :: AnyFont -> Int -> GlyphCode -> PDFFloat
glyphWidth (AnyFont f
f) = f -> Int -> GlyphCode -> PDFFloat
forall f. IsFont f => f -> Int -> GlyphCode -> PDFFloat
glyphWidth f
f
    {-
    Font convertions
    -}
    hyphenGlyph :: AnyFont -> Maybe GlyphCode
hyphenGlyph (AnyFont f
f) = f -> Maybe GlyphCode
forall f. IsFont f => f -> Maybe GlyphCode
hyphenGlyph f
f
    spaceGlyph :: AnyFont -> GlyphCode
spaceGlyph (AnyFont f
f) = f -> GlyphCode
forall f. IsFont f => f -> GlyphCode
spaceGlyph f
f
    charGlyph :: AnyFont -> Char -> GlyphCode
charGlyph (AnyFont f
f) = f -> Char -> GlyphCode
forall f. IsFont f => f -> Char -> GlyphCode
charGlyph f
f

instance Eq AnyFont where 
    AnyFont
a == :: AnyFont -> AnyFont -> Bool
== AnyFont
b = AnyFont -> String
forall f. IsFont f => f -> String
name AnyFont
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== AnyFont -> String
forall f. IsFont f => f -> String
name AnyFont
b

instance Ord AnyFont where 
    compare :: AnyFont -> AnyFont -> Ordering
compare AnyFont
a AnyFont
b = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AnyFont -> String
forall f. IsFont f => f -> String
name AnyFont
a) (AnyFont -> String
forall f. IsFont f => f -> String
name AnyFont
b)

data PDFFont = PDFFont AnyFont FontSize deriving(PDFFont -> PDFFont -> Bool
(PDFFont -> PDFFont -> Bool)
-> (PDFFont -> PDFFont -> Bool) -> Eq PDFFont
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PDFFont -> PDFFont -> Bool
$c/= :: PDFFont -> PDFFont -> Bool
== :: PDFFont -> PDFFont -> Bool
$c== :: PDFFont -> PDFFont -> Bool
Eq)

fontSize :: PDFFont -> FontSize 
fontSize :: PDFFont -> Int
fontSize (PDFFont AnyFont
_ Int
s) = Int
s

instance Ord PDFFont where
    compare :: PDFFont -> PDFFont -> Ordering
compare (PDFFont AnyFont
na Int
sa) (PDFFont AnyFont
nb Int
sb) = if Int
sa Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sb then AnyFont -> AnyFont -> Ordering
forall a. Ord a => a -> a -> Ordering
compare AnyFont
na AnyFont
nb else Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
sa Int
sb

-- pixel size / 2048 gives factor 

trueSize :: Int -> GlyphSize -> PDFFloat
trueSize :: Int -> GlyphSize -> PDFFloat
trueSize Int
fs GlyphSize
glyphSize = (GlyphSize -> PDFFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral GlyphSize
glyphSize PDFFloat -> PDFFloat -> PDFFloat
forall a. Num a => a -> a -> a
* Int -> PDFFloat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
fs) PDFFloat -> PDFFloat -> PDFFloat
forall a. Fractional a => a -> a -> a
/ PDFFloat
1000.0





readFontData :: FilePath -> IO FontData 
readFontData :: String -> IO FontData
readFontData String
f = do 
    ByteString
r <- String -> IO ByteString
B.readFile String
f 
    FontData -> IO FontData
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> FontData
Type1Data ByteString
r)