module Font(CharStruct(CharStruct,char_width,char_rbearing),
            FontStruct(..),FontStructList(..),
            FontStructF(FontStruct,font_id,font_ascent,font_descent,font_prop),
            FontDirection(..), FontProp(..), update_font_id, font_range,
            split_string, string_len, -- string_rect_mono,
            string_rect, string_box_size, string_bounds,
            next_pos, poslist, linespace,fsl2fs) where
import Geometry(Point(..), Rect(..), Size, pP, rR, rectsize, xcoord)
import Xtypes(Atom,FontId)
--import Utils(aboth)
--import HbcUtils(mapFst)
import Data.List(mapAccumL)
import Maptrace(ctrace) -- debugging
import Data.Array
--import qualified Data.Array as LA
--import qualified LA -- GHC bug workaround, can't use LA.!

default(Int)

data CharStruct = CharStruct {CharStruct -> Int
char_lbearing, CharStruct -> Int
char_rbearing,
                              CharStruct -> Int
char_width, CharStruct -> Int
char_ascent, CharStruct -> Int
char_descent :: Int}
		  deriving (CharStruct -> CharStruct -> Bool
(CharStruct -> CharStruct -> Bool)
-> (CharStruct -> CharStruct -> Bool) -> Eq CharStruct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharStruct -> CharStruct -> Bool
$c/= :: CharStruct -> CharStruct -> Bool
== :: CharStruct -> CharStruct -> Bool
$c== :: CharStruct -> CharStruct -> Bool
Eq, Eq CharStruct
Eq CharStruct
-> (CharStruct -> CharStruct -> Ordering)
-> (CharStruct -> CharStruct -> Bool)
-> (CharStruct -> CharStruct -> Bool)
-> (CharStruct -> CharStruct -> Bool)
-> (CharStruct -> CharStruct -> Bool)
-> (CharStruct -> CharStruct -> CharStruct)
-> (CharStruct -> CharStruct -> CharStruct)
-> Ord CharStruct
CharStruct -> CharStruct -> Bool
CharStruct -> CharStruct -> Ordering
CharStruct -> CharStruct -> CharStruct
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 :: CharStruct -> CharStruct -> CharStruct
$cmin :: CharStruct -> CharStruct -> CharStruct
max :: CharStruct -> CharStruct -> CharStruct
$cmax :: CharStruct -> CharStruct -> CharStruct
>= :: CharStruct -> CharStruct -> Bool
$c>= :: CharStruct -> CharStruct -> Bool
> :: CharStruct -> CharStruct -> Bool
$c> :: CharStruct -> CharStruct -> Bool
<= :: CharStruct -> CharStruct -> Bool
$c<= :: CharStruct -> CharStruct -> Bool
< :: CharStruct -> CharStruct -> Bool
$c< :: CharStruct -> CharStruct -> Bool
compare :: CharStruct -> CharStruct -> Ordering
$ccompare :: CharStruct -> CharStruct -> Ordering
$cp1Ord :: Eq CharStruct
Ord, Int -> CharStruct -> ShowS
[CharStruct] -> ShowS
CharStruct -> String
(Int -> CharStruct -> ShowS)
-> (CharStruct -> String)
-> ([CharStruct] -> ShowS)
-> Show CharStruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharStruct] -> ShowS
$cshowList :: [CharStruct] -> ShowS
show :: CharStruct -> String
$cshow :: CharStruct -> String
showsPrec :: Int -> CharStruct -> ShowS
$cshowsPrec :: Int -> CharStruct -> ShowS
Show, ReadPrec [CharStruct]
ReadPrec CharStruct
Int -> ReadS CharStruct
ReadS [CharStruct]
(Int -> ReadS CharStruct)
-> ReadS [CharStruct]
-> ReadPrec CharStruct
-> ReadPrec [CharStruct]
-> Read CharStruct
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CharStruct]
$creadListPrec :: ReadPrec [CharStruct]
readPrec :: ReadPrec CharStruct
$creadPrec :: ReadPrec CharStruct
readList :: ReadS [CharStruct]
$creadList :: ReadS [CharStruct]
readsPrec :: Int -> ReadS CharStruct
$creadsPrec :: Int -> ReadS CharStruct
Read)

data FontDirection = FontLeftToRight | FontRightToLeft 
                     deriving (FontDirection -> FontDirection -> Bool
(FontDirection -> FontDirection -> Bool)
-> (FontDirection -> FontDirection -> Bool) -> Eq FontDirection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontDirection -> FontDirection -> Bool
$c/= :: FontDirection -> FontDirection -> Bool
== :: FontDirection -> FontDirection -> Bool
$c== :: FontDirection -> FontDirection -> Bool
Eq, Eq FontDirection
Eq FontDirection
-> (FontDirection -> FontDirection -> Ordering)
-> (FontDirection -> FontDirection -> Bool)
-> (FontDirection -> FontDirection -> Bool)
-> (FontDirection -> FontDirection -> Bool)
-> (FontDirection -> FontDirection -> Bool)
-> (FontDirection -> FontDirection -> FontDirection)
-> (FontDirection -> FontDirection -> FontDirection)
-> Ord FontDirection
FontDirection -> FontDirection -> Bool
FontDirection -> FontDirection -> Ordering
FontDirection -> FontDirection -> FontDirection
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 :: FontDirection -> FontDirection -> FontDirection
$cmin :: FontDirection -> FontDirection -> FontDirection
max :: FontDirection -> FontDirection -> FontDirection
$cmax :: FontDirection -> FontDirection -> FontDirection
>= :: FontDirection -> FontDirection -> Bool
$c>= :: FontDirection -> FontDirection -> Bool
> :: FontDirection -> FontDirection -> Bool
$c> :: FontDirection -> FontDirection -> Bool
<= :: FontDirection -> FontDirection -> Bool
$c<= :: FontDirection -> FontDirection -> Bool
< :: FontDirection -> FontDirection -> Bool
$c< :: FontDirection -> FontDirection -> Bool
compare :: FontDirection -> FontDirection -> Ordering
$ccompare :: FontDirection -> FontDirection -> Ordering
$cp1Ord :: Eq FontDirection
Ord, Int -> FontDirection -> ShowS
[FontDirection] -> ShowS
FontDirection -> String
(Int -> FontDirection -> ShowS)
-> (FontDirection -> String)
-> ([FontDirection] -> ShowS)
-> Show FontDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontDirection] -> ShowS
$cshowList :: [FontDirection] -> ShowS
show :: FontDirection -> String
$cshow :: FontDirection -> String
showsPrec :: Int -> FontDirection -> ShowS
$cshowsPrec :: Int -> FontDirection -> ShowS
Show, ReadPrec [FontDirection]
ReadPrec FontDirection
Int -> ReadS FontDirection
ReadS [FontDirection]
(Int -> ReadS FontDirection)
-> ReadS [FontDirection]
-> ReadPrec FontDirection
-> ReadPrec [FontDirection]
-> Read FontDirection
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FontDirection]
$creadListPrec :: ReadPrec [FontDirection]
readPrec :: ReadPrec FontDirection
$creadPrec :: ReadPrec FontDirection
readList :: ReadS [FontDirection]
$creadList :: ReadS [FontDirection]
readsPrec :: Int -> ReadS FontDirection
$creadsPrec :: Int -> ReadS FontDirection
Read, Int -> FontDirection
FontDirection -> Int
FontDirection -> [FontDirection]
FontDirection -> FontDirection
FontDirection -> FontDirection -> [FontDirection]
FontDirection -> FontDirection -> FontDirection -> [FontDirection]
(FontDirection -> FontDirection)
-> (FontDirection -> FontDirection)
-> (Int -> FontDirection)
-> (FontDirection -> Int)
-> (FontDirection -> [FontDirection])
-> (FontDirection -> FontDirection -> [FontDirection])
-> (FontDirection -> FontDirection -> [FontDirection])
-> (FontDirection
    -> FontDirection -> FontDirection -> [FontDirection])
-> Enum FontDirection
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FontDirection -> FontDirection -> FontDirection -> [FontDirection]
$cenumFromThenTo :: FontDirection -> FontDirection -> FontDirection -> [FontDirection]
enumFromTo :: FontDirection -> FontDirection -> [FontDirection]
$cenumFromTo :: FontDirection -> FontDirection -> [FontDirection]
enumFromThen :: FontDirection -> FontDirection -> [FontDirection]
$cenumFromThen :: FontDirection -> FontDirection -> [FontDirection]
enumFrom :: FontDirection -> [FontDirection]
$cenumFrom :: FontDirection -> [FontDirection]
fromEnum :: FontDirection -> Int
$cfromEnum :: FontDirection -> Int
toEnum :: Int -> FontDirection
$ctoEnum :: Int -> FontDirection
pred :: FontDirection -> FontDirection
$cpred :: FontDirection -> FontDirection
succ :: FontDirection -> FontDirection
$csucc :: FontDirection -> FontDirection
Enum)

data FontProp = FontProp Atom Int deriving (FontProp -> FontProp -> Bool
(FontProp -> FontProp -> Bool)
-> (FontProp -> FontProp -> Bool) -> Eq FontProp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontProp -> FontProp -> Bool
$c/= :: FontProp -> FontProp -> Bool
== :: FontProp -> FontProp -> Bool
$c== :: FontProp -> FontProp -> Bool
Eq, Eq FontProp
Eq FontProp
-> (FontProp -> FontProp -> Ordering)
-> (FontProp -> FontProp -> Bool)
-> (FontProp -> FontProp -> Bool)
-> (FontProp -> FontProp -> Bool)
-> (FontProp -> FontProp -> Bool)
-> (FontProp -> FontProp -> FontProp)
-> (FontProp -> FontProp -> FontProp)
-> Ord FontProp
FontProp -> FontProp -> Bool
FontProp -> FontProp -> Ordering
FontProp -> FontProp -> FontProp
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 :: FontProp -> FontProp -> FontProp
$cmin :: FontProp -> FontProp -> FontProp
max :: FontProp -> FontProp -> FontProp
$cmax :: FontProp -> FontProp -> FontProp
>= :: FontProp -> FontProp -> Bool
$c>= :: FontProp -> FontProp -> Bool
> :: FontProp -> FontProp -> Bool
$c> :: FontProp -> FontProp -> Bool
<= :: FontProp -> FontProp -> Bool
$c<= :: FontProp -> FontProp -> Bool
< :: FontProp -> FontProp -> Bool
$c< :: FontProp -> FontProp -> Bool
compare :: FontProp -> FontProp -> Ordering
$ccompare :: FontProp -> FontProp -> Ordering
$cp1Ord :: Eq FontProp
Ord, Int -> FontProp -> ShowS
[FontProp] -> ShowS
FontProp -> String
(Int -> FontProp -> ShowS)
-> (FontProp -> String) -> ([FontProp] -> ShowS) -> Show FontProp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontProp] -> ShowS
$cshowList :: [FontProp] -> ShowS
show :: FontProp -> String
$cshow :: FontProp -> String
showsPrec :: Int -> FontProp -> ShowS
$cshowsPrec :: Int -> FontProp -> ShowS
Show, ReadPrec [FontProp]
ReadPrec FontProp
Int -> ReadS FontProp
ReadS [FontProp]
(Int -> ReadS FontProp)
-> ReadS [FontProp]
-> ReadPrec FontProp
-> ReadPrec [FontProp]
-> Read FontProp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FontProp]
$creadListPrec :: ReadPrec [FontProp]
readPrec :: ReadPrec FontProp
$creadPrec :: ReadPrec FontProp
readList :: ReadS [FontProp]
$creadList :: ReadS [FontProp]
readsPrec :: Int -> ReadS FontProp
$creadsPrec :: Int -> ReadS FontProp
Read)

-- Only 8-bit characters and 2-byte matrixes. See fsl2fs too!
type FontStruct = FontStructF (Array Char CharStruct)
data FontStructF per_char =
    FontStruct {FontStructF per_char -> FontId
font_id :: FontId,
                FontStructF per_char -> FontDirection
font_dir :: FontDirection,
                FontStructF per_char -> Char
first_char, FontStructF per_char -> Char
last_char :: Char,
                FontStructF per_char -> Bool
font_complete :: Bool, -- all chars exist
                FontStructF per_char -> Char
default_char :: Char,
                FontStructF per_char -> [FontProp]
font_prop :: [FontProp],
                FontStructF per_char -> CharStruct
max_bounds, FontStructF per_char -> CharStruct
min_bounds :: CharStruct,
                FontStructF per_char -> Maybe per_char
per_char :: Maybe per_char,
                FontStructF per_char -> Int
font_ascent, FontStructF per_char -> Int
font_descent :: Int
                  -- ^ logical extent above/below baseline for spacing
               }
    deriving (FontStructF per_char -> FontStructF per_char -> Bool
(FontStructF per_char -> FontStructF per_char -> Bool)
-> (FontStructF per_char -> FontStructF per_char -> Bool)
-> Eq (FontStructF per_char)
forall per_char.
Eq per_char =>
FontStructF per_char -> FontStructF per_char -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontStructF per_char -> FontStructF per_char -> Bool
$c/= :: forall per_char.
Eq per_char =>
FontStructF per_char -> FontStructF per_char -> Bool
== :: FontStructF per_char -> FontStructF per_char -> Bool
$c== :: forall per_char.
Eq per_char =>
FontStructF per_char -> FontStructF per_char -> Bool
Eq, Eq (FontStructF per_char)
Eq (FontStructF per_char)
-> (FontStructF per_char -> FontStructF per_char -> Ordering)
-> (FontStructF per_char -> FontStructF per_char -> Bool)
-> (FontStructF per_char -> FontStructF per_char -> Bool)
-> (FontStructF per_char -> FontStructF per_char -> Bool)
-> (FontStructF per_char -> FontStructF per_char -> Bool)
-> (FontStructF per_char
    -> FontStructF per_char -> FontStructF per_char)
-> (FontStructF per_char
    -> FontStructF per_char -> FontStructF per_char)
-> Ord (FontStructF per_char)
FontStructF per_char -> FontStructF per_char -> Bool
FontStructF per_char -> FontStructF per_char -> Ordering
FontStructF per_char
-> FontStructF per_char -> FontStructF per_char
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
forall per_char. Ord per_char => Eq (FontStructF per_char)
forall per_char.
Ord per_char =>
FontStructF per_char -> FontStructF per_char -> Bool
forall per_char.
Ord per_char =>
FontStructF per_char -> FontStructF per_char -> Ordering
forall per_char.
Ord per_char =>
FontStructF per_char
-> FontStructF per_char -> FontStructF per_char
min :: FontStructF per_char
-> FontStructF per_char -> FontStructF per_char
$cmin :: forall per_char.
Ord per_char =>
FontStructF per_char
-> FontStructF per_char -> FontStructF per_char
max :: FontStructF per_char
-> FontStructF per_char -> FontStructF per_char
$cmax :: forall per_char.
Ord per_char =>
FontStructF per_char
-> FontStructF per_char -> FontStructF per_char
>= :: FontStructF per_char -> FontStructF per_char -> Bool
$c>= :: forall per_char.
Ord per_char =>
FontStructF per_char -> FontStructF per_char -> Bool
> :: FontStructF per_char -> FontStructF per_char -> Bool
$c> :: forall per_char.
Ord per_char =>
FontStructF per_char -> FontStructF per_char -> Bool
<= :: FontStructF per_char -> FontStructF per_char -> Bool
$c<= :: forall per_char.
Ord per_char =>
FontStructF per_char -> FontStructF per_char -> Bool
< :: FontStructF per_char -> FontStructF per_char -> Bool
$c< :: forall per_char.
Ord per_char =>
FontStructF per_char -> FontStructF per_char -> Bool
compare :: FontStructF per_char -> FontStructF per_char -> Ordering
$ccompare :: forall per_char.
Ord per_char =>
FontStructF per_char -> FontStructF per_char -> Ordering
$cp1Ord :: forall per_char. Ord per_char => Eq (FontStructF per_char)
Ord, Int -> FontStructF per_char -> ShowS
[FontStructF per_char] -> ShowS
FontStructF per_char -> String
(Int -> FontStructF per_char -> ShowS)
-> (FontStructF per_char -> String)
-> ([FontStructF per_char] -> ShowS)
-> Show (FontStructF per_char)
forall per_char.
Show per_char =>
Int -> FontStructF per_char -> ShowS
forall per_char. Show per_char => [FontStructF per_char] -> ShowS
forall per_char. Show per_char => FontStructF per_char -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontStructF per_char] -> ShowS
$cshowList :: forall per_char. Show per_char => [FontStructF per_char] -> ShowS
show :: FontStructF per_char -> String
$cshow :: forall per_char. Show per_char => FontStructF per_char -> String
showsPrec :: Int -> FontStructF per_char -> ShowS
$cshowsPrec :: forall per_char.
Show per_char =>
Int -> FontStructF per_char -> ShowS
Show, ReadPrec [FontStructF per_char]
ReadPrec (FontStructF per_char)
Int -> ReadS (FontStructF per_char)
ReadS [FontStructF per_char]
(Int -> ReadS (FontStructF per_char))
-> ReadS [FontStructF per_char]
-> ReadPrec (FontStructF per_char)
-> ReadPrec [FontStructF per_char]
-> Read (FontStructF per_char)
forall per_char. Read per_char => ReadPrec [FontStructF per_char]
forall per_char. Read per_char => ReadPrec (FontStructF per_char)
forall per_char.
Read per_char =>
Int -> ReadS (FontStructF per_char)
forall per_char. Read per_char => ReadS [FontStructF per_char]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FontStructF per_char]
$creadListPrec :: forall per_char. Read per_char => ReadPrec [FontStructF per_char]
readPrec :: ReadPrec (FontStructF per_char)
$creadPrec :: forall per_char. Read per_char => ReadPrec (FontStructF per_char)
readList :: ReadS [FontStructF per_char]
$creadList :: forall per_char. Read per_char => ReadS [FontStructF per_char]
readsPrec :: Int -> ReadS (FontStructF per_char)
$creadsPrec :: forall per_char.
Read per_char =>
Int -> ReadS (FontStructF per_char)
Read)
{-
font_id      (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = fid
font_ascent  (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = asc
font_descent (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = de
per_char     (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = ca
max_bounds   (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = maxb
min_bounds   (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = minb
font_range   (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = (fc,lc)
default_char (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = dc
font_prop    (FontStruct fid fd fc lc all' dc fps minb maxb ca asc de) = fps
-}
font_range :: FontStructF per_char -> (Char, Char)
font_range FontStructF per_char
fs = (FontStructF per_char -> Char
forall per_char. FontStructF per_char -> Char
first_char FontStructF per_char
fs,FontStructF per_char -> Char
forall per_char. FontStructF per_char -> Char
last_char FontStructF per_char
fs)

--update_font_id (FontStruct _ fd fc lc all' dc fps minb maxb ca asc de) fid = 
--  FontStruct fid fd fc lc all' dc fps minb maxb ca asc de
update_font_id :: FontStructF per_char -> FontId -> FontStructF per_char
update_font_id FontStructF per_char
fs FontId
fid = FontStructF per_char
fs{font_id :: FontId
font_id=FontId
fid}

linespace :: FontStructF per_char -> Int
linespace FontStructF per_char
fs = FontStructF per_char -> Int
forall per_char. FontStructF per_char -> Int
font_ascent FontStructF per_char
fs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FontStructF per_char -> Int
forall per_char. FontStructF per_char -> Int
font_descent FontStructF per_char
fs

char_struct :: (FontStructF (Array Char p) -> p)
-> FontStructF (Array Char p) -> Char -> p
char_struct FontStructF (Array Char p) -> p
default' FontStructF (Array Char p)
fs Char
c =
    case FontStructF (Array Char p) -> Maybe (Array Char p)
forall per_char. FontStructF per_char -> Maybe per_char
per_char FontStructF (Array Char p)
fs of
      Maybe (Array Char p)
Nothing -> FontStructF (Array Char p) -> p
default' FontStructF (Array Char p)
fs
      Just Array Char p
ca -> --ca ! c
                 Array Char p
ca Array Char p -> Char -> p
forall i e. Ix i => Array i e -> i -> e
! (if (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (FontStructF (Array Char p) -> (Char, Char)
forall per_char. FontStructF per_char -> (Char, Char)
font_range FontStructF (Array Char p)
fs) Char
c   -- or: bounds ca
                       then -- debugging
		            if (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Array Char p -> (Char, Char)
forall i e. Array i e -> (i, i)
bounds Array Char p
ca) Char
c
			    then Char
c
			    else String -> ((Char, Char), (Char, Char), Char) -> Char -> Char
forall a1 a2. Show a1 => String -> a1 -> a2 -> a2
ctrace String
"fontrange" (FontStructF (Array Char p) -> (Char, Char)
forall per_char. FontStructF per_char -> (Char, Char)
font_range FontStructF (Array Char p)
fs,Array Char p -> (Char, Char)
forall i e. Array i e -> (i, i)
bounds Array Char p
ca,Char
c) (FontStructF (Array Char p) -> Char
forall per_char. FontStructF per_char -> Char
default_char FontStructF (Array Char p)
fs)
		       else let c' :: Char
c' = FontStructF (Array Char p) -> Char
forall per_char. FontStructF per_char -> Char
default_char FontStructF (Array Char p)
fs
		            in if (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Array Char p -> (Char, Char)
forall i e. Array i e -> (i, i)
bounds Array Char p
ca) Char
c'
			       then Char
c'
			       else String -> ((Char, Char), String, Char) -> Char -> Char
forall a1 a2. Show a1 => String -> a1 -> a2 -> a2
ctrace String
"fontrange" (FontStructF (Array Char p) -> (Char, Char)
forall per_char. FontStructF per_char -> (Char, Char)
font_range FontStructF (Array Char p)
fs,String
"default char",Char
c') Char
' ')

lbearing :: FontStructF (Array Char CharStruct) -> Char -> Int
lbearing FontStructF (Array Char CharStruct)
fs = CharStruct -> Int
char_lbearing (CharStruct -> Int) -> (Char -> CharStruct) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FontStructF (Array Char CharStruct) -> CharStruct)
-> FontStructF (Array Char CharStruct) -> Char -> CharStruct
forall p.
(FontStructF (Array Char p) -> p)
-> FontStructF (Array Char p) -> Char -> p
char_struct FontStructF (Array Char CharStruct) -> CharStruct
forall per_char. FontStructF per_char -> CharStruct
min_bounds FontStructF (Array Char CharStruct)
fs
rbearing :: FontStructF (Array Char CharStruct) -> Char -> Int
rbearing FontStructF (Array Char CharStruct)
fs = CharStruct -> Int
char_rbearing (CharStruct -> Int) -> (Char -> CharStruct) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FontStructF (Array Char CharStruct) -> CharStruct)
-> FontStructF (Array Char CharStruct) -> Char -> CharStruct
forall p.
(FontStructF (Array Char p) -> p)
-> FontStructF (Array Char p) -> Char -> p
char_struct FontStructF (Array Char CharStruct) -> CharStruct
forall per_char. FontStructF per_char -> CharStruct
max_bounds FontStructF (Array Char CharStruct)
fs

poslist :: FontStruct -> String -> [Int]
poslist :: FontStructF (Array Char CharStruct) -> String -> [Int]
poslist FontStructF (Array Char CharStruct)
fs = (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (CharStruct -> Int
char_width (CharStruct -> Int) -> (Char -> CharStruct) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FontStructF (Array Char CharStruct) -> CharStruct)
-> FontStructF (Array Char CharStruct) -> Char -> CharStruct
forall p.
(FontStructF (Array Char p) -> p)
-> FontStructF (Array Char p) -> Char -> p
char_struct FontStructF (Array Char CharStruct) -> CharStruct
forall per_char. FontStructF per_char -> CharStruct
max_bounds FontStructF (Array Char CharStruct)
fs)

next_pos :: FontStruct -> String -> Int
next_pos :: FontStructF (Array Char CharStruct) -> String -> Int
next_pos FontStructF (Array Char CharStruct)
fs = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (String -> [Int]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontStructF (Array Char CharStruct) -> String -> [Int]
poslist FontStructF (Array Char CharStruct)
fs

-- string_bounds gives enclosing rect with respect to first character's origin
string_bounds :: FontStruct -> String -> Rect
string_bounds :: FontStructF (Array Char CharStruct) -> String -> Rect
string_bounds FontStructF (Array Char CharStruct)
fs [] = Point -> Point -> Rect
Rect (Int -> Int -> Point
Point Int
0 Int
0) (Int -> Int -> Point
Point Int
0 Int
0)
string_bounds FontStructF (Array Char CharStruct)
fs String
s =
    let cs :: Char -> CharStruct
cs = (FontStructF (Array Char CharStruct) -> CharStruct)
-> FontStructF (Array Char CharStruct) -> Char -> CharStruct
forall p.
(FontStructF (Array Char p) -> p)
-> FontStructF (Array Char p) -> Char -> p
char_struct FontStructF (Array Char CharStruct) -> CharStruct
forall per_char. FontStructF per_char -> CharStruct
max_bounds FontStructF (Array Char CharStruct)
fs
        x :: Int
x = FontStructF (Array Char CharStruct) -> Char -> Int
lbearing FontStructF (Array Char CharStruct)
fs (String -> Char
forall a. [a] -> a
head String
s)
        y :: Int
y = -([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> (String -> [Int]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (CharStruct -> Int
char_ascent (CharStruct -> Int) -> (Char -> CharStruct) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> CharStruct
cs)) String
s
        width :: Int
width = FontStructF (Array Char CharStruct) -> String -> Int
next_pos FontStructF (Array Char CharStruct)
fs (Int -> ShowS
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FontStructF (Array Char CharStruct) -> Char -> Int
rbearing FontStructF (Array Char CharStruct)
fs (String -> Char
forall a. [a] -> a
last String
s)
        height :: Int
height = ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> (String -> [Int]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (CharStruct -> Int
char_descent (CharStruct -> Int) -> (Char -> CharStruct) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> CharStruct
cs)) String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y
    in  Point -> Point -> Rect
Rect (Int -> Int -> Point
Point Int
x Int
y) (Int -> Int -> Point
Point Int
width Int
height)

string_len :: FontStruct -> String -> Int
string_len :: FontStructF (Array Char CharStruct) -> String -> Int
string_len FontStructF (Array Char CharStruct)
fs String
s = (Point -> Int
xcoord (Point -> Int) -> (String -> Point) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rect -> Point
rectsize (Rect -> Point) -> (String -> Rect) -> String -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontStructF (Array Char CharStruct) -> String -> Rect
string_bounds FontStructF (Array Char CharStruct)
fs) String
s

string_rect :: FontStruct -> String -> Rect
string_rect :: FontStructF (Array Char CharStruct) -> String -> Rect
string_rect FontStructF (Array Char CharStruct)
fs String
s =
    Int -> Int -> Int -> Int -> Rect
rR Int
0 (-FontStructF (Array Char CharStruct) -> Int
forall per_char. FontStructF per_char -> Int
font_ascent FontStructF (Array Char CharStruct)
fs) (FontStructF (Array Char CharStruct) -> String -> Int
string_len FontStructF (Array Char CharStruct)
fs String
s) (FontStructF (Array Char CharStruct) -> Int
forall per_char. FontStructF per_char -> Int
linespace FontStructF (Array Char CharStruct)
fs)

string_box_size :: FontStruct -> String -> Size
string_box_size :: FontStructF (Array Char CharStruct) -> String -> Point
string_box_size FontStructF (Array Char CharStruct)
fs String
s = Int -> Int -> Point
pP (FontStructF (Array Char CharStruct) -> String -> Int
next_pos FontStructF (Array Char CharStruct)
fs String
s) (FontStructF (Array Char CharStruct) -> Int
forall per_char. FontStructF per_char -> Int
linespace FontStructF (Array Char CharStruct)
fs)

split_string:: FontStruct -> String -> Int -> (String,String,Int)
split_string :: FontStructF (Array Char CharStruct)
-> String -> Int -> (String, String, Int)
split_string FontStructF (Array Char CharStruct)
fs String
s Int
x =
   -- find the first char that ends to the right of the wanted x position
   case ((Int, Int, Int) -> Bool) -> [(Int, Int, Int)] -> [(Int, Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Int
_,Int
_,Int
xr)->Int
xrInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
x) [(Int, Int, Int)]
nxs of
     (Int
n,Int
xl,Int
xr):[(Int, Int, Int)]
_ ->
	-- xl<=x<=xr, wanted x position is inside the nth character
	if Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
xlInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
xrInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x
	then Int -> (String, String, Int)
split Int
n -- left edge of nth char is closer
	else Int -> (String, String, Int)
split (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) -- right edge of nth char is closer
     [] -> (String
s,[],Int
n) -- x position is after the last char of the string
  where
    split :: Int -> (String, String, Int)
split Int
n = case Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n String
s of (String
s1,String
s2) -> (String
s1,String
s2,Int
n)

    --n=length s, nxs= string & screen positions of all characters in the string
    ((Int
n,Int
_),[(Int, Int, Int)]
nxs) = ((Int, Int) -> Int -> ((Int, Int), (Int, Int, Int)))
-> (Int, Int) -> [Int] -> ((Int, Int), [(Int, Int, Int)])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\(Int
n,Int
x) Int
w -> ((Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w),(Int
n,Int
x,Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w))) ((Int
0,Int
0)::(Int,Int)) [Int]
ws

    -- Width of all characters:
    ws :: [Int]
ws = FontStructF (Array Char CharStruct) -> String -> [Int]
poslist FontStructF (Array Char CharStruct)
fs String
s
    

{- old:
    let dist s' = abs (next_pos font s' - x)
        nearer (pre1, _, _) (pre2, _, _) = dist pre1 <= dist pre2
	better x y = if nearer x y then x else y
    in foldr1 better (allsplits s)

--allsplits s = [(take n s, drop n s, n) | n <- [0 .. length s]])
allsplits [] = [([],[],0)]
allsplits xxs@(x:xs) = ([],xxs,0): map (\(xs,ys,n)->(x:xs,ys,n+1)) (allsplits xs)
-}

--------

-- This is a temporary fix until we know how to construct Haskell arrays from C
type FontStructList = FontStructF [CharStruct]
{-
data FontStructList = FontStructList
                             FontId
                             FontDirection
			     Char -- first character
			     Char -- last character
			     Bool -- all chars exist
			     Char -- default char
			     [FontProp]
			     CharStruct -- min bounds
			     CharStruct -- max bounds
			     (Maybe [CharStruct])
			     Int -- logical extent above baseline for spacing
			     Int -- logical extent below baseline for spacing 
                  deriving (Eq, Ord, Show, Read)
-}

--fontl_prop (FontStructList fid fd fc lc all' dc fps minb maxb ca asc de) = fps
fontl_prop :: FontStructF per_char -> [FontProp]
fontl_prop = FontStructF per_char -> [FontProp]
forall per_char. FontStructF per_char -> [FontProp]
font_prop

fsl2fs :: FontStructF [e] -> FontStructF (Array Char e)
fsl2fs (FontStruct FontId
fid FontDirection
fd Char
fc Char
lc Bool
all' Char
dc [FontProp]
fps CharStruct
minb CharStruct
maxb Maybe [e]
optclist Int
asc Int
de) =
    FontId
-> FontDirection
-> Char
-> Char
-> Bool
-> Char
-> [FontProp]
-> CharStruct
-> CharStruct
-> Maybe (Array Char e)
-> Int
-> Int
-> FontStructF (Array Char e)
forall per_char.
FontId
-> FontDirection
-> Char
-> Char
-> Bool
-> Char
-> [FontProp]
-> CharStruct
-> CharStruct
-> Maybe per_char
-> Int
-> Int
-> FontStructF per_char
FontStruct FontId
fid FontDirection
fd Char
fc Char
lc Bool
all' Char
dc [FontProp]
fps CharStruct
minb CharStruct
maxb Maybe (Array Char e)
optca Int
asc Int
de
  where optca :: Maybe (Array Char e)
optca = ([e] -> Array Char e) -> Maybe [e] -> Maybe (Array Char e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [e] -> Array Char e
forall e. [e] -> Array Char e
l2a Maybe [e]
optclist
        l2a :: [e] -> Array Char e
l2a [e]
clist = (Char, Char) -> [(Char, e)] -> Array Char e
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Char
fc, Char
lc) (String -> [e] -> [(Char, e)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
ixs [e]
clist)
	-- !! This assumes single byte font, or 2 byte matrix font.
	-- !! Linear 16-bit fonts will not work.
	-- ! Using a linear array for a 2 byte matrix font wastes space!
	ixs :: String
ixs = [Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
256Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
byte1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
byte2) | Int
byte1<-(Int, Int) -> [Int]
forall a. Ix a => (a, a) -> [a]
range (Int
min_byte1,Int
max_byte1),
	                         Int
byte2<-(Int, Int) -> [Int]
forall a. Ix a => (a, a) -> [a]
range (Int
min_byte2,Int
max_byte2)]
	(Int
min_byte1,Int
min_byte2) = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
fc Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
256
	(Int
max_byte1,Int
max_byte2) = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
lc Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
256
{-
-- hack to circumvent limitation in generational garbage collector

data Array a b = Arr (a,a) (LA.Array Int (LA.Array Int b))
	deriving (Eq,Ord,Show,Read)

array :: (Ix a, Enum a) => (a,a) -> [(a,b)] -> Array a b
array bds l = Arr bds (LA.listArray (0,dix b2i-dix b1i)
                       [LA.array rng (filter (inRange rng.fst) (mapFst fromEnum l))
                        | offs <- [b1i,b1i+maxsize..b2i],
			  rng <- [(offs,(offs+maxsize-1) `min` b2i)]])
  where (b1i,b2i) = aboth fromEnum bds

(!) :: (Ix a, Enum a) => Array a b -> a -> b
(!) (Arr (b1,b2) a) i = (a `LA.sub` dix (ii-fromEnum b1)) `LA.sub` ii where ii = fromEnum i

bounds :: (Ix a, Enum a) => Array a b -> (a,a)
bounds (Arr bds a) = bds

maxsize = 255
dix i = i `div` maxsize
-}