-- | The FontDescriptor describes a font's other metrics than it's
-- widths, see chap. 9.8 of PDF32000:2008

module Pdf.Content.FontDescriptor
  ( FontDescriptor(..)
  , FontDescriptorFlag(..)
  , flagSet
  )
where

import Pdf.Core.Types

import Data.Int
import Data.ByteString (ByteString)

data FontDescriptor = FontDescriptor {
  FontDescriptor -> ByteString
fdFontName :: ByteString,
  FontDescriptor -> Maybe ByteString
fdFontFamily :: Maybe ByteString,
  FontDescriptor -> Maybe ByteString
fdFontStretch :: Maybe ByteString,
  FontDescriptor -> Maybe Int
fdFontWeight :: Maybe Int,
  FontDescriptor -> Int64
fdFlags :: Int64, -- must hold at least 32 bit unsigned integers
  FontDescriptor -> Maybe (Rectangle Double)
fdFontBBox :: Maybe (Rectangle Double),
  FontDescriptor -> Double
fdItalicAngle :: Double,
  FontDescriptor -> Maybe Double
fdAscent :: Maybe Double,
  FontDescriptor -> Maybe Double
fdDescent :: Maybe Double,
  FontDescriptor -> Maybe Double
fdLeading :: Maybe Double,
  FontDescriptor -> Maybe Double
fdCapHeight :: Maybe Double,
  FontDescriptor -> Maybe Double
fdXHeight :: Maybe Double,
  FontDescriptor -> Maybe Double
fdStemV :: Maybe Double,
  FontDescriptor -> Maybe Double
fdStemH :: Maybe Double,
  FontDescriptor -> Maybe Double
fdAvgWidth :: Maybe Double,
  FontDescriptor -> Maybe Double
fdMaxWidth :: Maybe Double,
  FontDescriptor -> Maybe Double
fdMissingWidth :: Maybe Double,
  -- FIXME: add FontFile*
  FontDescriptor -> Maybe ByteString
fdCharSet :: Maybe ByteString
  -- FIXME: add special fields for CIDFonts
  } deriving (Int -> FontDescriptor -> ShowS
[FontDescriptor] -> ShowS
FontDescriptor -> String
(Int -> FontDescriptor -> ShowS)
-> (FontDescriptor -> String)
-> ([FontDescriptor] -> ShowS)
-> Show FontDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontDescriptor] -> ShowS
$cshowList :: [FontDescriptor] -> ShowS
show :: FontDescriptor -> String
$cshow :: FontDescriptor -> String
showsPrec :: Int -> FontDescriptor -> ShowS
$cshowsPrec :: Int -> FontDescriptor -> ShowS
Show)


data FontDescriptorFlag =
  FixedPitch | Serif | Symbolic | Script | NonSymbolic | Italic | AllCap | SmallCap | ForceBold


flagSet :: FontDescriptor -> FontDescriptorFlag -> Bool
flagSet :: FontDescriptor -> FontDescriptorFlag -> Bool
flagSet FontDescriptor
fd FontDescriptorFlag
FixedPitch = Int -> Int64 -> Int -> Bool
flagSet' Int
1 (FontDescriptor -> Int64
fdFlags FontDescriptor
fd) Int
0
flagSet FontDescriptor
fd FontDescriptorFlag
Serif = Int -> Int64 -> Int -> Bool
flagSet' Int
2 (FontDescriptor -> Int64
fdFlags FontDescriptor
fd) Int
0
flagSet FontDescriptor
fd FontDescriptorFlag
Symbolic = Int -> Int64 -> Int -> Bool
flagSet' Int
3 (FontDescriptor -> Int64
fdFlags FontDescriptor
fd) Int
0
flagSet FontDescriptor
fd FontDescriptorFlag
Script = Int -> Int64 -> Int -> Bool
flagSet' Int
4 (FontDescriptor -> Int64
fdFlags FontDescriptor
fd) Int
0
flagSet FontDescriptor
fd FontDescriptorFlag
NonSymbolic = Int -> Int64 -> Int -> Bool
flagSet' Int
6 (FontDescriptor -> Int64
fdFlags FontDescriptor
fd) Int
0
flagSet FontDescriptor
fd FontDescriptorFlag
Italic = Int -> Int64 -> Int -> Bool
flagSet' Int
7 (FontDescriptor -> Int64
fdFlags FontDescriptor
fd) Int
0
flagSet FontDescriptor
fd FontDescriptorFlag
AllCap = Int -> Int64 -> Int -> Bool
flagSet' Int
17 (FontDescriptor -> Int64
fdFlags FontDescriptor
fd) Int
0
flagSet FontDescriptor
fd FontDescriptorFlag
SmallCap = Int -> Int64 -> Int -> Bool
flagSet' Int
18 (FontDescriptor -> Int64
fdFlags FontDescriptor
fd) Int
0
flagSet FontDescriptor
fd FontDescriptorFlag
ForceBold = Int -> Int64 -> Int -> Bool
flagSet' Int
19 (FontDescriptor -> Int64
fdFlags FontDescriptor
fd) Int
0

flagSet' :: Int -> Int64 -> Int -> Bool
flagSet' :: Int -> Int64 -> Int -> Bool
flagSet' Int
pos Int64
val Int
expnt
  | Int
expnt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = Int64
val Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
2 Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
1
  | Int64
val Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0 = Bool
False
  | Bool
otherwise = Int -> Int64 -> Int -> Bool
flagSet' Int
pos (Int64
val Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
2) (Int
expntInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)