module TextExtents where
import Xrequest(xrequest)
import Command
import Event

queryTextExtents16K :: FontId -> [Char] -> (Int -> Int -> CharStruct -> f b ho) -> f b ho
queryTextExtents16K FontId
fid [Char]
str Int -> Int -> CharStruct -> f b ho
k =
    XRequest
-> (XResponse -> Maybe (Int, Int, CharStruct))
-> ((Int, Int, 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 (Int, Int, CharStruct)
expected (((Int, Int, CharStruct) -> f b ho) -> f b ho)
-> ((Int, Int, CharStruct) -> f b ho) -> f b ho
forall a b. (a -> b) -> a -> b
$ \ (Int
a,Int
d,CharStruct
cs) -> Int -> Int -> CharStruct -> f b ho
k Int
a Int
d CharStruct
cs
  where
    cmd :: XRequest
cmd = FontId -> [Char] -> XRequest
QueryTextExtents16 FontId
fid [Char]
str

    expected :: XResponse -> Maybe (Int, Int, CharStruct)
expected (TextExtents16Queried Int
a Int
d CharStruct
cs) = (Int, Int, CharStruct) -> Maybe (Int, Int, CharStruct)
forall a. a -> Maybe a
Just (Int
a,Int
d,CharStruct
cs)
    expected XResponse
_ = Maybe (Int, Int, CharStruct)
forall a. Maybe a
Nothing