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
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))
gcNew :: DrawableClass d => d -> IO GC
gcNew d = do
gcPtr <- (\(Drawable arg1) -> withForeignPtr arg1 $ \argPtr1 ->gdk_gc_new argPtr1) (toDrawable d)
if (gcPtr==nullPtr) then return (error "gcNew: null graphics context.")
else wrapNewGObject mkGC (return gcPtr)
gcNewWithValues :: DrawableClass d => d -> GCValues -> IO GC
gcNewWithValues d gcv = allocaBytes (sizeOf gcv) $ \vPtr -> do
mask <- pokeGCValues vPtr gcv
gc <- wrapNewGObject mkGC $ (\(Drawable arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->gdk_gc_new_with_values argPtr1 arg2 arg3)
(toDrawable d) (castPtr vPtr) mask
handle (\(ErrorCall _) -> return ()) $ when (isJust (tile gcv)) $
touchForeignPtr ((unPixmap.fromJust.tile) gcv)
handle (\(ErrorCall _) -> return ()) $ when (isJust (stipple gcv)) $
touchForeignPtr ((unPixmap.fromJust.stipple) gcv)
handle (\(ErrorCall _) -> return ()) $ when (isJust (clipMask gcv)) $
touchForeignPtr ((unPixmap.fromJust.clipMask) gcv)
return gc
gcSetValues :: GC -> GCValues -> IO ()
gcSetValues gc gcv = allocaBytes (sizeOf gcv) $ \vPtr -> do
mask <- pokeGCValues vPtr gcv
gc <- (\(GC arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->gdk_gc_set_values argPtr1 arg2 arg3) gc (castPtr vPtr) mask
handle (\(ErrorCall _) -> return ()) $ when (isJust (tile gcv)) $
touchForeignPtr ((unPixmap.fromJust.tile) gcv)
handle (\(ErrorCall _) -> return ()) $ when (isJust (stipple gcv)) $
touchForeignPtr ((unPixmap.fromJust.stipple) gcv)
handle (\(ErrorCall _) -> return ()) $ when (isJust (clipMask gcv)) $
touchForeignPtr ((unPixmap.fromJust.clipMask) gcv)
return gc
gcGetValues :: GC -> IO GCValues
gcGetValues gc = alloca $ \vPtr -> do
(\(GC arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gdk_gc_get_values argPtr1 arg2) gc (castPtr vPtr)
peek vPtr
gcSetClipRectangle :: GC -> Rectangle -> IO ()
gcSetClipRectangle gc r = with r $ \rPtr ->
(\(GC arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gdk_gc_set_clip_rectangle argPtr1 arg2) gc (castPtr rPtr)
gcSetClipRegion :: GC -> Region -> IO ()
gcSetClipRegion = (\(GC arg1) (Region arg2) -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->gdk_gc_set_clip_region argPtr1 argPtr2)
gcSetDashes :: GC -> Int -> [(Int,Int)] -> IO ()
gcSetDashes gc phase onOffList = do
let onOff :: [(CSChar)]
onOff = concatMap (\(on,off) -> [fromIntegral on, fromIntegral off])
onOffList
withArray onOff $ \aPtr ->
(\(GC arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->gdk_gc_set_dashes argPtr1 arg2 arg3 arg4) gc (fromIntegral phase) aPtr
(fromIntegral (length 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 ())))))