{-# LINE 1 "src/Stopgap/System/GLib/Callback.hsc" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
module Stopgap.System.GLib.Callback where
import Foreign.Ptr
import Foreign.Concurrent
import Foreign.Storable
import Control.Monad.ST
import Data.Int
import Data.CairoContext
import Stopgap.Data.Ptr
import Stopgap.Graphics.UI.Gdk.Event.Button qualified as Gdk.Event.Button
import Stopgap.Graphics.UI.Gdk.Event.Motion qualified as Gdk.Event.Motion
data CTag
newtype C fun = C (FunPtr CTag) deriving Int -> C fun -> ShowS
[C fun] -> ShowS
C fun -> String
(Int -> C fun -> ShowS)
-> (C fun -> String) -> ([C fun] -> ShowS) -> Show (C fun)
forall fun. Int -> C fun -> ShowS
forall fun. [C fun] -> ShowS
forall fun. C fun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall fun. Int -> C fun -> ShowS
showsPrec :: Int -> C fun -> ShowS
$cshow :: forall fun. C fun -> String
show :: C fun -> String
$cshowList :: forall fun. [C fun] -> ShowS
showList :: [C fun] -> ShowS
Show
foreign import capi "gtk/gtk.h G_CALLBACK" c_G_CALLBACK :: FunPtr fun -> C fun
c_ab :: (IsPtr a, IsPtr b) =>
(a -> b -> IO ()) -> IO (C (Ptr (Tag a) -> Ptr (Tag b) -> IO ()))
c_ab :: forall a b.
(IsPtr a, IsPtr b) =>
(a -> b -> IO ()) -> IO (C (Ptr (Tag a) -> Ptr (Tag b) -> IO ()))
c_ab a -> b -> IO ()
f = do
let f' :: Ptr (Tag a) -> Ptr (Tag b) -> IO ()
f' Ptr (Tag a)
x Ptr (Tag b)
y = a -> b -> IO ()
f (Ptr (Tag a) -> a
forall a. IsPtr a => Ptr (Tag a) -> a
fromPtr Ptr (Tag a)
x) (Ptr (Tag b) -> b
forall a. IsPtr a => Ptr (Tag a) -> a
fromPtr Ptr (Tag b)
y)
FunPtr (Ptr (Tag a) -> Ptr (Tag b) -> IO ())
-> C (Ptr (Tag a) -> Ptr (Tag b) -> IO ())
forall fun. FunPtr fun -> C fun
c_G_CALLBACK (FunPtr (Ptr (Tag a) -> Ptr (Tag b) -> IO ())
-> C (Ptr (Tag a) -> Ptr (Tag b) -> IO ()))
-> IO (FunPtr (Ptr (Tag a) -> Ptr (Tag b) -> IO ()))
-> IO (C (Ptr (Tag a) -> Ptr (Tag b) -> IO ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr (Tag a) -> Ptr (Tag b) -> IO ())
-> IO (FunPtr (Ptr (Tag a) -> Ptr (Tag b) -> IO ()))
forall a b.
(Ptr a -> Ptr b -> IO ()) -> IO (FunPtr (Ptr a -> Ptr b -> IO ()))
c_wrap_callback_ab Ptr (Tag a) -> Ptr (Tag b) -> IO ()
f'
foreign import ccall "wrapper" c_wrap_callback_ab ::
(Ptr a -> Ptr b -> IO ()) -> IO (FunPtr (Ptr a -> Ptr b -> IO ()))
c_ab_bool :: (IsPtr a, IsPtr b) =>
(a -> b -> IO Bool) -> IO (C (Ptr (Tag a) -> Ptr (Tag b) -> IO Int32))
{-# LINE 37 "src/Stopgap/System/GLib/Callback.hsc" #-}
c_ab_bool f = do
let f' x y = boolToGboolean <$> f (fromPtr x) (fromPtr y)
c_G_CALLBACK <$> c_wrap_callback_ab_bool f'
boolToGboolean :: Bool -> Int32
{-# LINE 42 "src/Stopgap/System/GLib/Callback.hsc" #-}
boolToGboolean = \case False -> 0; True -> 1
{-# LINE 43 "src/Stopgap/System/GLib/Callback.hsc" #-}
foreign import ccall "wrapper" c_wrap_callback_ab_bool ::
(Ptr a -> Ptr b -> IO Int32) ->
{-# LINE 46 "src/Stopgap/System/GLib/Callback.hsc" #-}
IO (FunPtr (Ptr a -> Ptr b -> IO Int32))
{-# LINE 47 "src/Stopgap/System/GLib/Callback.hsc" #-}
c_void_void :: IO () -> IO (C (IO ()))
c_void_void :: IO () -> IO (C (IO ()))
c_void_void IO ()
f = FunPtr (IO ()) -> C (IO ())
forall fun. FunPtr fun -> C fun
c_G_CALLBACK (FunPtr (IO ()) -> C (IO ()))
-> IO (FunPtr (IO ())) -> IO (C (IO ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO () -> IO (FunPtr (IO ()))
c_wrap_callback_void_void IO ()
f
foreign import ccall "wrapper" c_wrap_callback_void_void ::
IO () -> IO (FunPtr (IO ()))
c_self_cairo_ud :: (IsPtr a, IsPtr b) =>
(a -> CairoT r RealWorld -> b -> IO Bool) ->
IO (C ( Ptr (Tag a) -> Ptr (CairoT r RealWorld) -> Ptr (Tag b) ->
IO Int32))
{-# LINE 58 "src/Stopgap/System/GLib/Callback.hsc" #-}
c_self_cairo_ud f = do
let f' x cr y = boolToGboolean <$> do
cr' <- CairoT <$> newForeignPtr cr (pure ())
f (fromPtr x) cr' (fromPtr y)
c_G_CALLBACK <$> c_wrap_callback_self_cairo_ud f'
foreign import ccall "wrapper" c_wrap_callback_self_cairo_ud ::
(Ptr a -> Ptr (CairoT r s) -> Ptr b -> IO Int32) ->
{-# LINE 66 "src/Stopgap/System/GLib/Callback.hsc" #-}
IO (FunPtr (Ptr a -> Ptr (CairoT r s) -> Ptr b -> IO Int32))
{-# LINE 67 "src/Stopgap/System/GLib/Callback.hsc" #-}
c_self_button_ud :: (IsPtr a, IsPtr b) =>
(a -> Gdk.Event.Button.B -> b -> IO Bool) ->
IO (C ( Ptr (Tag a) -> Ptr Gdk.Event.Button.B -> Ptr (Tag b) ->
IO Int32))
{-# LINE 72 "src/Stopgap/System/GLib/Callback.hsc" #-}
c_self_button_ud f = do
let f' x eb y = boolToGboolean <$> do
eb' <- peek eb
f (fromPtr x) eb' (fromPtr y)
c_G_CALLBACK <$> c_wrap_callback_self_button_ud f'
foreign import ccall "wrapper" c_wrap_callback_self_button_ud ::
(Ptr a -> Ptr Gdk.Event.Button.B -> Ptr b -> IO Int32) ->
{-# LINE 80 "src/Stopgap/System/GLib/Callback.hsc" #-}
IO (FunPtr (
Ptr a -> Ptr Gdk.Event.Button.B -> Ptr b ->
IO Int32 ))
{-# LINE 83 "src/Stopgap/System/GLib/Callback.hsc" #-}
c_self_motion_ud :: (IsPtr a, IsPtr b) =>
(a -> Gdk.Event.Motion.M -> b -> IO Bool) ->
IO (C ( Ptr (Tag a) -> Ptr Gdk.Event.Motion.M -> Ptr (Tag b) ->
IO Int32))
{-# LINE 88 "src/Stopgap/System/GLib/Callback.hsc" #-}
c_self_motion_ud f = do
let f' x eb y = boolToGboolean <$> do
eb' <- peek eb
f (fromPtr x) eb' (fromPtr y)
c_G_CALLBACK <$> c_wrap_callback_self_motion_ud f'
foreign import ccall "wrapper" c_wrap_callback_self_motion_ud ::
(Ptr a -> Ptr Gdk.Event.Motion.M -> Ptr b -> IO Int32) ->
{-# LINE 96 "src/Stopgap/System/GLib/Callback.hsc" #-}
IO (FunPtr (
Ptr a -> Ptr Gdk.Event.Motion.M -> Ptr b ->
IO Int32 ))
{-# LINE 99 "src/Stopgap/System/GLib/Callback.hsc" #-}