{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Graphics.Text.PCF (
loadPCF,
decodePCF,
renderPCFText,
renderPCFTextColor,
getPCFGlyph,
getPCFGlyphPixel,
foldPCFGlyphPixels,
pcf_text_ascii,
glyph_ascii,
glyph_ascii_lines,
getPCFProps,
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
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
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."
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
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
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
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
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
getPCFGlyphPixel :: PCFGlyph
-> Int
-> Int
-> Bool
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
foldPCFGlyphPixels :: PCFGlyph
-> (Int -> Int -> Bool -> a -> a)
-> a
-> 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
renderPCFText :: PCF
-> String
-> Maybe PCFText
renderPCFText :: PCF -> String -> Maybe PCFText
renderPCFText PCF
pcf = PCF -> Word8 -> Word8 -> String -> Maybe PCFText
renderPCFTextColor PCF
pcf Word8
0x00 Word8
0xFF
renderPCFTextColor :: PCF
-> Word8
-> Word8
-> String
-> Maybe PCFText
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
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))