{-# LINE 2 "./Graphics/UI/Gtk/Gdk/GC.chs" #-}
module Graphics.UI.Gtk.Gdk.GC (
GC,
GCClass,
castToGC, gTypeGC,
gcNew,
GCValues(GCValues),
newGCValues,
Color(..),
foreground,
background,
Function(..),
function,
Fill(..),
fill,
tile,
stipple,
clipMask,
SubwindowMode(..),
subwindowMode,
tsXOrigin,
tsYOrigin,
clipXOrigin,
clipYOrigin,
graphicsExposure,
lineWidth,
LineStyle(..),
lineStyle,
CapStyle(..),
capStyle,
JoinStyle(..),
joinStyle,
gcNewWithValues,
gcSetValues,
gcGetValues,
gcSetClipRectangle,
gcSetClipRegion,
gcSetDashes
) where
import Control.Monad (when)
import Data.Maybe (fromJust, isJust)
import Control.Exception (handle, ErrorCall(..))
import System.Glib.FFI
import Graphics.UI.Gtk.Types
{-# LINE 91 "./Graphics/UI/Gtk/Gdk/GC.chs" #-}
import Graphics.UI.Gtk.General.Structs
import Graphics.UI.Gtk.General.Enums (Function(..), Fill(..), SubwindowMode(..), LineStyle(..),
CapStyle(..), JoinStyle(..))
import Graphics.UI.Gtk.Gdk.Region (Region(Region))
{-# LINE 99 "./Graphics/UI/Gtk/Gdk/GC.chs" #-}
gcNew :: DrawableClass d => d -> IO GC
gcNew :: forall d. DrawableClass d => d -> IO GC
gcNew d
d = do
Ptr GC
gcPtr <- (\(Drawable ForeignPtr Drawable
arg1) -> ForeignPtr Drawable -> (Ptr Drawable -> IO (Ptr GC)) -> IO (Ptr GC)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Drawable
arg1 ((Ptr Drawable -> IO (Ptr GC)) -> IO (Ptr GC))
-> (Ptr Drawable -> IO (Ptr GC)) -> IO (Ptr GC)
forall a b. (a -> b) -> a -> b
$ \Ptr Drawable
argPtr1 ->Ptr Drawable -> IO (Ptr GC)
gdk_gc_new Ptr Drawable
argPtr1) (d -> Drawable
forall o. DrawableClass o => o -> Drawable
toDrawable d
d)
if (Ptr GC
gcPtrPtr GC -> Ptr GC -> Bool
forall a. Eq a => a -> a -> Bool
==Ptr GC
forall a. Ptr a
nullPtr) then GC -> IO GC
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> GC
forall a. HasCallStack => [Char] -> a
error [Char]
"gcNew: null graphics context.")
else (ForeignPtr GC -> GC, FinalizerPtr GC) -> IO (Ptr GC) -> IO GC
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr GC -> GC, FinalizerPtr GC)
forall {a}. (ForeignPtr GC -> GC, FinalizerPtr a)
mkGC (Ptr GC -> IO (Ptr GC)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GC
gcPtr)
gcNewWithValues :: DrawableClass d => d -> GCValues -> IO GC
gcNewWithValues :: forall d. DrawableClass d => d -> GCValues -> IO GC
gcNewWithValues d
d GCValues
gcv = Int -> (Ptr GCValues -> IO GC) -> IO GC
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (GCValues -> Int
forall a. Storable a => a -> Int
sizeOf GCValues
gcv) ((Ptr GCValues -> IO GC) -> IO GC)
-> (Ptr GCValues -> IO GC) -> IO GC
forall a b. (a -> b) -> a -> b
$ \Ptr GCValues
vPtr -> do
CInt
mask <- Ptr GCValues -> GCValues -> IO CInt
pokeGCValues Ptr GCValues
vPtr GCValues
gcv
GC
gc <- (ForeignPtr GC -> GC, FinalizerPtr GC) -> IO (Ptr GC) -> IO GC
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (ForeignPtr GC -> GC, FinalizerPtr GC)
forall {a}. (ForeignPtr GC -> GC, FinalizerPtr a)
mkGC (IO (Ptr GC) -> IO GC) -> IO (Ptr GC) -> IO GC
forall a b. (a -> b) -> a -> b
$ (\(Drawable ForeignPtr Drawable
arg1) Ptr ()
arg2 CInt
arg3 -> ForeignPtr Drawable -> (Ptr Drawable -> IO (Ptr GC)) -> IO (Ptr GC)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Drawable
arg1 ((Ptr Drawable -> IO (Ptr GC)) -> IO (Ptr GC))
-> (Ptr Drawable -> IO (Ptr GC)) -> IO (Ptr GC)
forall a b. (a -> b) -> a -> b
$ \Ptr Drawable
argPtr1 ->Ptr Drawable -> Ptr () -> CInt -> IO (Ptr GC)
gdk_gc_new_with_values Ptr Drawable
argPtr1 Ptr ()
arg2 CInt
arg3)
{-# LINE 115 "./Graphics/UI/Gtk/Gdk/GC.chs" #-}
(toDrawable d) (Ptr GCValues -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr GCValues
vPtr) CInt
mask
(ErrorCall -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(ErrorCall [Char]
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Pixmap -> Bool
forall a. Maybe a -> Bool
isJust (GCValues -> Maybe Pixmap
tile GCValues
gcv)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
ForeignPtr Pixmap -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ((Pixmap -> ForeignPtr Pixmap
unPixmap(Pixmap -> ForeignPtr Pixmap)
-> (GCValues -> Pixmap) -> GCValues -> ForeignPtr Pixmap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Maybe Pixmap -> Pixmap
forall a. HasCallStack => Maybe a -> a
fromJust(Maybe Pixmap -> Pixmap)
-> (GCValues -> Maybe Pixmap) -> GCValues -> Pixmap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.GCValues -> Maybe Pixmap
tile) GCValues
gcv)
(ErrorCall -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(ErrorCall [Char]
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Pixmap -> Bool
forall a. Maybe a -> Bool
isJust (GCValues -> Maybe Pixmap
stipple GCValues
gcv)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
ForeignPtr Pixmap -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ((Pixmap -> ForeignPtr Pixmap
unPixmap(Pixmap -> ForeignPtr Pixmap)
-> (GCValues -> Pixmap) -> GCValues -> ForeignPtr Pixmap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Maybe Pixmap -> Pixmap
forall a. HasCallStack => Maybe a -> a
fromJust(Maybe Pixmap -> Pixmap)
-> (GCValues -> Maybe Pixmap) -> GCValues -> Pixmap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.GCValues -> Maybe Pixmap
stipple) GCValues
gcv)
(ErrorCall -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(ErrorCall [Char]
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Pixmap -> Bool
forall a. Maybe a -> Bool
isJust (GCValues -> Maybe Pixmap
clipMask GCValues
gcv)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
ForeignPtr Pixmap -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ((Pixmap -> ForeignPtr Pixmap
unPixmap(Pixmap -> ForeignPtr Pixmap)
-> (GCValues -> Pixmap) -> GCValues -> ForeignPtr Pixmap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Maybe Pixmap -> Pixmap
forall a. HasCallStack => Maybe a -> a
fromJust(Maybe Pixmap -> Pixmap)
-> (GCValues -> Maybe Pixmap) -> GCValues -> Pixmap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.GCValues -> Maybe Pixmap
clipMask) GCValues
gcv)
GC -> IO GC
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GC
gc
gcSetValues :: GC -> GCValues -> IO ()
gcSetValues :: GC -> GCValues -> IO ()
gcSetValues GC
gc GCValues
gcv = Int -> (Ptr GCValues -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (GCValues -> Int
forall a. Storable a => a -> Int
sizeOf GCValues
gcv) ((Ptr GCValues -> IO ()) -> IO ())
-> (Ptr GCValues -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GCValues
vPtr -> do
CInt
mask <- Ptr GCValues -> GCValues -> IO CInt
pokeGCValues Ptr GCValues
vPtr GCValues
gcv
()
gc <- (\(GC ForeignPtr GC
arg1) Ptr ()
arg2 CInt
arg3 -> ForeignPtr GC -> (Ptr GC -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GC
arg1 ((Ptr GC -> IO ()) -> IO ()) -> (Ptr GC -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GC
argPtr1 ->Ptr GC -> Ptr () -> CInt -> IO ()
gdk_gc_set_values Ptr GC
argPtr1 Ptr ()
arg2 CInt
arg3) GC
gc (Ptr GCValues -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr GCValues
vPtr) CInt
mask
(ErrorCall -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(ErrorCall [Char]
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Pixmap -> Bool
forall a. Maybe a -> Bool
isJust (GCValues -> Maybe Pixmap
tile GCValues
gcv)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
ForeignPtr Pixmap -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ((Pixmap -> ForeignPtr Pixmap
unPixmap(Pixmap -> ForeignPtr Pixmap)
-> (GCValues -> Pixmap) -> GCValues -> ForeignPtr Pixmap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Maybe Pixmap -> Pixmap
forall a. HasCallStack => Maybe a -> a
fromJust(Maybe Pixmap -> Pixmap)
-> (GCValues -> Maybe Pixmap) -> GCValues -> Pixmap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.GCValues -> Maybe Pixmap
tile) GCValues
gcv)
(ErrorCall -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(ErrorCall [Char]
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Pixmap -> Bool
forall a. Maybe a -> Bool
isJust (GCValues -> Maybe Pixmap
stipple GCValues
gcv)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
ForeignPtr Pixmap -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ((Pixmap -> ForeignPtr Pixmap
unPixmap(Pixmap -> ForeignPtr Pixmap)
-> (GCValues -> Pixmap) -> GCValues -> ForeignPtr Pixmap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Maybe Pixmap -> Pixmap
forall a. HasCallStack => Maybe a -> a
fromJust(Maybe Pixmap -> Pixmap)
-> (GCValues -> Maybe Pixmap) -> GCValues -> Pixmap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.GCValues -> Maybe Pixmap
stipple) GCValues
gcv)
(ErrorCall -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(ErrorCall [Char]
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Pixmap -> Bool
forall a. Maybe a -> Bool
isJust (GCValues -> Maybe Pixmap
clipMask GCValues
gcv)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
ForeignPtr Pixmap -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ((Pixmap -> ForeignPtr Pixmap
unPixmap(Pixmap -> ForeignPtr Pixmap)
-> (GCValues -> Pixmap) -> GCValues -> ForeignPtr Pixmap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Maybe Pixmap -> Pixmap
forall a. HasCallStack => Maybe a -> a
fromJust(Maybe Pixmap -> Pixmap)
-> (GCValues -> Maybe Pixmap) -> GCValues -> Pixmap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.GCValues -> Maybe Pixmap
clipMask) GCValues
gcv)
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
gc
gcGetValues :: GC -> IO GCValues
gcGetValues :: GC -> IO GCValues
gcGetValues GC
gc = (Ptr GCValues -> IO GCValues) -> IO GCValues
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr GCValues -> IO GCValues) -> IO GCValues)
-> (Ptr GCValues -> IO GCValues) -> IO GCValues
forall a b. (a -> b) -> a -> b
$ \Ptr GCValues
vPtr -> do
(\(GC ForeignPtr GC
arg1) Ptr ()
arg2 -> ForeignPtr GC -> (Ptr GC -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GC
arg1 ((Ptr GC -> IO ()) -> IO ()) -> (Ptr GC -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GC
argPtr1 ->Ptr GC -> Ptr () -> IO ()
gdk_gc_get_values Ptr GC
argPtr1 Ptr ()
arg2) GC
gc (Ptr GCValues -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr GCValues
vPtr)
Ptr GCValues -> IO GCValues
forall a. Storable a => Ptr a -> IO a
peek Ptr GCValues
vPtr
gcSetClipRectangle :: GC -> Rectangle -> IO ()
gcSetClipRectangle :: GC -> Rectangle -> IO ()
gcSetClipRectangle GC
gc Rectangle
r = Rectangle -> (Ptr Rectangle -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
r ((Ptr Rectangle -> IO ()) -> IO ())
-> (Ptr Rectangle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Rectangle
rPtr ->
(\(GC ForeignPtr GC
arg1) Ptr ()
arg2 -> ForeignPtr GC -> (Ptr GC -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GC
arg1 ((Ptr GC -> IO ()) -> IO ()) -> (Ptr GC -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GC
argPtr1 ->Ptr GC -> Ptr () -> IO ()
gdk_gc_set_clip_rectangle Ptr GC
argPtr1 Ptr ()
arg2) GC
gc (Ptr Rectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Rectangle
rPtr)
gcSetClipRegion :: GC -> Region -> IO ()
gcSetClipRegion :: GC -> Region -> IO ()
gcSetClipRegion = (\(GC ForeignPtr GC
arg1) (Region ForeignPtr Region
arg2) -> ForeignPtr GC -> (Ptr GC -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GC
arg1 ((Ptr GC -> IO ()) -> IO ()) -> (Ptr GC -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GC
argPtr1 ->ForeignPtr Region -> (Ptr Region -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Region
arg2 ((Ptr Region -> IO ()) -> IO ()) -> (Ptr Region -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Region
argPtr2 ->Ptr GC -> Ptr Region -> IO ()
gdk_gc_set_clip_region Ptr GC
argPtr1 Ptr Region
argPtr2)
{-# LINE 161 "./Graphics/UI/Gtk/Gdk/GC.chs" #-}
gcSetDashes :: GC -> Int -> [(Int,Int)] -> IO ()
gcSetDashes :: GC -> Int -> [(Int, Int)] -> IO ()
gcSetDashes GC
gc Int
phase [(Int, Int)]
onOffList = do
let onOff :: [(CSChar)]
onOff :: [CSChar]
onOff = ((Int, Int) -> [CSChar]) -> [(Int, Int)] -> [CSChar]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
on,Int
off) -> [Int -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
on, Int -> CSChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off])
[(Int, Int)]
onOffList
[CSChar] -> (Ptr CSChar -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CSChar]
onOff ((Ptr CSChar -> IO ()) -> IO ()) -> (Ptr CSChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CSChar
aPtr ->
(\(GC ForeignPtr GC
arg1) CInt
arg2 Ptr CSChar
arg3 CInt
arg4 -> ForeignPtr GC -> (Ptr GC -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GC
arg1 ((Ptr GC -> IO ()) -> IO ()) -> (Ptr GC -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GC
argPtr1 ->Ptr GC -> CInt -> Ptr CSChar -> CInt -> IO ()
gdk_gc_set_dashes Ptr GC
argPtr1 CInt
arg2 Ptr CSChar
arg3 CInt
arg4) GC
gc (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
phase) Ptr CSChar
aPtr
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CSChar] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CSChar]
onOff))
foreign import ccall unsafe "gdk_gc_new"
gdk_gc_new :: ((Ptr Drawable) -> (IO (Ptr GC)))
foreign import ccall unsafe "gdk_gc_new_with_values"
gdk_gc_new_with_values :: ((Ptr Drawable) -> ((Ptr ()) -> (CInt -> (IO (Ptr GC)))))
foreign import ccall unsafe "gdk_gc_set_values"
gdk_gc_set_values :: ((Ptr GC) -> ((Ptr ()) -> (CInt -> (IO ()))))
foreign import ccall unsafe "gdk_gc_get_values"
gdk_gc_get_values :: ((Ptr GC) -> ((Ptr ()) -> (IO ())))
foreign import ccall unsafe "gdk_gc_set_clip_rectangle"
gdk_gc_set_clip_rectangle :: ((Ptr GC) -> ((Ptr ()) -> (IO ())))
foreign import ccall unsafe "gdk_gc_set_clip_region"
gdk_gc_set_clip_region :: ((Ptr GC) -> ((Ptr Region) -> (IO ())))
foreign import ccall unsafe "gdk_gc_set_dashes"
gdk_gc_set_dashes :: ((Ptr GC) -> (CInt -> ((Ptr CSChar) -> (CInt -> (IO ())))))