{-# 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

-- | Container of tables extracted from a PCF font file.
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
                          -- ^ False = left to right, True = right to left
                          , 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)

-- | Container of glyph dimension and position metrics.
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
                           -- ^ Table type
                           , TableMeta -> Word32
tableMetaFormat :: Word32
                           -- ^ Whole format field for reconstructing
                           , TableMeta -> Word8
tableMetaGlyphPad :: Word8
                           -- ^ Level of padding applied to glyph bitmaps
                           , TableMeta -> Word8
tableMetaScanUnit :: Word8
                           -- ^ ?
                           , TableMeta -> Bool
tableMetaByte :: Bool
                           -- ^ Byte-wise endianess
                           , TableMeta -> Bool
tableMetaBit :: Bool
                           -- ^ Bit-wise endianess
                           , TableMeta -> Word32
tableMetaSize :: Word32
                           -- ^ Number of bytes used by the table
                           , TableMeta -> Word32
tableMetaOffset :: Word32
                           -- ^ Byte offset to table from beginning of file
                           }

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)

-- | Container of a single glyph bitmap and its metadata.
data PCFGlyph = PCFGlyph { PCFGlyph -> Metrics
glyph_metrics :: Metrics
                         , PCFGlyph -> Char
glyph_char :: Char
                         -- ^ Unicode character corresponding to glyph
                         , PCFGlyph -> Int
glyph_width :: Int
                         -- ^ Pixel width of glyph once rendered
                         , PCFGlyph -> Int
glyph_height :: Int
                         -- ^ Pixel height of glyph once rendered
                         , PCFGlyph -> Int
glyph_pitch :: Int
                         -- ^ Number of bytes in each bitmap row
                         , PCFGlyph -> ByteString
glyph_bitmap :: ByteString
                         -- ^ `glyph_height` rows of `glyph_pitch` bytes containing the glyph's bitmap image starting from the left-most bit and ending at the `glyph_width` bit in each row
                         }

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

-- | Render glyph bitmap as a string where 'X' represents opaque pixels and whitespace represents blank pixels.
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

-- | Render glyph bitmap as a list of strings representing lines where 'X' represents opaque pixels and whitespace represents blank pixels.
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
" "

-- | Representation of string and its corresponding bitmap content. Metadata regarding source font is not included.
data PCFText = PCFText { PCFText -> [PCFGlyph]
pcf_text_glyphs :: [PCFGlyph]
                       -- ^ Metadata of each glyph rendered to the image bitmap
                       , PCFText -> Int
pcf_text_width :: Int
                       -- ^ Width of the rendered bitmap image
                       , PCFText -> Int
pcf_text_height :: Int
                       -- ^ Height of the rendered bitmap image
                       , PCFText -> Vector Word8
pcf_text_image :: VS.Vector Word8
                       -- ^ Text rendered as a bitmap image where 0 is opaque and 255 is empty in each cell
                       }

-- | String represented by PCFText rendering.
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

-- | ASCII rendering of a whole PCFText string rendering.
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