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 System.Glib.GObject (wrapNewGObject)
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 ())))))