{-# LINE 1 "Graphics/X11/Xlib/Font.hsc" #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Graphics.X11.Xlib.Font(
Glyph,
queryFont,
fontFromGC,
loadQueryFont,
freeFont,
FontStruct,
fontFromFontStruct,
ascentFromFontStruct,
descentFromFontStruct,
minBoundsFromFontStruct,
maxBoundsFromFontStruct,
CharStruct,
textExtents,
textWidth,
) where
import Graphics.X11.Types
import Graphics.X11.Xlib.Types
import Foreign (Ptr, Int32, alloca, allocaBytes, peekByteOff, Word16, Word64, peek, plusPtr, throwIfNull)
{-# LINE 41 "Graphics/X11/Xlib/Font.hsc" #-}
import Foreign.C
import System.IO.Unsafe
{-# LINE 46 "Graphics/X11/Xlib/Font.hsc" #-}
import Data.Data
{-# LINE 48 "Graphics/X11/Xlib/Font.hsc" #-}
type Glyph = Word16
newtype FontStruct = FontStruct (Ptr FontStruct)
{-# LINE 60 "Graphics/X11/Xlib/Font.hsc" #-}
deriving (FontStruct -> FontStruct -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontStruct -> FontStruct -> Bool
$c/= :: FontStruct -> FontStruct -> Bool
== :: FontStruct -> FontStruct -> Bool
$c== :: FontStruct -> FontStruct -> Bool
Eq, Eq FontStruct
FontStruct -> FontStruct -> Bool
FontStruct -> FontStruct -> Ordering
FontStruct -> FontStruct -> FontStruct
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 :: FontStruct -> FontStruct -> FontStruct
$cmin :: FontStruct -> FontStruct -> FontStruct
max :: FontStruct -> FontStruct -> FontStruct
$cmax :: FontStruct -> FontStruct -> FontStruct
>= :: FontStruct -> FontStruct -> Bool
$c>= :: FontStruct -> FontStruct -> Bool
> :: FontStruct -> FontStruct -> Bool
$c> :: FontStruct -> FontStruct -> Bool
<= :: FontStruct -> FontStruct -> Bool
$c<= :: FontStruct -> FontStruct -> Bool
< :: FontStruct -> FontStruct -> Bool
$c< :: FontStruct -> FontStruct -> Bool
compare :: FontStruct -> FontStruct -> Ordering
$ccompare :: FontStruct -> FontStruct -> Ordering
Ord, Int -> FontStruct -> ShowS
[FontStruct] -> ShowS
FontStruct -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontStruct] -> ShowS
$cshowList :: [FontStruct] -> ShowS
show :: FontStruct -> String
$cshow :: FontStruct -> String
showsPrec :: Int -> FontStruct -> ShowS
$cshowsPrec :: Int -> FontStruct -> ShowS
Show, Typeable, Typeable FontStruct
FontStruct -> DataType
FontStruct -> Constr
(forall b. Data b => b -> b) -> FontStruct -> FontStruct
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FontStruct -> u
forall u. (forall d. Data d => d -> u) -> FontStruct -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FontStruct -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FontStruct -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FontStruct -> m FontStruct
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FontStruct -> m FontStruct
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FontStruct
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FontStruct -> c FontStruct
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FontStruct)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FontStruct)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FontStruct -> m FontStruct
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FontStruct -> m FontStruct
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FontStruct -> m FontStruct
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FontStruct -> m FontStruct
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FontStruct -> m FontStruct
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FontStruct -> m FontStruct
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FontStruct -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FontStruct -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FontStruct -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FontStruct -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FontStruct -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FontStruct -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FontStruct -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FontStruct -> r
gmapT :: (forall b. Data b => b -> b) -> FontStruct -> FontStruct
$cgmapT :: (forall b. Data b => b -> b) -> FontStruct -> FontStruct
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FontStruct)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FontStruct)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FontStruct)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FontStruct)
dataTypeOf :: FontStruct -> DataType
$cdataTypeOf :: FontStruct -> DataType
toConstr :: FontStruct -> Constr
$ctoConstr :: FontStruct -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FontStruct
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FontStruct
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FontStruct -> c FontStruct
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FontStruct -> c FontStruct
Data)
{-# LINE 64 "Graphics/X11/Xlib/Font.hsc" #-}
foreign import ccall unsafe "HsXlib.h XQueryFont"
queryFont :: Display -> Font -> IO FontStruct
fontFromGC :: Display -> GC -> IO Font
fontFromGC :: Display -> GC -> IO Font
fontFromGC Display
display GC
gc =
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
128) forall a b. (a -> b) -> a -> b
$ \ Ptr GCValues
values -> do
{-# LINE 85 "Graphics/X11/Xlib/Font.hsc" #-}
String -> IO CInt -> IO ()
throwIfZero String
"fontFromGC" forall a b. (a -> b) -> a -> b
$
Display -> GC -> Font -> Ptr GCValues -> IO CInt
xGetGCValues Display
display GC
gc Font
16384 Ptr GCValues
values
{-# LINE 87 "Graphics/X11/Xlib/Font.hsc" #-}
(\Ptr GCValues
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GCValues
hsc_ptr Int
88) Ptr GCValues
values
{-# LINE 88 "Graphics/X11/Xlib/Font.hsc" #-}
foreign import ccall unsafe "HsXlib.h XGetGCValues"
xGetGCValues :: Display -> GC -> ValueMask -> Ptr GCValues -> IO CInt
type ValueMask = Word64
{-# LINE 92 "Graphics/X11/Xlib/Font.hsc" #-}
loadQueryFont :: Display -> String -> IO FontStruct
loadQueryFont :: Display -> String -> IO FontStruct
loadQueryFont Display
display String
name =
forall a. String -> (CString -> IO a) -> IO a
withCString String
name forall a b. (a -> b) -> a -> b
$ \ CString
c_name -> do
Ptr FontStruct
fs <- forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwIfNull String
"loadQueryFont" forall a b. (a -> b) -> a -> b
$ Display -> CString -> IO (Ptr FontStruct)
xLoadQueryFont Display
display CString
c_name
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr FontStruct -> FontStruct
FontStruct Ptr FontStruct
fs)
foreign import ccall unsafe "HsXlib.h XLoadQueryFont"
xLoadQueryFont :: Display -> CString -> IO (Ptr FontStruct)
foreign import ccall unsafe "HsXlib.h XFreeFont"
freeFont :: Display -> FontStruct -> IO ()
fontFromFontStruct :: FontStruct -> Font
fontFromFontStruct :: FontStruct -> Font
fontFromFontStruct (FontStruct Ptr FontStruct
fs) = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
(\Ptr FontStruct
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr FontStruct
hsc_ptr Int
8) Ptr FontStruct
fs
{-# LINE 110 "Graphics/X11/Xlib/Font.hsc" #-}
ascentFromFontStruct :: FontStruct -> Int32
ascentFromFontStruct :: FontStruct -> Int32
ascentFromFontStruct (FontStruct Ptr FontStruct
fs) = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
(\Ptr FontStruct
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr FontStruct
hsc_ptr Int
88) Ptr FontStruct
fs
{-# LINE 114 "Graphics/X11/Xlib/Font.hsc" #-}
descentFromFontStruct :: FontStruct -> Int32
descentFromFontStruct :: FontStruct -> Int32
descentFromFontStruct (FontStruct Ptr FontStruct
fs) = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
(\Ptr FontStruct
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr FontStruct
hsc_ptr Int
92) Ptr FontStruct
fs
{-# LINE 118 "Graphics/X11/Xlib/Font.hsc" #-}
minBoundsFromFontStruct :: FontStruct -> CharStruct
minBoundsFromFontStruct :: FontStruct -> CharStruct
minBoundsFromFontStruct (FontStruct Ptr FontStruct
fs) = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
Ptr CharStruct -> IO CharStruct
peekCharStruct forall a b. (a -> b) -> a -> b
$ (\Ptr FontStruct
hsc_ptr -> Ptr FontStruct
hsc_ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) Ptr FontStruct
fs
{-# LINE 122 "Graphics/X11/Xlib/Font.hsc" #-}
maxBoundsFromFontStruct :: FontStruct -> CharStruct
maxBoundsFromFontStruct :: FontStruct -> CharStruct
maxBoundsFromFontStruct (FontStruct Ptr FontStruct
fs) = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
Ptr CharStruct -> IO CharStruct
peekCharStruct forall a b. (a -> b) -> a -> b
$ (\Ptr FontStruct
hsc_ptr -> Ptr FontStruct
hsc_ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
68) Ptr FontStruct
fs
{-# LINE 126 "Graphics/X11/Xlib/Font.hsc" #-}
type CharStruct =
( CInt
, CInt
, CInt
, CInt
, CInt
)
peekCharStruct :: Ptr CharStruct -> IO CharStruct
peekCharStruct :: Ptr CharStruct -> IO CharStruct
peekCharStruct Ptr CharStruct
p = do
CShort
lbearing <- (\Ptr CharStruct
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CharStruct
hsc_ptr Int
0) Ptr CharStruct
p
{-# LINE 159 "Graphics/X11/Xlib/Font.hsc" #-}
CShort
rbearing <- (\Ptr CharStruct
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CharStruct
hsc_ptr Int
2) Ptr CharStruct
p
{-# LINE 160 "Graphics/X11/Xlib/Font.hsc" #-}
CShort
width <- (\Ptr CharStruct
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CharStruct
hsc_ptr Int
4) Ptr CharStruct
p
{-# LINE 161 "Graphics/X11/Xlib/Font.hsc" #-}
CShort
ascent <- (\Ptr CharStruct
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CharStruct
hsc_ptr Int
6) Ptr CharStruct
p
{-# LINE 162 "Graphics/X11/Xlib/Font.hsc" #-}
CShort
descent <- (\Ptr CharStruct
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CharStruct
hsc_ptr Int
8) Ptr CharStruct
p
{-# LINE 163 "Graphics/X11/Xlib/Font.hsc" #-}
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort
lbearing::CShort),
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort
rbearing::CShort),
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort
width::CShort),
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort
ascent::CShort),
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CShort
descent::CShort))
textExtents :: FontStruct -> String -> (FontDirection, Int32, Int32, CharStruct)
textExtents :: FontStruct -> String -> (CInt, Int32, Int32, CharStruct)
textExtents FontStruct
font_struct String
string = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
string forall a b. (a -> b) -> a -> b
$ \ (CString
c_string, Int
nchars) ->
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \ Ptr CInt
direction_return ->
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \ Ptr Int32
font_ascent_return ->
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \ Ptr Int32
font_descent_return ->
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
12) forall a b. (a -> b) -> a -> b
$ \ Ptr CharStruct
overall_return -> do
{-# LINE 179 "Graphics/X11/Xlib/Font.hsc" #-}
_ <- xTextExtents font_struct c_string (fromIntegral nchars) direction_return
font_ascent_return font_descent_return overall_return
direction <- peek direction_return
ascent <- peek font_ascent_return
descent <- peek font_descent_return
cs <- peekCharStruct overall_return
return (direction, ascent, descent, cs)
foreign import ccall unsafe "HsXlib.h XTextExtents"
xTextExtents :: FontStruct -> CString -> CInt ->
Ptr FontDirection -> Ptr Int32 -> Ptr Int32 ->
Ptr CharStruct -> IO CInt
textWidth :: FontStruct -> String -> Int32
textWidth :: FontStruct -> String -> Int32
textWidth FontStruct
font_struct String
string = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
string forall a b. (a -> b) -> a -> b
$ \ (CString
c_string, Int
len) ->
FontStruct -> CString -> CInt -> IO Int32
xTextWidth FontStruct
font_struct CString
c_string (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
foreign import ccall unsafe "HsXlib.h XTextWidth"
xTextWidth :: FontStruct -> CString -> CInt -> IO Int32