blob: 040d6f7b671365ddaa9b4759fa130ee785b19a69 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
implementation module Gtk.Signal
import StdEnv
import StdMaybe
import StdDebug
import Control.Monad
import Data.Functor
import qualified Data.Map
import Gtk
import Gtk.Internal
instance signalHandler GSignalHandler
where
signalName h = case h of
DestroyHandler _ -> "destroy"
ActivateHandler _ -> "activate"
signalHandler h = case h of
DestroyHandler f -> SHI_Void f
ActivateHandler f -> SHI_Void f
installSignalHandler :: !h !w -> GtkM w | signalHandler h & gtkWidget w
installSignalHandler handler widget =
let handler_internal = signalHandler handler in
modState (\st ->
{ st
& signal_handlers = 'Data.Map'.put (st.signal_counter+1) handler_internal st.signal_handlers
, signal_counter = st.signal_counter+1
}) >>|
getState >>= \{signal_counter=id} ->
(toState case handler_internal of
SHI_Void _
-> g_signal_connect 1 (toPtr (gtkWidget widget)) (signalName handler) id
SHI_Int_Int_Pointer_Pointer_Bool _
-> g_signal_connect 2 (toPtr (gtkWidget widget)) (signalName handler) id) >>|
pure widget
instance tune w SignalHandler | gtkWidget w
where
tune (SignalHandler handler) widget = installSignalHandler handler widget
// NB: low-level hacking to use and modify the GtkState from within callbacks.
// We use a CAF to keep track of the state. In runGtk, the state is saved with
// saveState. This state is retrieved with retrieveState there (to check
// whether the application should quit), but is also used here (in
// handleSignal) to be used and modified from signal callbacks.
saved_state :: {!GtkState}
saved_state =: {newGtkState}
save_state :: !GtkState !.a -> .a
save_state state env
# saved_state = mk_unique saved_state
saved_state & [0] = state
| saved_state.[0].return <> state.return
= abort "internal error in saveState\n"
= env
where
mk_unique :: !{!GtkState} -> *{!GtkState}
mk_unique _ = code {
no_op
}
saveState :: GtkM ()
saveState = getState >>= \state -> toState (save_state state)
retrieveState :: GtkM GtkState
retrieveState = modState (const saved_state.[0])
foreign export handleSignal
handleSignal :: !Int !{#Int} -> Int
handleSignal id args
# st = saved_state.[0]
= case 'Data.Map'.get id st.signal_handlers of
Nothing
-> trace_n ("handleSignal: missing signal handler #"+++toString id) 0
Just handler
# (GtkM f) = runSignalHandler handler args
# (i,st) = f st
-> save_state st i
runSignalHandler :: !SignalHandlerInternal !{#Int} -> GtkM Int
runSignalHandler handler args = case handler of
SHI_Void f
-> toInt <$> f
SHI_Int_Int_Pointer_Pointer_Bool f
-> toInt <$> f args.[0] args.[1] args.[2] args.[3]
instance toInt Bool where toInt b = if b 1 0
instance toInt () where toInt _ = 0
|
