module LoadFont(loadQueryFont, queryFont, loadFont, loadQueryFontF, 
                queryFontF, loadFontF,safeLoadQueryFont, safeLoadQueryFontF,
                listFonts,listFontsF,listFontsWithInfo,tryLoadFont) where
import Command(XRequest(..))
import Event
import Font(fsl2fs) --FontStruct,FontStructList,
--import Fudget
--import Geometry(Line, Point, Rect, Size(..))
--import EitherUtils(stripMaybe,mapMaybe)
import Data.Maybe(fromJust)
import HbcUtils(mapSnd)
import Cont(tryM)
import Xrequest
import Xtypes

lf :: (XRequest -> (XResponse -> Maybe FontId) -> t) -> FontName -> t
lf XRequest -> (XResponse -> Maybe FontId) -> t
k FontName
fontname =
    let cmd :: XRequest
cmd = FontName -> XRequest
LoadFont FontName
fontname
        expected :: XResponse -> Maybe FontId
expected (FontLoaded FontId
fid) = forall a. a -> Maybe a
Just FontId
fid
        expected XResponse
_ = forall a. Maybe a
Nothing
    in XRequest -> (XResponse -> Maybe FontId) -> t
k XRequest
cmd XResponse -> Maybe FontId
expected

loadFont :: FontName -> (FontId -> f hi ho) -> f hi ho
loadFont FontName
x = forall {t}.
(XRequest -> (XResponse -> Maybe FontId) -> t) -> FontName -> t
lf forall {f :: * -> * -> *} {ans} {hi} {ho}.
FudgetIO f =>
XRequest -> (XResponse -> Maybe ans) -> (ans -> f hi ho) -> f hi ho
xrequest FontName
x
loadFontF :: FontName -> Cont (F b c) FontId
loadFontF = forall {t}.
(XRequest -> (XResponse -> Maybe FontId) -> t) -> FontName -> t
lf forall {a} {b} {c}.
XRequest -> (XResponse -> Maybe a) -> Cont (F b c) a
xrequestF

qf :: (XRequest
 -> (XResponse -> Maybe (FontStructF (Array Char CharStruct))) -> t)
-> FontId -> t
qf XRequest
-> (XResponse -> Maybe (FontStructF (Array Char CharStruct))) -> t
k FontId
fid =
    let cmd :: XRequest
cmd = FontId -> XRequest
QueryFont FontId
fid
        expected :: XResponse -> Maybe (FontStructF (Array Char CharStruct))
expected (FontQueried Maybe FontStructList
fs) = forall a. a -> Maybe a
Just (forall {e}. FontStructF [e] -> FontStructF (Array Char e)
fsl2fs (forall a. HasCallStack => Maybe a -> a
fromJust Maybe FontStructList
fs))
        expected XResponse
_ = forall a. Maybe a
Nothing
    in  XRequest
-> (XResponse -> Maybe (FontStructF (Array Char CharStruct))) -> t
k XRequest
cmd XResponse -> Maybe (FontStructF (Array Char CharStruct))
expected

queryFont :: FontId
-> (FontStructF (Array Char CharStruct) -> f hi ho) -> f hi ho
queryFont FontId
x = forall {t}.
(XRequest
 -> (XResponse -> Maybe (FontStructF (Array Char CharStruct))) -> t)
-> FontId -> t
qf forall {f :: * -> * -> *} {ans} {hi} {ho}.
FudgetIO f =>
XRequest -> (XResponse -> Maybe ans) -> (ans -> f hi ho) -> f hi ho
xrequest FontId
x
queryFontF :: FontId -> Cont (F b c) (FontStructF (Array Char CharStruct))
queryFontF = forall {t}.
(XRequest
 -> (XResponse -> Maybe (FontStructF (Array Char CharStruct))) -> t)
-> FontId -> t
qf forall {a} {b} {c}.
XRequest -> (XResponse -> Maybe a) -> Cont (F b c) a
xrequestF

lqf :: (XRequest
 -> (XResponse
     -> Maybe (Maybe (FontStructF (Array Char CharStruct))))
 -> t)
-> FontName -> t
lqf XRequest
-> (XResponse
    -> Maybe (Maybe (FontStructF (Array Char CharStruct))))
-> t
k FontName
fontname =
    let cmd :: XRequest
cmd = FontName -> XRequest
LoadQueryFont FontName
fontname
        expected :: XResponse -> Maybe (Maybe (FontStructF (Array Char CharStruct)))
expected (FontQueried Maybe FontStructList
optfs) = forall a. a -> Maybe a
Just (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {e}. FontStructF [e] -> FontStructF (Array Char e)
fsl2fs Maybe FontStructList
optfs)
        expected XResponse
_ = forall a. Maybe a
Nothing
    in  XRequest
-> (XResponse
    -> Maybe (Maybe (FontStructF (Array Char CharStruct))))
-> t
k XRequest
cmd XResponse -> Maybe (Maybe (FontStructF (Array Char CharStruct)))
expected

loadQueryFont :: FontName
-> (Maybe (FontStructF (Array Char CharStruct)) -> f hi ho)
-> f hi ho
loadQueryFont FontName
x = forall {t}.
(XRequest
 -> (XResponse
     -> Maybe (Maybe (FontStructF (Array Char CharStruct))))
 -> t)
-> FontName -> t
lqf forall {f :: * -> * -> *} {ans} {hi} {ho}.
FudgetIO f =>
XRequest -> (XResponse -> Maybe ans) -> (ans -> f hi ho) -> f hi ho
xrequest FontName
x
loadQueryFontF :: FontName
-> Cont (F b c) (Maybe (FontStructF (Array Char CharStruct)))
loadQueryFontF = forall {t}.
(XRequest
 -> (XResponse
     -> Maybe (Maybe (FontStructF (Array Char CharStruct))))
 -> t)
-> FontName -> t
lqf forall {a} {b} {c}.
XRequest -> (XResponse -> Maybe a) -> Cont (F b c) a
xrequestF

safeLqf :: (FontName -> Cont c (Maybe t)) -> FontName -> (t -> c) -> c
safeLqf FontName -> Cont c (Maybe t)
lqf FontName
fn t -> c
k =
  forall c a. Cont c (Maybe a) -> c -> Cont c a
tryM (FontName -> Cont c (Maybe t)
lqf FontName
fn)
       (FontName -> Cont c (Maybe t)
lqf (FontName
"fixed"::FontName) forall a b. (a -> b) -> a -> b
$ \ (Just t
fs) -> t -> c
k t
fs)
       t -> c
k

safeLoadQueryFont :: FontName
-> (FontStructF (Array Char CharStruct) -> f hi ho) -> f hi ho
safeLoadQueryFont FontName
x = forall {c} {t}.
(FontName -> Cont c (Maybe t)) -> FontName -> (t -> c) -> c
safeLqf forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FontName
-> (Maybe (FontStructF (Array Char CharStruct)) -> f hi ho)
-> f hi ho
loadQueryFont FontName
x
safeLoadQueryFontF :: FontName -> (FontStructF (Array Char CharStruct) -> F b c) -> F b c
safeLoadQueryFontF = forall {c} {t}.
(FontName -> Cont c (Maybe t)) -> FontName -> (t -> c) -> c
safeLqf forall {b} {c}.
FontName
-> Cont (F b c) (Maybe (FontStructF (Array Char CharStruct)))
loadQueryFontF

lif :: (XRequest -> (XResponse -> Maybe [FontName]) -> t)
-> FontName -> Int -> t
lif XRequest -> (XResponse -> Maybe [FontName]) -> t
k FontName
pattern Int
maxnames =
    let cmd :: XRequest
cmd = FontName -> Int -> XRequest
ListFonts FontName
pattern Int
maxnames
        expected :: XResponse -> Maybe [FontName]
expected (GotFontList [FontName]
fns) = forall a. a -> Maybe a
Just [FontName]
fns
	expected XResponse
_ = forall a. Maybe a
Nothing
    in XRequest -> (XResponse -> Maybe [FontName]) -> t
k XRequest
cmd XResponse -> Maybe [FontName]
expected

listFonts :: FontName -> Int -> ([FontName] -> f hi ho) -> f hi ho
listFonts FontName
x = forall {t}.
(XRequest -> (XResponse -> Maybe [FontName]) -> t)
-> FontName -> Int -> t
lif forall {f :: * -> * -> *} {ans} {hi} {ho}.
FudgetIO f =>
XRequest -> (XResponse -> Maybe ans) -> (ans -> f hi ho) -> f hi ho
xrequest FontName
x
listFontsF :: FontName -> Int -> Cont (F b c) [FontName]
listFontsF = forall {t}.
(XRequest -> (XResponse -> Maybe [FontName]) -> t)
-> FontName -> Int -> t
lif forall {a} {b} {c}.
XRequest -> (XResponse -> Maybe a) -> Cont (F b c) a
xrequestF

listFontsWithInfo :: FontName
-> Int
-> ([(FontName, FontStructF (Array Char CharStruct))] -> f hi ho)
-> f hi ho
listFontsWithInfo FontName
pattern Int
maxnames =
    let cmd :: XRequest
cmd = FontName -> Int -> XRequest
ListFontsWithInfo FontName
pattern Int
maxnames
        expected :: XResponse
-> Maybe [(FontName, FontStructF (Array Char CharStruct))]
expected (GotFontListWithInfo [(FontName, FontStructList)]
fis) = forall a. a -> Maybe a
Just (forall {t} {b} {a}. (t -> b) -> [(a, t)] -> [(a, b)]
mapSnd forall {e}. FontStructF [e] -> FontStructF (Array Char e)
fsl2fs [(FontName, FontStructList)]
fis)
--      expected (GotFontListWithInfo fis) = Just (map ((,) pattern . fsl2fs) fis)
	expected XResponse
_ = forall a. Maybe a
Nothing
    in forall {f :: * -> * -> *} {ans} {hi} {ho}.
FudgetIO f =>
XRequest -> (XResponse -> Maybe ans) -> (ans -> f hi ho) -> f hi ho
xrequest XRequest
cmd XResponse
-> Maybe [(FontName, FontStructF (Array Char CharStruct))]
expected

-- Since loadFont succeeds and returns a FontId even if the font doesn't exist:
tryLoadFont :: FontName -> (Maybe FontId -> f hi ho) -> f hi ho
tryLoadFont FontName
fn Maybe FontId -> f hi ho
k =
  forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FontName -> Int -> ([FontName] -> f hi ho) -> f hi ho
listFonts FontName
fn Int
1 forall a b. (a -> b) -> a -> b
$ \ [FontName]
fns ->
  case [FontName]
fns of
    FontName
fn:[FontName]
_ -> forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FontName -> (FontId -> f hi ho) -> f hi ho
loadFont FontName
fn (Maybe FontId -> f hi ho
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
    [FontName]
_ -> Maybe FontId -> f hi ho
k forall a. Maybe a
Nothing