diff options
Diffstat (limited to 'src/Gtk/Signal.icl')
| -rw-r--r-- | src/Gtk/Signal.icl | 36 |
1 files changed, 33 insertions, 3 deletions
diff --git a/src/Gtk/Signal.icl b/src/Gtk/Signal.icl index 154fd30..64a244e 100644 --- a/src/Gtk/Signal.icl +++ b/src/Gtk/Signal.icl @@ -27,9 +27,9 @@ installSignalHandler handler widget = { 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 (g_signal_connect + }) >>= \{signal_counter=id} -> + toState + (g_signal_connect (type handler_internal) (toPtr (gtkWidget widget)) (signalName handler) @@ -102,3 +102,33 @@ runSignalHandler handler args = case handler of instance toInt Bool where toInt b = if b 1 0 instance toInt () where toInt _ = 0 + +addTimeout :: !GtkTimeout !(GtkM Bool) -> GtkM () +addTimeout interval callback = + modState (\st -> + let id = st.timeout_counter+1 in + { st + & timeouts = 'Data.Map'.put id (wrapped_callback id) st.timeouts + , timeout_counter = id + }) >>= \{timeout_counter=id} -> + case interval of + Milliseconds ms -> toState (g_timeout_add ms id) + Seconds s -> toState (g_timeout_add_seconds s id) +where + wrapped_callback id = + callback >>= \r -> + if r + getState + (modState \st -> {st & timeouts='Data.Map'.del id st.timeouts}) >>| + pure r + +foreign export handleTimeout +handleTimeout :: !Int -> Int +handleTimeout id + # st = saved_state.[0] + = case 'Data.Map'.get id st.timeouts of + Nothing + -> trace_n ("handleTimeout: missing function #"+++toString id) 0 + Just (GtkM f) + # (b,st) = f st + -> save_state st (if b 1 0) |