{-# 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
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 (gcPtr==nullPtr) then return (error "gcNew: null graphics context.")
else wrapNewGObject mkGC (return 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
mask <- Ptr GCValues -> GCValues -> IO CInt
pokeGCValues Ptr GCValues
vPtr GCValues
gcv
gc <- wrapNewGObject mkGC $ (\(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) (castPtr vPtr) mask
handle (\(ErrorCall [Char]
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) $ when (isJust (tile gcv)) $
touchForeignPtr ((unPixmap.fromJust.tile) gcv)
handle (\(ErrorCall [Char]
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) $ when (isJust (stipple gcv)) $
touchForeignPtr ((unPixmap.fromJust.stipple) gcv)
handle (\(ErrorCall [Char]
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) $ when (isJust (clipMask gcv)) $
touchForeignPtr ((unPixmap.fromJust.clipMask) gcv)
return 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
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 (castPtr vPtr) mask
handle (\(ErrorCall [Char]
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) $ when (isJust (tile gcv)) $
touchForeignPtr ((unPixmap.fromJust.tile) gcv)
handle (\(ErrorCall [Char]
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) $ when (isJust (stipple gcv)) $
touchForeignPtr ((unPixmap.fromJust.stipple) gcv)
handle (\(ErrorCall [Char]
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) $ when (isJust (clipMask gcv)) $
touchForeignPtr ((unPixmap.fromJust.clipMask) gcv)
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 ())))))