{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

-- | Rendering bitmap text with __pcf-font__ is easy. For instance, a program that renders text into a PNG is trivial:
--
-- > import Codec.Picture.Png
-- > import Codec.Picture.Types
-- > import Data.List
-- > import Graphics.Text.PCF
-- > import System.Environment
-- >
-- > -- | USAGE: program <font.pcf.gz> <output.png> <text>
-- > main :: IO ()
-- > main = do
-- >     [input_file, output_file, text] <- getArgs
-- >     pcf <- either fail return =<< loadPCF input_file
-- >     case renderPCFText pcf text of
-- >         Just (PCFText _ w h img) ->
-- >             writePng output_file (Image w h img :: Image Pixel8)
-- >         Nothing ->
-- >             putStrLn "ERROR: Unable to render input text."
--
-- Rendering some text as an ASCII bitmap is also convenient:
--
-- > import Graphics.Text.PCF
-- > import System.Environment
-- >
-- > -- | USAGE: program <font.pcf.gz> <text>
-- > main :: IO ()
-- > main = do
-- >     [font_file, text] <- getArgs
-- >     pcf <- either fail return =<< loadPCF font_file
-- >     case renderPCFText pcf text of
-- >         Just pcf_text ->
-- >             putStrLn $ pcf_text_ascii pcf_text
-- >         Nothing ->
-- >             putStrLn "ERROR: Unable to render input text."
module Graphics.Text.PCF (
        -- * Decoding
        loadPCF,
        decodePCF,
        -- * Rendering
        renderPCFText,
        renderPCFTextColor,
        getPCFGlyph,
        getPCFGlyphPixel,
        foldPCFGlyphPixels,
        -- * ASCII Rendering
        pcf_text_ascii,
        glyph_ascii,
        glyph_ascii_lines,
        -- * Metadata
        getPCFProps,
        -- * Types
        PCF,
        PCFGlyph(..),
        PCFText(..),
        Metrics(..)
    ) where

import Data.Binary
import Data.Binary.Get
import Data.Bits
import Data.Bool
import Data.List
import Data.Maybe
import qualified Data.Map.Strict as M
import Control.Monad
import Control.Applicative
import Data.ByteString.Lazy (ByteString)
import Data.Vector ((!?))
import GHC.Exts
import Data.Char
import qualified Data.ByteString.Lazy as B
import qualified Data.Vector as V
import qualified Data.Vector.Storable as VS
import qualified Data.IntMap as IntMap
import Graphics.Text.PCF.Types
import Codec.Compression.GZip

assert :: MonadFail m => Bool -> String -> m ()
assert :: Bool -> String -> m ()
assert Bool
True  = m () -> String -> m ()
forall a b. a -> b -> a
const (m () -> String -> m ()) -> m () -> String -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
assert Bool
False = String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail

allUnique :: Eq a => [a] -> Bool
allUnique :: [a] -> Bool
allUnique [] = Bool
True
allUnique (a
x:[a]
xs) = a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
xs Bool -> Bool -> Bool
&& [a] -> Bool
forall a. Eq a => [a] -> Bool
allUnique [a]
xs

-- | List key-value pairs found in PCF properties table.
getPCFProps :: PCF -> [(ByteString, Either ByteString Int)]
getPCFProps :: PCF -> [(ByteString, Either ByteString Int)]
getPCFProps PCF{Maybe (TableMeta, Table)
(TableMeta, Table)
pcf_ink_metrics :: PCF -> Maybe (TableMeta, Table)
pcf_glyph_names :: PCF -> Maybe (TableMeta, Table)
pcf_accelerators :: PCF -> (TableMeta, Table)
pcf_swidths :: PCF -> (TableMeta, Table)
pcf_bdf_encodings :: PCF -> (TableMeta, Table)
pcf_bitmaps :: PCF -> (TableMeta, Table)
pcf_metrics :: PCF -> (TableMeta, Table)
pcf_properties :: PCF -> (TableMeta, Table)
pcf_ink_metrics :: Maybe (TableMeta, Table)
pcf_glyph_names :: Maybe (TableMeta, Table)
pcf_accelerators :: (TableMeta, Table)
pcf_swidths :: (TableMeta, Table)
pcf_bdf_encodings :: (TableMeta, Table)
pcf_bitmaps :: (TableMeta, Table)
pcf_metrics :: (TableMeta, Table)
pcf_properties :: (TableMeta, Table)
..} = ((Prop -> (ByteString, Either ByteString Int))
 -> [Prop] -> [(ByteString, Either ByteString Int)])
-> [Prop]
-> (Prop -> (ByteString, Either ByteString Int))
-> [(ByteString, Either ByteString Int)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Prop -> (ByteString, Either ByteString Int))
-> [Prop] -> [(ByteString, Either ByteString Int)]
forall a b. (a -> b) -> [a] -> [b]
map [Prop]
properties_props ((Prop -> (ByteString, Either ByteString Int))
 -> [(ByteString, Either ByteString Int)])
-> (Prop -> (ByteString, Either ByteString Int))
-> [(ByteString, Either ByteString Int)]
forall a b. (a -> b) -> a -> b
$ \Prop{Word8
Word32
prop_value :: Prop -> Word32
prop_is_string :: Prop -> Word8
prop_name_offset :: Prop -> Word32
prop_value :: Word32
prop_is_string :: Word8
prop_name_offset :: Word32
..} ->
        (Word32 -> ByteString
getPropString Word32
prop_name_offset,
         if Word8
prop_is_string Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0 then
             ByteString -> Either ByteString Int
forall a b. a -> Either a b
Left (ByteString -> Either ByteString Int)
-> ByteString -> Either ByteString Int
forall a b. (a -> b) -> a -> b
$ Word32 -> ByteString
getPropString Word32
prop_value
         else
             Int -> Either ByteString Int
forall a b. b -> Either a b
Right (Int -> Either ByteString Int) -> Int -> Either ByteString Int
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
prop_value)
    where
        (TableMeta
_, PROPERTIES{[Prop]
ByteString
properties_strings :: Table -> ByteString
properties_props :: Table -> [Prop]
properties_strings :: ByteString
properties_props :: [Prop]
..}) = (TableMeta, Table)
pcf_properties
        getPropString :: Word32 -> ByteString
getPropString = (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString)
-> (Word32 -> ByteString) -> Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> ByteString -> ByteString)
-> ByteString -> Int64 -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int64 -> ByteString -> ByteString
B.drop ByteString
properties_strings (Int64 -> ByteString) -> (Word32 -> Int64) -> Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Extract a single glyph bitmap from a PCF font.
getPCFGlyph :: PCF -> Char -> Maybe PCFGlyph
getPCFGlyph :: PCF -> Char -> Maybe PCFGlyph
getPCFGlyph PCF{Maybe (TableMeta, Table)
(TableMeta, Table)
pcf_ink_metrics :: Maybe (TableMeta, Table)
pcf_glyph_names :: Maybe (TableMeta, Table)
pcf_accelerators :: (TableMeta, Table)
pcf_swidths :: (TableMeta, Table)
pcf_bdf_encodings :: (TableMeta, Table)
pcf_bitmaps :: (TableMeta, Table)
pcf_metrics :: (TableMeta, Table)
pcf_properties :: (TableMeta, Table)
pcf_ink_metrics :: PCF -> Maybe (TableMeta, Table)
pcf_glyph_names :: PCF -> Maybe (TableMeta, Table)
pcf_accelerators :: PCF -> (TableMeta, Table)
pcf_swidths :: PCF -> (TableMeta, Table)
pcf_bdf_encodings :: PCF -> (TableMeta, Table)
pcf_bitmaps :: PCF -> (TableMeta, Table)
pcf_metrics :: PCF -> (TableMeta, Table)
pcf_properties :: PCF -> (TableMeta, Table)
..} Char
c = do
        Int
glyph_index <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Maybe Word16 -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IntMap Word16 -> Maybe Word16
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Char -> Int
ord Char
c) IntMap Word16
encodings_glyph_indices
        Int64
offset      <- Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int64) -> Maybe Word32 -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vector Word32
bitmaps_offsets Vector Word32 -> Int -> Maybe Word32
forall a. Vector a -> Int -> Maybe a
!? Int
glyph_index)
        m :: Metrics
m@Metrics{Int16
metrics_character_attributes :: Metrics -> Int16
metrics_character_descent :: Metrics -> Int16
metrics_character_ascent :: Metrics -> Int16
metrics_character_width :: Metrics -> Int16
metrics_right_sided_bearings :: Metrics -> Int16
metrics_left_sided_bearings :: Metrics -> Int16
metrics_character_attributes :: Int16
metrics_character_descent :: Int16
metrics_character_ascent :: Int16
metrics_character_width :: Int16
metrics_right_sided_bearings :: Int16
metrics_left_sided_bearings :: Int16
..} <- Vector Metrics
metrics_metrics Vector Metrics -> Int -> Maybe Metrics
forall a. Vector a -> Int -> Maybe a
!? Int
glyph_index
        let cols :: Int
cols = Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int) -> Int16 -> Int
forall a b. (a -> b) -> a -> b
$ Int16
metrics_right_sided_bearings Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
- Int16
metrics_left_sided_bearings
            rows :: Int
rows = Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int) -> Int16 -> Int
forall a b. (a -> b) -> a -> b
$ Int16
metrics_character_ascent Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
metrics_character_descent
        Int
pitch <- case TableMeta -> Word8
tableMetaGlyphPad TableMeta
meta_bitmaps of
                    Word8
1 -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
                    Word8
2 -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ((Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
15) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
4) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
1
                    Word8
4 -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ((Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
31) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
5) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2
                    Word8
8 -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ((Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
63) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
3
                    Word8
_ -> Maybe Int
forall a. Maybe a
Nothing
        let bytes :: Int64
bytes = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pitch
        PCFGlyph -> Maybe PCFGlyph
forall (m :: * -> *) a. Monad m => a -> m a
return (PCFGlyph -> Maybe PCFGlyph) -> PCFGlyph -> Maybe PCFGlyph
forall a b. (a -> b) -> a -> b
$ Metrics -> Char -> Int -> Int -> Int -> ByteString -> PCFGlyph
PCFGlyph Metrics
m Char
c Int
cols Int
rows Int
pitch (Int64 -> ByteString -> ByteString
B.take Int64
bytes (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
B.drop Int64
offset ByteString
bitmaps_data)
    where
        (TableMeta
meta_bitmaps, BITMAPS{Word32
(Word32, Word32, Word32, Word32)
ByteString
Vector Word32
bitmaps_data :: Table -> ByteString
bitmaps_sizes :: Table -> (Word32, Word32, Word32, Word32)
bitmaps_offsets :: Table -> Vector Word32
bitmaps_glyph_count :: Table -> Word32
bitmaps_sizes :: (Word32, Word32, Word32, Word32)
bitmaps_glyph_count :: Word32
bitmaps_data :: ByteString
bitmaps_offsets :: Vector Word32
..}) = (TableMeta, Table)
pcf_bitmaps
        (TableMeta
_, METRICS{Bool
Vector Metrics
metrics_metrics :: Table -> Vector Metrics
metrics_compressed :: Table -> Bool
metrics_ink_type :: Table -> Bool
metrics_compressed :: Bool
metrics_ink_type :: Bool
metrics_metrics :: Vector Metrics
..})            = (TableMeta, Table)
pcf_metrics
        (TableMeta
_, BDF_ENCODINGS{Word16
(Word16, Word16)
IntMap Word16
encodings_glyph_indices :: Table -> IntMap Word16
encodings_default_char :: Table -> Word16
encodings_rows :: Table -> (Word16, Word16)
encodings_cols :: Table -> (Word16, Word16)
encodings_default_char :: Word16
encodings_rows :: (Word16, Word16)
encodings_cols :: (Word16, Word16)
encodings_glyph_indices :: IntMap Word16
..})      = (TableMeta, Table)
pcf_bdf_encodings

getPCF :: Get PCF
getPCF :: Get PCF
getPCF = do
    ByteString
magic <- Int -> Get ByteString
getByteString Int
4
    Bool -> String -> Get ()
forall (m :: * -> *). MonadFail m => Bool -> String -> m ()
assert (ByteString
magic ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"\1fcp")
        String
"Invalid magic number found in PCF header."
    -- Table count silently capped at 9 for compatibility with FreeType
    Word32
table_count <- Word32 -> Word32 -> Word32
forall a. Ord a => a -> a -> a
min Word32
9 (Word32 -> Word32) -> Get Word32 -> Get Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
    [TableMeta]
table_metas <- (TableMeta -> Word32) -> [TableMeta] -> [TableMeta]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith TableMeta -> Word32
tableMetaOffset ([TableMeta] -> [TableMeta]) -> Get [TableMeta] -> Get [TableMeta]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get TableMeta -> Get [TableMeta]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
table_count) Get TableMeta
getTableMeta
    let table_in_bounds :: (TableMeta, TableMeta) -> Bool
table_in_bounds (TableMeta
t0, TableMeta
t1) = TableMeta -> Word32
tableMetaSize TableMeta
t0 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= TableMeta -> Word32
tableMetaOffset TableMeta
t1 Bool -> Bool -> Bool
&&
                                   TableMeta -> Word32
tableMetaOffset TableMeta
t0 Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= TableMeta -> Word32
tableMetaOffset TableMeta
t1 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- TableMeta -> Word32
tableMetaSize TableMeta
t0
        table_types :: [PCFTableType]
table_types = (TableMeta -> PCFTableType) -> [TableMeta] -> [PCFTableType]
forall a b. (a -> b) -> [a] -> [b]
map TableMeta -> PCFTableType
tableMetaType [TableMeta]
table_metas
    Bool -> String -> Get ()
forall (m :: * -> *). MonadFail m => Bool -> String -> m ()
assert (((TableMeta, TableMeta) -> Bool)
-> [(TableMeta, TableMeta)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TableMeta, TableMeta) -> Bool
table_in_bounds ([(TableMeta, TableMeta)] -> Bool)
-> [(TableMeta, TableMeta)] -> Bool
forall a b. (a -> b) -> a -> b
$ [TableMeta] -> [TableMeta] -> [(TableMeta, TableMeta)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TableMeta]
table_metas ([TableMeta] -> [(TableMeta, TableMeta)])
-> [TableMeta] -> [(TableMeta, TableMeta)]
forall a b. (a -> b) -> a -> b
$ [TableMeta] -> [TableMeta]
forall a. [a] -> [a]
tail [TableMeta]
table_metas)
        String
"Multiple PCF tables overlap, according to metadata."
    Bool -> String -> Get ()
forall (m :: * -> *). MonadFail m => Bool -> String -> m ()
assert ([PCFTableType] -> Bool
forall a. Eq a => [a] -> Bool
allUnique [PCFTableType]
table_types)
        String
"Multiple PCF tables of the same type is not supported."
    [Table]
tables <- (TableMeta -> Get Table) -> [TableMeta] -> Get [Table]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TableMeta -> Get Table
get_table [TableMeta]
table_metas
    let tableMap :: PCFTableType -> Maybe (TableMeta, Table)
tableMap = (PCFTableType
 -> Map PCFTableType (TableMeta, Table) -> Maybe (TableMeta, Table))
-> Map PCFTableType (TableMeta, Table)
-> PCFTableType
-> Maybe (TableMeta, Table)
forall a b c. (a -> b -> c) -> b -> a -> c
flip PCFTableType
-> Map PCFTableType (TableMeta, Table) -> Maybe (TableMeta, Table)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Map PCFTableType (TableMeta, Table)
 -> PCFTableType -> Maybe (TableMeta, Table))
-> Map PCFTableType (TableMeta, Table)
-> PCFTableType
-> Maybe (TableMeta, Table)
forall a b. (a -> b) -> a -> b
$ [(PCFTableType, (TableMeta, Table))]
-> Map PCFTableType (TableMeta, Table)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PCFTableType, (TableMeta, Table))]
 -> Map PCFTableType (TableMeta, Table))
-> [(PCFTableType, (TableMeta, Table))]
-> Map PCFTableType (TableMeta, Table)
forall a b. (a -> b) -> a -> b
$ [PCFTableType]
-> [(TableMeta, Table)] -> [(PCFTableType, (TableMeta, Table))]
forall a b. [a] -> [b] -> [(a, b)]
zip [PCFTableType]
table_types ([(TableMeta, Table)] -> [(PCFTableType, (TableMeta, Table))])
-> [(TableMeta, Table)] -> [(PCFTableType, (TableMeta, Table))]
forall a b. (a -> b) -> a -> b
$ [TableMeta] -> [Table] -> [(TableMeta, Table)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TableMeta]
table_metas [Table]
tables
        pcf :: Maybe PCF
pcf = (TableMeta, Table)
-> (TableMeta, Table)
-> (TableMeta, Table)
-> (TableMeta, Table)
-> (TableMeta, Table)
-> (TableMeta, Table)
-> Maybe (TableMeta, Table)
-> Maybe (TableMeta, Table)
-> PCF
PCF ((TableMeta, Table)
 -> (TableMeta, Table)
 -> (TableMeta, Table)
 -> (TableMeta, Table)
 -> (TableMeta, Table)
 -> (TableMeta, Table)
 -> Maybe (TableMeta, Table)
 -> Maybe (TableMeta, Table)
 -> PCF)
-> Maybe (TableMeta, Table)
-> Maybe
     ((TableMeta, Table)
      -> (TableMeta, Table)
      -> (TableMeta, Table)
      -> (TableMeta, Table)
      -> (TableMeta, Table)
      -> Maybe (TableMeta, Table)
      -> Maybe (TableMeta, Table)
      -> PCF)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PCFTableType -> Maybe (TableMeta, Table)
tableMap PCFTableType
PCF_PROPERTIES
                  Maybe
  ((TableMeta, Table)
   -> (TableMeta, Table)
   -> (TableMeta, Table)
   -> (TableMeta, Table)
   -> (TableMeta, Table)
   -> Maybe (TableMeta, Table)
   -> Maybe (TableMeta, Table)
   -> PCF)
-> Maybe (TableMeta, Table)
-> Maybe
     ((TableMeta, Table)
      -> (TableMeta, Table)
      -> (TableMeta, Table)
      -> (TableMeta, Table)
      -> Maybe (TableMeta, Table)
      -> Maybe (TableMeta, Table)
      -> PCF)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PCFTableType -> Maybe (TableMeta, Table)
tableMap PCFTableType
PCF_METRICS
                  Maybe
  ((TableMeta, Table)
   -> (TableMeta, Table)
   -> (TableMeta, Table)
   -> (TableMeta, Table)
   -> Maybe (TableMeta, Table)
   -> Maybe (TableMeta, Table)
   -> PCF)
-> Maybe (TableMeta, Table)
-> Maybe
     ((TableMeta, Table)
      -> (TableMeta, Table)
      -> (TableMeta, Table)
      -> Maybe (TableMeta, Table)
      -> Maybe (TableMeta, Table)
      -> PCF)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PCFTableType -> Maybe (TableMeta, Table)
tableMap PCFTableType
PCF_BITMAPS
                  Maybe
  ((TableMeta, Table)
   -> (TableMeta, Table)
   -> (TableMeta, Table)
   -> Maybe (TableMeta, Table)
   -> Maybe (TableMeta, Table)
   -> PCF)
-> Maybe (TableMeta, Table)
-> Maybe
     ((TableMeta, Table)
      -> (TableMeta, Table)
      -> Maybe (TableMeta, Table)
      -> Maybe (TableMeta, Table)
      -> PCF)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PCFTableType -> Maybe (TableMeta, Table)
tableMap PCFTableType
PCF_BDF_ENCODINGS
                  Maybe
  ((TableMeta, Table)
   -> (TableMeta, Table)
   -> Maybe (TableMeta, Table)
   -> Maybe (TableMeta, Table)
   -> PCF)
-> Maybe (TableMeta, Table)
-> Maybe
     ((TableMeta, Table)
      -> Maybe (TableMeta, Table) -> Maybe (TableMeta, Table) -> PCF)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PCFTableType -> Maybe (TableMeta, Table)
tableMap PCFTableType
PCF_SWIDTHS
                  Maybe
  ((TableMeta, Table)
   -> Maybe (TableMeta, Table) -> Maybe (TableMeta, Table) -> PCF)
-> Maybe (TableMeta, Table)
-> Maybe
     (Maybe (TableMeta, Table) -> Maybe (TableMeta, Table) -> PCF)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PCFTableType -> Maybe (TableMeta, Table)
tableMap PCFTableType
PCF_BDF_ACCELERATORS Maybe (TableMeta, Table)
-> Maybe (TableMeta, Table) -> Maybe (TableMeta, Table)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PCFTableType -> Maybe (TableMeta, Table)
tableMap PCFTableType
PCF_ACCELERATORS)
                  Maybe (Maybe (TableMeta, Table) -> Maybe (TableMeta, Table) -> PCF)
-> Maybe (Maybe (TableMeta, Table))
-> Maybe (Maybe (TableMeta, Table) -> PCF)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (TableMeta, Table) -> Maybe (Maybe (TableMeta, Table))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PCFTableType -> Maybe (TableMeta, Table)
tableMap PCFTableType
PCF_GLYPH_NAMES)
                  Maybe (Maybe (TableMeta, Table) -> PCF)
-> Maybe (Maybe (TableMeta, Table)) -> Maybe PCF
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (TableMeta, Table) -> Maybe (Maybe (TableMeta, Table))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PCFTableType -> Maybe (TableMeta, Table)
tableMap PCFTableType
PCF_INK_METRICS)
        missing :: [PCFTableType]
missing = (PCFTableType -> Bool) -> [PCFTableType] -> [PCFTableType]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (TableMeta, Table) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (TableMeta, Table) -> Bool)
-> (PCFTableType -> Maybe (TableMeta, Table))
-> PCFTableType
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PCFTableType -> Maybe (TableMeta, Table)
tableMap)
                    [ PCFTableType
PCF_PROPERTIES
                    , PCFTableType
PCF_ACCELERATORS
                    , PCFTableType
PCF_METRICS
                    , PCFTableType
PCF_BITMAPS
                    , PCFTableType
PCF_INK_METRICS
                    , PCFTableType
PCF_BDF_ENCODINGS
                    , PCFTableType
PCF_SWIDTHS
                    , PCFTableType
PCF_GLYPH_NAMES
                    , PCFTableType
PCF_BDF_ACCELERATORS ]
    Get PCF -> (PCF -> Get PCF) -> Maybe PCF -> Get PCF
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Get PCF
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get PCF) -> String -> Get PCF
forall a b. (a -> b) -> a -> b
$ String
"Incomplete PCF given. One or more tables are missing: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [PCFTableType] -> String
forall a. Show a => a -> String
show [PCFTableType]
missing) PCF -> Get PCF
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PCF
pcf
    where
      isDefaultFormat, isAccelWithInkBoundsFormat, isCompressedMetricsFormat :: Word32 -> Bool
      isDefaultFormat :: Word32 -> Bool
isDefaultFormat = (Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x00000000) (Word32 -> Bool) -> (Word32 -> Word32) -> Word32 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFFFFFF00)
      isAccelWithInkBoundsFormat :: Word32 -> Bool
isAccelWithInkBoundsFormat = (Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x00000100) (Word32 -> Bool) -> (Word32 -> Word32) -> Word32 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFFFFFF00)
      isCompressedMetricsFormat :: Word32 -> Bool
isCompressedMetricsFormat = (Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0x00000100) (Word32 -> Bool) -> (Word32 -> Word32) -> Word32 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFFFFFF00)

      get_table :: TableMeta -> Get Table
get_table TableMeta{Bool
Word8
Word32
PCFTableType
tableMetaBit :: TableMeta -> Bool
tableMetaByte :: TableMeta -> Bool
tableMetaScanUnit :: TableMeta -> Word8
tableMetaFormat :: TableMeta -> Word32
tableMetaOffset :: Word32
tableMetaSize :: Word32
tableMetaBit :: Bool
tableMetaByte :: Bool
tableMetaScanUnit :: Word8
tableMetaGlyphPad :: Word8
tableMetaFormat :: Word32
tableMetaType :: PCFTableType
tableMetaType :: TableMeta -> PCFTableType
tableMetaSize :: TableMeta -> Word32
tableMetaOffset :: TableMeta -> Word32
tableMetaGlyphPad :: TableMeta -> Word8
..} = do
        Int64
pos <- Get Int64
bytesRead
        Int -> Get ()
skip (Int -> Get ()) -> Int -> Get ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
tableMetaOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
pos
        Word32
_ <- Get Word32
getWord32le -- Redundant 'format' field.
        let getWord32 :: Get Word32
getWord32 = if Bool
tableMetaByte then Get Word32
getWord32be else Get Word32
getWord32le
        let getWord16 :: Get Word16
getWord16 = if Bool
tableMetaByte then Get Word16
getWord16be else Get Word16
getWord16le
        let getInt16 :: Get Int16
getInt16 = if Bool
tableMetaByte then Get Int16
getInt16be else Get Int16
getInt16le
        let get_metrics :: Get Metrics
get_metrics = Int16 -> Int16 -> Int16 -> Int16 -> Int16 -> Int16 -> Metrics
Metrics (Int16 -> Int16 -> Int16 -> Int16 -> Int16 -> Int16 -> Metrics)
-> Get Int16
-> Get (Int16 -> Int16 -> Int16 -> Int16 -> Int16 -> Metrics)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16 Get (Int16 -> Int16 -> Int16 -> Int16 -> Int16 -> Metrics)
-> Get Int16 -> Get (Int16 -> Int16 -> Int16 -> Int16 -> Metrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int16
getInt16 Get (Int16 -> Int16 -> Int16 -> Int16 -> Metrics)
-> Get Int16 -> Get (Int16 -> Int16 -> Int16 -> Metrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int16
getInt16 Get (Int16 -> Int16 -> Int16 -> Metrics)
-> Get Int16 -> Get (Int16 -> Int16 -> Metrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int16
getInt16 Get (Int16 -> Int16 -> Metrics)
-> Get Int16 -> Get (Int16 -> Metrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int16
getInt16 Get (Int16 -> Metrics) -> Get Int16 -> Get Metrics
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int16
getInt16
        let get_metrics_table :: Bool -> Get Table
get_metrics_table Bool
ty = do
                Bool -> String -> Get ()
forall (m :: * -> *). MonadFail m => Bool -> String -> m ()
assert (Word32 -> Bool
isDefaultFormat Word32
tableMetaFormat Bool -> Bool -> Bool
|| Word32 -> Bool
isCompressedMetricsFormat Word32
tableMetaFormat)
                    String
"Properties table only supports PCF_DEAULT_FORMAT and PCF_COMPRESSED_METRICS."
                Vector Metrics
metrics <- ([Metrics] -> Vector Metrics)
-> Get [Metrics] -> Get (Vector Metrics)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Metrics] -> Vector Metrics
forall a. [a] -> Vector a
V.fromList (Get [Metrics] -> Get (Vector Metrics))
-> Get [Metrics] -> Get (Vector Metrics)
forall a b. (a -> b) -> a -> b
$ if Word32 -> Bool
isCompressedMetricsFormat Word32
tableMetaFormat then do
                  Word16
metrics_count <- Get Word16
getWord16
                  let getInt :: Get Int16
getInt = (Int8 -> Int16) -> Get Int8 -> Get Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int8
x -> Int8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Int16) -> Int8 -> Int16
forall a b. (a -> b) -> a -> b
$ Int8
x Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
- Int8
127 Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
- Int8
1) Get Int8
getInt8
                  Int -> Get Metrics -> Get [Metrics]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
metrics_count) (Get Metrics -> Get [Metrics]) -> Get Metrics -> Get [Metrics]
forall a b. (a -> b) -> a -> b
$
                    Int16 -> Int16 -> Int16 -> Int16 -> Int16 -> Int16 -> Metrics
Metrics (Int16 -> Int16 -> Int16 -> Int16 -> Int16 -> Int16 -> Metrics)
-> Get Int16
-> Get (Int16 -> Int16 -> Int16 -> Int16 -> Int16 -> Metrics)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt Get (Int16 -> Int16 -> Int16 -> Int16 -> Int16 -> Metrics)
-> Get Int16 -> Get (Int16 -> Int16 -> Int16 -> Int16 -> Metrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int16
getInt Get (Int16 -> Int16 -> Int16 -> Int16 -> Metrics)
-> Get Int16 -> Get (Int16 -> Int16 -> Int16 -> Metrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int16
getInt Get (Int16 -> Int16 -> Int16 -> Metrics)
-> Get Int16 -> Get (Int16 -> Int16 -> Metrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int16
getInt Get (Int16 -> Int16 -> Metrics)
-> Get Int16 -> Get (Int16 -> Metrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int16
getInt Get (Int16 -> Metrics) -> Get Int16 -> Get Metrics
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int16 -> Get Int16
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int16
0
                else do
                  Word32
metrics_count <- Get Word32
getWord32
                  Int -> Get Metrics -> Get [Metrics]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
metrics_count) Get Metrics
get_metrics

                Table -> Get Table
forall (m :: * -> *) a. Monad m => a -> m a
return (Table -> Get Table) -> Table -> Get Table
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Vector Metrics -> Table
METRICS Bool
ty (Word32 -> Bool
isCompressedMetricsFormat Word32
tableMetaFormat) Vector Metrics
metrics
        let get_accelerators_table :: Get Table
get_accelerators_table = 
              Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Word32
-> Word32
-> Word32
-> Metrics
-> Metrics
-> Maybe (Metrics, Metrics)
-> Table
ACCELERATORS (Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Word32
 -> Word32
 -> Word32
 -> Metrics
 -> Metrics
 -> Maybe (Metrics, Metrics)
 -> Table)
-> Get Bool
-> Get
     (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Word32
      -> Word32
      -> Word32
      -> Metrics
      -> Metrics
      -> Maybe (Metrics, Metrics)
      -> Table)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
forall t. Binary t => Get t
get Get
  (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Word32
   -> Word32
   -> Word32
   -> Metrics
   -> Metrics
   -> Maybe (Metrics, Metrics)
   -> Table)
-> Get Bool
-> Get
     (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Word32
      -> Word32
      -> Word32
      -> Metrics
      -> Metrics
      -> Maybe (Metrics, Metrics)
      -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Bool
forall t. Binary t => Get t
get Get
  (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Word32
   -> Word32
   -> Word32
   -> Metrics
   -> Metrics
   -> Maybe (Metrics, Metrics)
   -> Table)
-> Get Bool
-> Get
     (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Word32
      -> Word32
      -> Word32
      -> Metrics
      -> Metrics
      -> Maybe (Metrics, Metrics)
      -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Bool
forall t. Binary t => Get t
get Get
  (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Word32
   -> Word32
   -> Word32
   -> Metrics
   -> Metrics
   -> Maybe (Metrics, Metrics)
   -> Table)
-> Get Bool
-> Get
     (Bool
      -> Bool
      -> Bool
      -> Word32
      -> Word32
      -> Word32
      -> Metrics
      -> Metrics
      -> Maybe (Metrics, Metrics)
      -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Bool
forall t. Binary t => Get t
get Get
  (Bool
   -> Bool
   -> Bool
   -> Word32
   -> Word32
   -> Word32
   -> Metrics
   -> Metrics
   -> Maybe (Metrics, Metrics)
   -> Table)
-> Get Bool
-> Get
     (Bool
      -> Bool
      -> Word32
      -> Word32
      -> Word32
      -> Metrics
      -> Metrics
      -> Maybe (Metrics, Metrics)
      -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Bool
forall t. Binary t => Get t
get Get
  (Bool
   -> Bool
   -> Word32
   -> Word32
   -> Word32
   -> Metrics
   -> Metrics
   -> Maybe (Metrics, Metrics)
   -> Table)
-> Get Bool
-> Get
     (Bool
      -> Word32
      -> Word32
      -> Word32
      -> Metrics
      -> Metrics
      -> Maybe (Metrics, Metrics)
      -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Bool
forall t. Binary t => Get t
get Get
  (Bool
   -> Word32
   -> Word32
   -> Word32
   -> Metrics
   -> Metrics
   -> Maybe (Metrics, Metrics)
   -> Table)
-> Get Bool
-> Get
     (Word32
      -> Word32
      -> Word32
      -> Metrics
      -> Metrics
      -> Maybe (Metrics, Metrics)
      -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Bool
forall t. Binary t => Get t
get
                           Get
  (Word32
   -> Word32
   -> Word32
   -> Metrics
   -> Metrics
   -> Maybe (Metrics, Metrics)
   -> Table)
-> Get Word8
-> Get
     (Word32
      -> Word32
      -> Word32
      -> Metrics
      -> Metrics
      -> Maybe (Metrics, Metrics)
      -> Table)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Get Word8
getWord8 Get
  (Word32
   -> Word32
   -> Word32
   -> Metrics
   -> Metrics
   -> Maybe (Metrics, Metrics)
   -> Table)
-> Get Word32
-> Get
     (Word32
      -> Word32
      -> Metrics
      -> Metrics
      -> Maybe (Metrics, Metrics)
      -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32 Get
  (Word32
   -> Word32
   -> Metrics
   -> Metrics
   -> Maybe (Metrics, Metrics)
   -> Table)
-> Get Word32
-> Get
     (Word32 -> Metrics -> Metrics -> Maybe (Metrics, Metrics) -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32 Get
  (Word32 -> Metrics -> Metrics -> Maybe (Metrics, Metrics) -> Table)
-> Get Word32
-> Get (Metrics -> Metrics -> Maybe (Metrics, Metrics) -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32 Get (Metrics -> Metrics -> Maybe (Metrics, Metrics) -> Table)
-> Get Metrics
-> Get (Metrics -> Maybe (Metrics, Metrics) -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Metrics
get_metrics Get (Metrics -> Maybe (Metrics, Metrics) -> Table)
-> Get Metrics -> Get (Maybe (Metrics, Metrics) -> Table)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Metrics
get_metrics
                           Get (Maybe (Metrics, Metrics) -> Table)
-> Get (Maybe (Metrics, Metrics)) -> Get Table
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (if Word32 -> Bool
isAccelWithInkBoundsFormat Word32
tableMetaFormat then
                                  ((Metrics, Metrics) -> Maybe (Metrics, Metrics))
-> Get (Metrics, Metrics) -> Get (Maybe (Metrics, Metrics))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Metrics, Metrics) -> Maybe (Metrics, Metrics)
forall a. a -> Maybe a
Just (Get (Metrics, Metrics) -> Get (Maybe (Metrics, Metrics)))
-> Get (Metrics, Metrics) -> Get (Maybe (Metrics, Metrics))
forall a b. (a -> b) -> a -> b
$ (,) (Metrics -> Metrics -> (Metrics, Metrics))
-> Get Metrics -> Get (Metrics -> (Metrics, Metrics))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Metrics
get_metrics Get (Metrics -> (Metrics, Metrics))
-> Get Metrics -> Get (Metrics, Metrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Metrics
get_metrics
                                else
                                  Maybe (Metrics, Metrics) -> Get (Maybe (Metrics, Metrics))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Metrics, Metrics)
forall a. Maybe a
Nothing)
        Table
table <- case PCFTableType
tableMetaType of
          PCFTableType
PCF_PROPERTIES -> do
            Bool -> String -> Get ()
forall (m :: * -> *). MonadFail m => Bool -> String -> m ()
assert (Word32 -> Bool
isDefaultFormat Word32
tableMetaFormat)
              String
"Properties table only supports PCF_DEFAULT_FORMAT."
            Word32
nprops <- Get Word32
getWord32
            [Prop]
props <- Int -> Get Prop -> Get [Prop]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nprops) (Word32 -> Word8 -> Word32 -> Prop
Prop (Word32 -> Word8 -> Word32 -> Prop)
-> Get Word32 -> Get (Word8 -> Word32 -> Prop)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32 Get (Word8 -> Word32 -> Prop) -> Get Word8 -> Get (Word32 -> Prop)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
getWord8 Get (Word32 -> Prop) -> Get Word32 -> Get Prop
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32)
            Int -> Get ()
skip (Int -> Get ()) -> Int -> Get ()
forall a b. (a -> b) -> a -> b
$ (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nprops Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4 -- Insert padding
            Word32
string_size <- Get Word32
getWord32
            ByteString
strings <- Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
string_size)
            Table -> Get Table
forall (m :: * -> *) a. Monad m => a -> m a
return (Table -> Get Table) -> Table -> Get Table
forall a b. (a -> b) -> a -> b
$ [Prop] -> ByteString -> Table
PROPERTIES [Prop]
props (ByteString -> ByteString
B.fromStrict ByteString
strings)
          PCFTableType
PCF_ACCELERATORS     -> Get Table
get_accelerators_table
          PCFTableType
PCF_BDF_ACCELERATORS -> Get Table
get_accelerators_table
          PCFTableType
PCF_METRICS     -> Bool -> Get Table
get_metrics_table Bool
False
          PCFTableType
PCF_INK_METRICS -> Bool -> Get Table
get_metrics_table Bool
True
          PCFTableType
PCF_BITMAPS -> do
            Word32
glyph_count <- Get Word32
getWord32
            Vector Word32
offsets <- [Word32] -> Vector Word32
forall a. [a] -> Vector a
V.fromList ([Word32] -> Vector Word32) -> Get [Word32] -> Get (Vector Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Word32 -> Get [Word32]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
glyph_count) Get Word32
getWord32
            (Word32, Word32, Word32, Word32)
sizes <- (,,,) (Word32
 -> Word32 -> Word32 -> Word32 -> (Word32, Word32, Word32, Word32))
-> Get Word32
-> Get
     (Word32 -> Word32 -> Word32 -> (Word32, Word32, Word32, Word32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32 Get
  (Word32 -> Word32 -> Word32 -> (Word32, Word32, Word32, Word32))
-> Get Word32
-> Get (Word32 -> Word32 -> (Word32, Word32, Word32, Word32))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32 Get (Word32 -> Word32 -> (Word32, Word32, Word32, Word32))
-> Get Word32 -> Get (Word32 -> (Word32, Word32, Word32, Word32))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32 Get (Word32 -> (Word32, Word32, Word32, Word32))
-> Get Word32 -> Get (Word32, Word32, Word32, Word32)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32
            ByteString
bitmap_data <- case (Word8
tableMetaGlyphPad, (Word32, Word32, Word32, Word32)
sizes) of
                             (Word8
1, (Word32
w,Word32
_,Word32
_,Word32
_)) -> Int -> Get ByteString
getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Word32
w
                             (Word8
2, (Word32
_,Word32
x,Word32
_,Word32
_)) -> Int -> Get ByteString
getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Word32
x
                             (Word8
4, (Word32
_,Word32
_,Word32
y,Word32
_)) -> Int -> Get ByteString
getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Word32
y
                             (Word8
8, (Word32
_,Word32
_,Word32
_,Word32
z)) -> Int -> Get ByteString
getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Word32
z
                             (Word8, (Word32, Word32, Word32, Word32))
_ -> String -> Get ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid glyph padding encountered while parsing PCF bitmap table."
            Table -> Get Table
forall (m :: * -> *) a. Monad m => a -> m a
return (Table -> Get Table) -> Table -> Get Table
forall a b. (a -> b) -> a -> b
$ Word32
-> Vector Word32
-> (Word32, Word32, Word32, Word32)
-> ByteString
-> Table
BITMAPS Word32
glyph_count Vector Word32
offsets (Word32, Word32, Word32, Word32)
sizes (ByteString -> ByteString
B.fromStrict ByteString
bitmap_data)
          PCFTableType
PCF_BDF_ENCODINGS -> do
            (Word16, Word16)
cols <- (,) (Word16 -> Word16 -> (Word16, Word16))
-> Get Word16 -> Get (Word16 -> (Word16, Word16))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16 Get (Word16 -> (Word16, Word16))
-> Get Word16 -> Get (Word16, Word16)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16
            (Word16, Word16)
rows <- (,) (Word16 -> Word16 -> (Word16, Word16))
-> Get Word16 -> Get (Word16 -> (Word16, Word16))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16 Get (Word16 -> (Word16, Word16))
-> Get Word16 -> Get (Word16, Word16)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
getWord16
            Word16
default_char <- Get Word16
getWord16
            [[(Int, Word16)]]
glyph_indices <-
                ((Word16 -> Get [(Int, Word16)])
 -> [Word16] -> Get [[(Int, Word16)]])
-> [Word16]
-> (Word16 -> Get [(Int, Word16)])
-> Get [[(Int, Word16)]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Word16 -> Get [(Int, Word16)])
-> [Word16] -> Get [[(Int, Word16)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [(Word16, Word16) -> Word16
forall a b. (a, b) -> a
fst (Word16, Word16)
rows..(Word16, Word16) -> Word16
forall a b. (a, b) -> b
snd (Word16, Word16)
rows] ((Word16 -> Get [(Int, Word16)]) -> Get [[(Int, Word16)]])
-> (Word16 -> Get [(Int, Word16)]) -> Get [[(Int, Word16)]]
forall a b. (a -> b) -> a -> b
$ \Word16
i ->
                    ((Word16 -> Get (Int, Word16)) -> [Word16] -> Get [(Int, Word16)])
-> [Word16] -> (Word16 -> Get (Int, Word16)) -> Get [(Int, Word16)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Word16 -> Get (Int, Word16)) -> [Word16] -> Get [(Int, Word16)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [(Word16, Word16) -> Word16
forall a b. (a, b) -> a
fst (Word16, Word16)
cols..(Word16, Word16) -> Word16
forall a b. (a, b) -> b
snd (Word16, Word16)
cols] ((Word16 -> Get (Int, Word16)) -> Get [(Int, Word16)])
-> (Word16 -> Get (Int, Word16)) -> Get [(Int, Word16)]
forall a b. (a -> b) -> a -> b
$ \Word16
j -> do
                        Word16
encoding_offset <- Get Word16
getWord16
                        (Int, Word16) -> Get (Int, Word16)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Word16
i Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
256 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
j, Word16
encoding_offset)
            Table -> Get Table
forall (m :: * -> *) a. Monad m => a -> m a
return (Table -> Get Table) -> Table -> Get Table
forall a b. (a -> b) -> a -> b
$ (Word16, Word16)
-> (Word16, Word16) -> Word16 -> IntMap Word16 -> Table
BDF_ENCODINGS (Word16, Word16)
cols (Word16, Word16)
rows Word16
default_char ([(Int, Word16)] -> IntMap Word16
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, Word16)] -> IntMap Word16)
-> [(Int, Word16)] -> IntMap Word16
forall a b. (a -> b) -> a -> b
$ [[(Int, Word16)]] -> [(Int, Word16)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Int, Word16)]]
glyph_indices)
          PCFTableType
PCF_SWIDTHS -> do
            Word32
glyph_count <- Get Word32
getWord32
            [Word32] -> Table
SWIDTHS ([Word32] -> Table) -> Get [Word32] -> Get Table
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Word32 -> Get [Word32]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
glyph_count) Get Word32
getWord32
          PCFTableType
PCF_GLYPH_NAMES ->
            [Word32] -> ByteString -> Table
GLYPH_NAMES ([Word32] -> ByteString -> Table)
-> Get [Word32] -> Get (ByteString -> Table)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word32
getWord32 Get Word32 -> (Word32 -> Get [Word32]) -> Get [Word32]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Get Word32 -> Get [Word32])
-> Get Word32 -> Int -> Get [Word32]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Get Word32 -> Get [Word32]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Get Word32
getWord32 (Int -> Get [Word32]) -> (Word32 -> Int) -> Word32 -> Get [Word32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Get (ByteString -> Table) -> Get ByteString -> Get Table
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Get Word32
getWord32 Get Word32 -> (Word32 -> Get ByteString) -> Get ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
B.fromStrict (Get ByteString -> Get ByteString)
-> (Word32 -> Get ByteString) -> Word32 -> Get ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Get ByteString
getByteString (Int -> Get ByteString)
-> (Word32 -> Int) -> Word32 -> Get ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
        Table -> Get Table
forall (m :: * -> *) a. Monad m => a -> m a
return Table
table

-- | Load a PCF font file. Both uncompressed and GZip compressed files are allowed, i.e. ".pcf" and ".pcf.gz" files.
loadPCF :: FilePath -> IO (Either String PCF)
loadPCF :: String -> IO (Either String PCF)
loadPCF String
filepath = ByteString -> Either String PCF
decodePCF (ByteString -> Either String PCF)
-> IO ByteString -> IO (Either String PCF)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
B.readFile String
filepath

-- | Decode a PCF font from an in-memory `ByteString`. Uncompressed and GZip compressed input are allowed.
decodePCF :: ByteString -> Either String PCF
decodePCF :: ByteString -> Either String PCF
decodePCF ByteString
bs = ((ByteString, Int64, String) -> Either String PCF)
-> ((ByteString, Int64, PCF) -> Either String PCF)
-> Either (ByteString, Int64, String) (ByteString, Int64, PCF)
-> Either String PCF
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String PCF
forall a b. a -> Either a b
Left (String -> Either String PCF)
-> ((ByteString, Int64, String) -> String)
-> (ByteString, Int64, String)
-> Either String PCF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, Int64, String) -> String
forall a b c. (a, b, c) -> c
extract) (PCF -> Either String PCF
forall a b. b -> Either a b
Right (PCF -> Either String PCF)
-> ((ByteString, Int64, PCF) -> PCF)
-> (ByteString, Int64, PCF)
-> Either String PCF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, Int64, PCF) -> PCF
forall a b c. (a, b, c) -> c
extract) (Either (ByteString, Int64, String) (ByteString, Int64, PCF)
 -> Either String PCF)
-> Either (ByteString, Int64, String) (ByteString, Int64, PCF)
-> Either String PCF
forall a b. (a -> b) -> a -> b
$ Get PCF
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, PCF)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail Get PCF
getPCF (ByteString
 -> Either (ByteString, Int64, String) (ByteString, Int64, PCF))
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, PCF)
forall a b. (a -> b) -> a -> b
$ if Int64 -> ByteString -> ByteString
B.take Int64
2 ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"\x1f\x8b" then ByteString -> ByteString
decompress ByteString
bs else ByteString
bs
    where
        extract :: (a, b, c) -> c
extract (a
_,b
_,c
v) = c
v

getPCFTableType :: Get PCFTableType
getPCFTableType :: Get PCFTableType
getPCFTableType = do
  Word32
type_rep <- Get Word32
getWord32le
  case Word32
type_rep of
    Word32
0x001 -> PCFTableType -> Get PCFTableType
forall (m :: * -> *) a. Monad m => a -> m a
return PCFTableType
PCF_PROPERTIES
    Word32
0x002 -> PCFTableType -> Get PCFTableType
forall (m :: * -> *) a. Monad m => a -> m a
return PCFTableType
PCF_ACCELERATORS
    Word32
0x004 -> PCFTableType -> Get PCFTableType
forall (m :: * -> *) a. Monad m => a -> m a
return PCFTableType
PCF_METRICS
    Word32
0x008 -> PCFTableType -> Get PCFTableType
forall (m :: * -> *) a. Monad m => a -> m a
return PCFTableType
PCF_BITMAPS
    Word32
0x010 -> PCFTableType -> Get PCFTableType
forall (m :: * -> *) a. Monad m => a -> m a
return PCFTableType
PCF_INK_METRICS
    Word32
0x020 -> PCFTableType -> Get PCFTableType
forall (m :: * -> *) a. Monad m => a -> m a
return PCFTableType
PCF_BDF_ENCODINGS
    Word32
0x040 -> PCFTableType -> Get PCFTableType
forall (m :: * -> *) a. Monad m => a -> m a
return PCFTableType
PCF_SWIDTHS
    Word32
0x080 -> PCFTableType -> Get PCFTableType
forall (m :: * -> *) a. Monad m => a -> m a
return PCFTableType
PCF_GLYPH_NAMES
    Word32
0x100 -> PCFTableType -> Get PCFTableType
forall (m :: * -> *) a. Monad m => a -> m a
return PCFTableType
PCF_BDF_ACCELERATORS
    Word32
_     -> String -> Get PCFTableType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid PCF table type encountered."

getTableMeta :: Get TableMeta
getTableMeta :: Get TableMeta
getTableMeta = do
  PCFTableType
table_type <- Get PCFTableType
getPCFTableType
  Word32
fmt <- Get Word32
getWord32le
  Word32
size <- Get Word32
getWord32le
  Word32
offset <- Get Word32
getWord32le
  TableMeta -> Get TableMeta
forall (m :: * -> *) a. Monad m => a -> m a
return (TableMeta -> Get TableMeta) -> TableMeta -> Get TableMeta
forall a b. (a -> b) -> a -> b
$ PCFTableType
-> Word32
-> Word8
-> Word8
-> Bool
-> Bool
-> Word32
-> Word32
-> TableMeta
TableMeta PCFTableType
table_type Word32
fmt (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
1 (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Word32
fmt Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
3) (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word8) -> Word32 -> Word8
forall a b. (a -> b) -> a -> b
$ Word32
fmt Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
4 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x3) (Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
fmt Int
2) (Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
fmt Int
3) Word32
size Word32
offset

-- | Calculate the color of a pixel in a glyph given its (x,y) coordinates.
getPCFGlyphPixel :: PCFGlyph
                 -> Int
                 -- ^ X
                 -> Int
                 -- ^ Y
                 -> Bool
                 -- ^ `True` if pixel at (x,y) is opaque; `False` if pixel at (x,y) is transparent or (x,y) is out of the glyph's bounds
getPCFGlyphPixel :: PCFGlyph -> Int -> Int -> Bool
getPCFGlyphPixel g :: PCFGlyph
g@PCFGlyph{Char
Int
ByteString
Metrics
glyph_bitmap :: PCFGlyph -> ByteString
glyph_pitch :: PCFGlyph -> Int
glyph_height :: PCFGlyph -> Int
glyph_width :: PCFGlyph -> Int
glyph_char :: PCFGlyph -> Char
glyph_metrics :: PCFGlyph -> Metrics
glyph_bitmap :: ByteString
glyph_pitch :: Int
glyph_height :: Int
glyph_width :: Int
glyph_char :: Char
glyph_metrics :: Metrics
..} Int
x Int
y = Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
glyph_width Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
glyph_height Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& PCFGlyph -> Int -> Int -> Bool
getPCFGlyphPixelUnsafe PCFGlyph
g Int
x Int
y

getPCFGlyphPixelUnsafe :: PCFGlyph -> Int -> Int -> Bool
getPCFGlyphPixelUnsafe :: PCFGlyph -> Int -> Int -> Bool
getPCFGlyphPixelUnsafe PCFGlyph{Char
Int
ByteString
Metrics
glyph_bitmap :: ByteString
glyph_pitch :: Int
glyph_height :: Int
glyph_width :: Int
glyph_char :: Char
glyph_metrics :: Metrics
glyph_bitmap :: PCFGlyph -> ByteString
glyph_pitch :: PCFGlyph -> Int
glyph_height :: PCFGlyph -> Int
glyph_width :: PCFGlyph -> Int
glyph_char :: PCFGlyph -> Char
glyph_metrics :: PCFGlyph -> Metrics
..} Int
x Int
y = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (ByteString -> Word8
B.head (ByteString -> Word8) -> ByteString -> Word8
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
B.drop Int64
off ByteString
glyph_bitmap) (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8)
    where
        off :: Int64
off = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
glyph_pitch Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
        

-- | Scan over every pixel in a glyph, constructing some value in the process.
foldPCFGlyphPixels :: PCFGlyph
                   -> (Int -> Int -> Bool -> a -> a)
                   -- ^ Function that takes x, y, pixel value at (x,y), and an accumulator, returning a modified accumulator
                   -> a
                   -- ^ Initial accumulator
                   -> a
foldPCFGlyphPixels :: PCFGlyph -> (Int -> Int -> Bool -> a -> a) -> a -> a
foldPCFGlyphPixels g :: PCFGlyph
g@PCFGlyph{Char
Int
ByteString
Metrics
glyph_bitmap :: ByteString
glyph_pitch :: Int
glyph_height :: Int
glyph_width :: Int
glyph_char :: Char
glyph_metrics :: Metrics
glyph_bitmap :: PCFGlyph -> ByteString
glyph_pitch :: PCFGlyph -> Int
glyph_height :: PCFGlyph -> Int
glyph_width :: PCFGlyph -> Int
glyph_char :: PCFGlyph -> Char
glyph_metrics :: PCFGlyph -> Metrics
..} Int -> Int -> Bool -> a -> a
f =
    [Int] -> (Int -> a -> a) -> a -> a
forall (t :: * -> *) a b.
Foldable t =>
t a -> (a -> b -> b) -> b -> b
fold [Int
0..Int
glyph_widthInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> a -> a) -> a -> a) -> (Int -> a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ \Int
x ->
        [Int] -> (Int -> a -> a) -> a -> a
forall (t :: * -> *) a b.
Foldable t =>
t a -> (a -> b -> b) -> b -> b
fold [Int
0..Int
glyph_heightInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> a -> a) -> a -> a) -> (Int -> a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ \Int
y ->
            Int -> Int -> Bool -> a -> a
f Int
x Int
y (PCFGlyph -> Int -> Int -> Bool
getPCFGlyphPixelUnsafe PCFGlyph
g Int
x Int
y)
    where
        fold :: t a -> (a -> b -> b) -> b -> b
fold t a
bs a -> b -> b
f' b
a = (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> b -> b) -> b -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
f') b
a t a
bs

-- | Generate a vector of black and white pixels from a PCF font and a string. Black and white pixels are represented by 0x00 and 0xFF byte values respectively.
renderPCFText :: PCF
              -- ^ Font to render with
              -> String
              -- ^ Text to render
              -> Maybe PCFText
              -- ^ `Just` width, height, and rendering; `Nothing` if an unrenderable character is encountered
renderPCFText :: PCF -> String -> Maybe PCFText
renderPCFText PCF
pcf = PCF -> Word8 -> Word8 -> String -> Maybe PCFText
renderPCFTextColor PCF
pcf Word8
0x00 Word8
0xFF

-- | Generate a vector of opaque and blank pixels from a PCF font and a string.
renderPCFTextColor :: PCF
                   -- ^ Font to render with
                   -> Word8
                   -- ^ Opaque color value
                   -> Word8
                   -- ^ Blank color value
                   -> String
                   -- ^ Text to render
                   -> Maybe PCFText
                   -- ^ `Just` width, height, and rendering; `Nothing` if an unrenderable character is encountered
renderPCFTextColor :: PCF -> Word8 -> Word8 -> String -> Maybe PCFText
renderPCFTextColor pcf :: PCF
pcf@PCF{Maybe (TableMeta, Table)
(TableMeta, Table)
pcf_ink_metrics :: Maybe (TableMeta, Table)
pcf_glyph_names :: Maybe (TableMeta, Table)
pcf_accelerators :: (TableMeta, Table)
pcf_swidths :: (TableMeta, Table)
pcf_bdf_encodings :: (TableMeta, Table)
pcf_bitmaps :: (TableMeta, Table)
pcf_metrics :: (TableMeta, Table)
pcf_properties :: (TableMeta, Table)
pcf_ink_metrics :: PCF -> Maybe (TableMeta, Table)
pcf_glyph_names :: PCF -> Maybe (TableMeta, Table)
pcf_accelerators :: PCF -> (TableMeta, Table)
pcf_swidths :: PCF -> (TableMeta, Table)
pcf_bdf_encodings :: PCF -> (TableMeta, Table)
pcf_bitmaps :: PCF -> (TableMeta, Table)
pcf_metrics :: PCF -> (TableMeta, Table)
pcf_properties :: PCF -> (TableMeta, Table)
..} Word8
opaque Word8
blank String
text = do
    [PCFGlyph]
glyphs <- (Char -> Maybe PCFGlyph) -> String -> Maybe [PCFGlyph]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (PCF -> Char -> Maybe PCFGlyph
getPCFGlyph PCF
pcf) String
text
    let w :: Int
w = (Int -> PCFGlyph -> Int) -> Int -> [PCFGlyph] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
n -> (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (PCFGlyph -> Int) -> PCFGlyph -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int) -> (PCFGlyph -> Int16) -> PCFGlyph -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metrics -> Int16
metrics_character_width (Metrics -> Int16) -> (PCFGlyph -> Metrics) -> PCFGlyph -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PCFGlyph -> Metrics
glyph_metrics) Int
0 [PCFGlyph]
glyphs
        ascent :: Int16
ascent = (Int16 -> PCFGlyph -> Int16) -> Int16 -> [PCFGlyph] -> Int16
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int16
n PCFGlyph{Char
Int
ByteString
Metrics
glyph_bitmap :: ByteString
glyph_pitch :: Int
glyph_height :: Int
glyph_width :: Int
glyph_char :: Char
glyph_metrics :: Metrics
glyph_bitmap :: PCFGlyph -> ByteString
glyph_pitch :: PCFGlyph -> Int
glyph_height :: PCFGlyph -> Int
glyph_width :: PCFGlyph -> Int
glyph_char :: PCFGlyph -> Char
glyph_metrics :: PCFGlyph -> Metrics
..} -> Int16 -> Int16 -> Int16
forall a. Ord a => a -> a -> a
max Int16
n (Metrics -> Int16
metrics_character_ascent Metrics
glyph_metrics)) Int16
0 [PCFGlyph]
glyphs
        descent :: Int16
descent = (Int16 -> PCFGlyph -> Int16) -> Int16 -> [PCFGlyph] -> Int16
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int16
n PCFGlyph{Char
Int
ByteString
Metrics
glyph_bitmap :: ByteString
glyph_pitch :: Int
glyph_height :: Int
glyph_width :: Int
glyph_char :: Char
glyph_metrics :: Metrics
glyph_bitmap :: PCFGlyph -> ByteString
glyph_pitch :: PCFGlyph -> Int
glyph_height :: PCFGlyph -> Int
glyph_width :: PCFGlyph -> Int
glyph_char :: PCFGlyph -> Char
glyph_metrics :: PCFGlyph -> Metrics
..} -> Int16 -> Int16 -> Int16
forall a. Ord a => a -> a -> a
max Int16
n (Metrics -> Int16
metrics_character_descent Metrics
glyph_metrics)) Int16
0 [PCFGlyph]
glyphs
        h :: Int
h = Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int) -> Int16 -> Int
forall a b. (a -> b) -> a -> b
$ Int16
ascent Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
descent
        updates :: Int -> [PCFGlyph] -> [[Int]]
updates Int
_ [] = []
        updates Int
off (PCFGlyph
g:[PCFGlyph]
gs) = PCFGlyph
-> (Int -> Int -> Bool -> [Int] -> [Int]) -> [Int] -> [Int]
forall a. PCFGlyph -> (Int -> Int -> Bool -> a -> a) -> a -> a
foldPCFGlyphPixels PCFGlyph
g (\Int
x Int
y -> ([Int] -> [Int]) -> ([Int] -> [Int]) -> Bool -> [Int] -> [Int]
forall a. a -> a -> Bool -> a
bool [Int] -> [Int]
forall a. a -> a
id (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Metrics -> Int16
metrics_left_sided_bearings (PCFGlyph -> Metrics
glyph_metrics PCFGlyph
g)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16
ascent Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
- Metrics -> Int16
metrics_character_ascent (PCFGlyph -> Metrics
glyph_metrics PCFGlyph
g))) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
wInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:)) [] [Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
: Int -> [PCFGlyph] -> [[Int]]
updates (Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Metrics -> Int16
metrics_character_width (PCFGlyph -> Metrics
glyph_metrics PCFGlyph
g))) [PCFGlyph]
gs
    -- 64 MB max image size
    if Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 then
        Maybe PCFText
forall a. Maybe a
Nothing
    else
        PCFText -> Maybe PCFText
forall (m :: * -> *) a. Monad m => a -> m a
return ([PCFGlyph] -> Int -> Int -> Vector Word8 -> PCFText
PCFText [PCFGlyph]
glyphs Int
w Int
h (Vector Word8 -> PCFText) -> Vector Word8 -> PCFText
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> Vector Word8
forall a. Storable a => Int -> a -> Vector a
VS.replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h) Word8
blank Vector Word8 -> [(Int, Word8)] -> Vector Word8
forall a. Storable a => Vector a -> [(Int, a)] -> Vector a
VS.// ((Int -> (Int, Word8)) -> [Int] -> [(Int, Word8)]
forall a b. (a -> b) -> [a] -> [b]
map (,Word8
opaque) ([Int] -> [(Int, Word8)]) -> [Int] -> [(Int, Word8)]
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> [PCFGlyph] -> [[Int]]
updates Int
0 [PCFGlyph]
glyphs))