{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Graphics.Text.PCF.Types (
PCF(..),
PCFGlyph(..),
Prop(..),
Table(..),
Metrics(..),
TableMeta(..),
PCFTableType(..),
PCFText(..),
glyph_ascii,
glyph_ascii_lines,
pcf_text_string,
pcf_text_ascii
) where
import Data.Binary
import Data.Bits
import Data.Int
import Data.Monoid
import Data.List
import Data.Vector (Vector)
import Data.IntMap (IntMap)
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy as B (concatMap, take)
import qualified Data.ByteString.Lazy.Char8 as B (unpack, splitAt, intercalate, concat)
import qualified Data.Vector.Storable as VS
data PCF = PCF { PCF -> (TableMeta, Table)
pcf_properties :: (TableMeta, Table)
, PCF -> (TableMeta, Table)
pcf_metrics :: (TableMeta, Table)
, PCF -> (TableMeta, Table)
pcf_bitmaps :: (TableMeta, Table)
, PCF -> (TableMeta, Table)
pcf_bdf_encodings :: (TableMeta, Table)
, PCF -> (TableMeta, Table)
pcf_swidths :: (TableMeta, Table)
, PCF -> (TableMeta, Table)
pcf_accelerators :: (TableMeta, Table)
, PCF -> Maybe (TableMeta, Table)
pcf_glyph_names :: Maybe (TableMeta, Table)
, PCF -> Maybe (TableMeta, Table)
pcf_ink_metrics :: Maybe (TableMeta, Table)
}
data Table = PROPERTIES { Table -> [Prop]
properties_props :: [Prop]
, Table -> ByteString
properties_strings :: ByteString }
| BITMAPS { Table -> Word32
bitmaps_glyph_count :: Word32
, Table -> Vector Word32
bitmaps_offsets :: Vector Word32
, Table -> (Word32, Word32, Word32, Word32)
bitmaps_sizes :: (Word32, Word32, Word32, Word32)
, Table -> ByteString
bitmaps_data :: ByteString }
| METRICS { Table -> Bool
metrics_ink_type :: Bool
, Table -> Bool
metrics_compressed :: Bool
, Table -> Vector Metrics
metrics_metrics :: Vector Metrics }
| SWIDTHS { Table -> [Word32]
swidths_swidths :: [Word32] }
| ACCELERATORS { Table -> Bool
accel_no_overlap :: Bool
, Table -> Bool
accel_constant_metrics :: Bool
, Table -> Bool
accel_terminal_font :: Bool
, Table -> Bool
accel_constant_width :: Bool
, Table -> Bool
accel_ink_inside :: Bool
, Table -> Bool
accel_ink_metrics :: Bool
, Table -> Bool
accel_draw_direction :: Bool
, Table -> Word32
accel_font_ascent :: Word32
, Table -> Word32
accel_font_descent :: Word32
, Table -> Word32
accel_max_overlap :: Word32
, Table -> Metrics
accel_min_bounds :: Metrics
, Table -> Metrics
accel_max_bounds :: Metrics
, Table -> Maybe (Metrics, Metrics)
accel_ink_min_max_bounds :: Maybe (Metrics, Metrics)
}
| GLYPH_NAMES { Table -> [Word32]
glyph_names_offsets :: [Word32]
, Table -> ByteString
glyph_names_string :: ByteString }
| BDF_ENCODINGS { Table -> (Word16, Word16)
encodings_cols :: (Word16, Word16)
, Table -> (Word16, Word16)
encodings_rows :: (Word16, Word16)
, Table -> Word16
encodings_default_char :: Word16
, Table -> IntMap Word16
encodings_glyph_indices :: IntMap Word16 }
data Prop = Prop { Prop -> Word32
prop_name_offset :: Word32
, Prop -> Word8
prop_is_string :: Word8
, Prop -> Word32
prop_value :: Word32 }
deriving (Prop -> Prop -> Bool
(Prop -> Prop -> Bool) -> (Prop -> Prop -> Bool) -> Eq Prop
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prop -> Prop -> Bool
$c/= :: Prop -> Prop -> Bool
== :: Prop -> Prop -> Bool
$c== :: Prop -> Prop -> Bool
Eq)
data Metrics = Metrics { Metrics -> Int16
metrics_left_sided_bearings :: Int16
, Metrics -> Int16
metrics_right_sided_bearings :: Int16
, Metrics -> Int16
metrics_character_width :: Int16
, Metrics -> Int16
metrics_character_ascent :: Int16
, Metrics -> Int16
metrics_character_descent :: Int16
, Metrics -> Int16
metrics_character_attributes :: Int16 }
deriving (Metrics -> Metrics -> Bool
(Metrics -> Metrics -> Bool)
-> (Metrics -> Metrics -> Bool) -> Eq Metrics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metrics -> Metrics -> Bool
$c/= :: Metrics -> Metrics -> Bool
== :: Metrics -> Metrics -> Bool
$c== :: Metrics -> Metrics -> Bool
Eq, Int -> Metrics -> ShowS
[Metrics] -> ShowS
Metrics -> String
(Int -> Metrics -> ShowS)
-> (Metrics -> String) -> ([Metrics] -> ShowS) -> Show Metrics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metrics] -> ShowS
$cshowList :: [Metrics] -> ShowS
show :: Metrics -> String
$cshow :: Metrics -> String
showsPrec :: Int -> Metrics -> ShowS
$cshowsPrec :: Int -> Metrics -> ShowS
Show)
data TableMeta = TableMeta { TableMeta -> PCFTableType
tableMetaType :: PCFTableType
, TableMeta -> Word32
tableMetaFormat :: Word32
, TableMeta -> Word8
tableMetaGlyphPad :: Word8
, TableMeta -> Word8
tableMetaScanUnit :: Word8
, TableMeta -> Bool
tableMetaByte :: Bool
, TableMeta -> Bool
tableMetaBit :: Bool
, TableMeta -> Word32
tableMetaSize :: Word32
, TableMeta -> Word32
tableMetaOffset :: Word32
}
data PCFTableType = PCF_PROPERTIES
| PCF_ACCELERATORS
| PCF_METRICS
| PCF_BITMAPS
| PCF_INK_METRICS
| PCF_BDF_ENCODINGS
| PCF_SWIDTHS
| PCF_GLYPH_NAMES
| PCF_BDF_ACCELERATORS
deriving (PCFTableType -> PCFTableType -> Bool
(PCFTableType -> PCFTableType -> Bool)
-> (PCFTableType -> PCFTableType -> Bool) -> Eq PCFTableType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCFTableType -> PCFTableType -> Bool
$c/= :: PCFTableType -> PCFTableType -> Bool
== :: PCFTableType -> PCFTableType -> Bool
$c== :: PCFTableType -> PCFTableType -> Bool
Eq, Eq PCFTableType
Eq PCFTableType
-> (PCFTableType -> PCFTableType -> Ordering)
-> (PCFTableType -> PCFTableType -> Bool)
-> (PCFTableType -> PCFTableType -> Bool)
-> (PCFTableType -> PCFTableType -> Bool)
-> (PCFTableType -> PCFTableType -> Bool)
-> (PCFTableType -> PCFTableType -> PCFTableType)
-> (PCFTableType -> PCFTableType -> PCFTableType)
-> Ord PCFTableType
PCFTableType -> PCFTableType -> Bool
PCFTableType -> PCFTableType -> Ordering
PCFTableType -> PCFTableType -> PCFTableType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PCFTableType -> PCFTableType -> PCFTableType
$cmin :: PCFTableType -> PCFTableType -> PCFTableType
max :: PCFTableType -> PCFTableType -> PCFTableType
$cmax :: PCFTableType -> PCFTableType -> PCFTableType
>= :: PCFTableType -> PCFTableType -> Bool
$c>= :: PCFTableType -> PCFTableType -> Bool
> :: PCFTableType -> PCFTableType -> Bool
$c> :: PCFTableType -> PCFTableType -> Bool
<= :: PCFTableType -> PCFTableType -> Bool
$c<= :: PCFTableType -> PCFTableType -> Bool
< :: PCFTableType -> PCFTableType -> Bool
$c< :: PCFTableType -> PCFTableType -> Bool
compare :: PCFTableType -> PCFTableType -> Ordering
$ccompare :: PCFTableType -> PCFTableType -> Ordering
$cp1Ord :: Eq PCFTableType
Ord, Int -> PCFTableType -> ShowS
[PCFTableType] -> ShowS
PCFTableType -> String
(Int -> PCFTableType -> ShowS)
-> (PCFTableType -> String)
-> ([PCFTableType] -> ShowS)
-> Show PCFTableType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCFTableType] -> ShowS
$cshowList :: [PCFTableType] -> ShowS
show :: PCFTableType -> String
$cshow :: PCFTableType -> String
showsPrec :: Int -> PCFTableType -> ShowS
$cshowsPrec :: Int -> PCFTableType -> ShowS
Show)
data PCFGlyph = PCFGlyph { PCFGlyph -> Metrics
glyph_metrics :: Metrics
, PCFGlyph -> Char
glyph_char :: Char
, PCFGlyph -> Int
glyph_width :: Int
, PCFGlyph -> Int
glyph_height :: Int
, PCFGlyph -> Int
glyph_pitch :: Int
, PCFGlyph -> ByteString
glyph_bitmap :: ByteString
}
instance Show PCFGlyph where
show :: PCFGlyph -> String
show 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
..} = String
"PCFGlyph {glyph_metrics = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Metrics -> String
forall a. Show a => a -> String
show Metrics
glyph_metrics String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
", glyph_char = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
glyph_char String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
", glyph_width = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
glyph_width String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
", glyph_height = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
glyph_height String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
", glyph_pitch = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
glyph_pitch String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
", glyph_bitmap = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
glyph_bitmap String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
PCFGlyph -> String
glyph_ascii PCFGlyph
g
glyph_ascii :: PCFGlyph -> String
glyph_ascii :: PCFGlyph -> String
glyph_ascii = ByteString -> String
B.unpack (ByteString -> String)
-> (PCFGlyph -> ByteString) -> PCFGlyph -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString)
-> (PCFGlyph -> [ByteString]) -> PCFGlyph -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n") ([ByteString] -> [ByteString])
-> (PCFGlyph -> [ByteString]) -> PCFGlyph -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PCFGlyph -> [ByteString]
glyph_ascii_lines_bs
glyph_ascii_lines :: PCFGlyph -> [String]
glyph_ascii_lines :: PCFGlyph -> [String]
glyph_ascii_lines = (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
B.unpack ([ByteString] -> [String])
-> (PCFGlyph -> [ByteString]) -> PCFGlyph -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PCFGlyph -> [ByteString]
glyph_ascii_lines_bs
glyph_ascii_lines_bs :: PCFGlyph -> [ByteString]
glyph_ascii_lines_bs :: PCFGlyph -> [ByteString]
glyph_ascii_lines_bs 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
..} = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Int64 -> ByteString -> ByteString
B.take (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glyph_width) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
showBits) [ByteString]
rs
where
rs :: [ByteString]
rs = ByteString -> [ByteString]
rows ByteString
glyph_bitmap
rows :: ByteString -> [ByteString]
rows ByteString
bs = case Int64 -> ByteString -> (ByteString, ByteString)
B.splitAt (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
glyph_pitch) ByteString
bs of
(ByteString
r, ByteString
"") -> [ByteString
r]
(ByteString
r, ByteString
t) -> ByteString
r ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
rows ByteString
t
showBits :: ByteString -> ByteString
showBits = (Word8 -> ByteString) -> ByteString -> ByteString
B.concatMap ((Word8 -> ByteString) -> ByteString -> ByteString)
-> (Word8 -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [Word8 -> ByteString] -> Word8 -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([Word8 -> ByteString] -> Word8 -> ByteString)
-> [Word8 -> ByteString] -> Word8 -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int -> Word8 -> ByteString) -> [Int] -> [Word8 -> ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Word8 -> ByteString
showBit [Int
7,Int
6..Int
0]
showBit :: Int -> Word8 -> ByteString
showBit :: Int -> Word8 -> ByteString
showBit Int
i Word8
w
| Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
w Int
i = ByteString
"X"
| Bool
otherwise = ByteString
" "
data PCFText = PCFText { PCFText -> [PCFGlyph]
pcf_text_glyphs :: [PCFGlyph]
, PCFText -> Int
pcf_text_width :: Int
, PCFText -> Int
pcf_text_height :: Int
, PCFText -> Vector Word8
pcf_text_image :: VS.Vector Word8
}
pcf_text_string :: PCFText -> String
pcf_text_string :: PCFText -> String
pcf_text_string = (PCFGlyph -> Char) -> [PCFGlyph] -> String
forall a b. (a -> b) -> [a] -> [b]
map PCFGlyph -> Char
glyph_char ([PCFGlyph] -> String)
-> (PCFText -> [PCFGlyph]) -> PCFText -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PCFText -> [PCFGlyph]
pcf_text_glyphs
pcf_text_ascii :: PCFText -> String
pcf_text_ascii :: PCFText -> String
pcf_text_ascii = ByteString -> String
B.unpack (ByteString -> String)
-> (PCFText -> ByteString) -> PCFText -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"\n" ([ByteString] -> ByteString)
-> (PCFText -> [ByteString]) -> PCFText -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString] -> ByteString) -> [[ByteString]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map [ByteString] -> ByteString
B.concat ([[ByteString]] -> [ByteString])
-> (PCFText -> [[ByteString]]) -> PCFText -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ByteString]] -> [[ByteString]]
forall a. [[a]] -> [[a]]
transpose ([[ByteString]] -> [[ByteString]])
-> (PCFText -> [[ByteString]]) -> PCFText -> [[ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PCFGlyph -> [ByteString]) -> [PCFGlyph] -> [[ByteString]]
forall a b. (a -> b) -> [a] -> [b]
map PCFGlyph -> [ByteString]
glyph_ascii_lines_bs ([PCFGlyph] -> [[ByteString]])
-> (PCFText -> [PCFGlyph]) -> PCFText -> [[ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PCFText -> [PCFGlyph]
pcf_text_glyphs