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) -> [Char] -> t
lf XRequest -> (XResponse -> Maybe FontId) -> t
k [Char]
fontname =
    let cmd :: XRequest
cmd = [Char] -> XRequest
LoadFont [Char]
fontname
        expected :: XResponse -> Maybe FontId
expected (FontLoaded FontId
fid) = FontId -> Maybe FontId
forall a. a -> Maybe a
Just FontId
fid
        expected XResponse
_ = Maybe FontId
forall a. Maybe a
Nothing
    in XRequest -> (XResponse -> Maybe FontId) -> t
k XRequest
cmd XResponse -> Maybe FontId
expected

loadFont :: [Char] -> (FontId -> f b ho) -> f b ho
loadFont [Char]
x = (XRequest
 -> (XResponse -> Maybe FontId) -> (FontId -> f b ho) -> f b ho)
-> [Char] -> (FontId -> f b ho) -> f b ho
forall t.
(XRequest -> (XResponse -> Maybe FontId) -> t) -> [Char] -> t
lf XRequest
-> (XResponse -> Maybe FontId) -> (FontId -> f b ho) -> f b ho
forall (f :: * -> * -> *) ans b ho.
FudgetIO f =>
XRequest -> (XResponse -> Maybe ans) -> (ans -> f b ho) -> f b ho
xrequest [Char]
x
loadFontF :: [Char] -> Cont (F b c) FontId
loadFontF = (XRequest -> (XResponse -> Maybe FontId) -> Cont (F b c) FontId)
-> [Char] -> Cont (F b c) FontId
forall t.
(XRequest -> (XResponse -> Maybe FontId) -> t) -> [Char] -> t
lf XRequest -> (XResponse -> Maybe FontId) -> Cont (F b c) FontId
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) = FontStructF (Array Char CharStruct)
-> Maybe (FontStructF (Array Char CharStruct))
forall a. a -> Maybe a
Just (FontStructList -> FontStructF (Array Char CharStruct)
forall e. FontStructF [e] -> FontStructF (Array Char e)
fsl2fs (Maybe FontStructList -> FontStructList
forall a. HasCallStack => Maybe a -> a
fromJust Maybe FontStructList
fs))
        expected XResponse
_ = Maybe (FontStructF (Array Char CharStruct))
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 b ho) -> f b ho
queryFont FontId
x = (XRequest
 -> (XResponse -> Maybe (FontStructF (Array Char CharStruct)))
 -> (FontStructF (Array Char CharStruct) -> f b ho)
 -> f b ho)
-> FontId
-> (FontStructF (Array Char CharStruct) -> f b ho)
-> f b ho
forall t.
(XRequest
 -> (XResponse -> Maybe (FontStructF (Array Char CharStruct))) -> t)
-> FontId -> t
qf XRequest
-> (XResponse -> Maybe (FontStructF (Array Char CharStruct)))
-> (FontStructF (Array Char CharStruct) -> f b ho)
-> f b ho
forall (f :: * -> * -> *) ans b ho.
FudgetIO f =>
XRequest -> (XResponse -> Maybe ans) -> (ans -> f b ho) -> f b ho
xrequest FontId
x
queryFontF :: FontId -> Cont (F b c) (FontStructF (Array Char CharStruct))
queryFontF = (XRequest
 -> (XResponse -> Maybe (FontStructF (Array Char CharStruct)))
 -> Cont (F b c) (FontStructF (Array Char CharStruct)))
-> FontId -> Cont (F b c) (FontStructF (Array Char CharStruct))
forall t.
(XRequest
 -> (XResponse -> Maybe (FontStructF (Array Char CharStruct))) -> t)
-> FontId -> t
qf XRequest
-> (XResponse -> Maybe (FontStructF (Array Char CharStruct)))
-> Cont (F b c) (FontStructF (Array Char CharStruct))
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (F b c) a
xrequestF

lqf :: (XRequest
 -> (XResponse
     -> Maybe (Maybe (FontStructF (Array Char CharStruct))))
 -> t)
-> [Char] -> t
lqf XRequest
-> (XResponse
    -> Maybe (Maybe (FontStructF (Array Char CharStruct))))
-> t
k [Char]
fontname =
    let cmd :: XRequest
cmd = [Char] -> XRequest
LoadQueryFont [Char]
fontname
        expected :: XResponse -> Maybe (Maybe (FontStructF (Array Char CharStruct)))
expected (FontQueried Maybe FontStructList
optfs) = Maybe (FontStructF (Array Char CharStruct))
-> Maybe (Maybe (FontStructF (Array Char CharStruct)))
forall a. a -> Maybe a
Just ((FontStructList -> FontStructF (Array Char CharStruct))
-> Maybe FontStructList
-> Maybe (FontStructF (Array Char CharStruct))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FontStructList -> FontStructF (Array Char CharStruct)
forall e. FontStructF [e] -> FontStructF (Array Char e)
fsl2fs Maybe FontStructList
optfs)
        expected XResponse
_ = Maybe (Maybe (FontStructF (Array Char CharStruct)))
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 :: [Char]
-> (Maybe (FontStructF (Array Char CharStruct)) -> f b ho)
-> f b ho
loadQueryFont [Char]
x = (XRequest
 -> (XResponse
     -> Maybe (Maybe (FontStructF (Array Char CharStruct))))
 -> (Maybe (FontStructF (Array Char CharStruct)) -> f b ho)
 -> f b ho)
-> [Char]
-> (Maybe (FontStructF (Array Char CharStruct)) -> f b ho)
-> f b ho
forall t.
(XRequest
 -> (XResponse
     -> Maybe (Maybe (FontStructF (Array Char CharStruct))))
 -> t)
-> [Char] -> t
lqf XRequest
-> (XResponse
    -> Maybe (Maybe (FontStructF (Array Char CharStruct))))
-> (Maybe (FontStructF (Array Char CharStruct)) -> f b ho)
-> f b ho
forall (f :: * -> * -> *) ans b ho.
FudgetIO f =>
XRequest -> (XResponse -> Maybe ans) -> (ans -> f b ho) -> f b ho
xrequest [Char]
x
loadQueryFontF :: [Char]
-> Cont (F b c) (Maybe (FontStructF (Array Char CharStruct)))
loadQueryFontF = (XRequest
 -> (XResponse
     -> Maybe (Maybe (FontStructF (Array Char CharStruct))))
 -> Cont (F b c) (Maybe (FontStructF (Array Char CharStruct))))
-> [Char]
-> Cont (F b c) (Maybe (FontStructF (Array Char CharStruct)))
forall t.
(XRequest
 -> (XResponse
     -> Maybe (Maybe (FontStructF (Array Char CharStruct))))
 -> t)
-> [Char] -> t
lqf XRequest
-> (XResponse
    -> Maybe (Maybe (FontStructF (Array Char CharStruct))))
-> Cont (F b c) (Maybe (FontStructF (Array Char CharStruct)))
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (F b c) a
xrequestF

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

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

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

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

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

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