Add addTimeout for running a task on a certain interval

8 files changed, 68 insertions, 4 deletions

diff --git a/src/Gtk/Internal.dcl b/src/Gtk/Internal.dcl
index 8cadd66..fe5b749 100644
--- a/src/Gtk/Internal.dcl
+++ b/src/Gtk/Internal.dcl
@@ -10,6 +10,9 @@ g_object_unref :: !Pointer !.a -> .a
 
 g_signal_connect :: !Int !Pointer !String !Int !.a -> .a
 
+g_timeout_add :: !Int !Int !.a -> .a
+g_timeout_add_seconds :: !Int !Int !.a -> .a
+
 gtk_box_new :: !Bool !Int !.a -> (!Pointer, !.a)
 gtk_box_pack_start :: !Pointer !Pointer !Bool !Bool !Int !.a -> .a
 gtk_box_pack_end :: !Pointer !Pointer !Bool !Bool !Int !.a -> .a
diff --git a/src/Gtk/Internal.icl b/src/Gtk/Internal.icl
index 52c648d..55d5744 100644
--- a/src/Gtk/Internal.icl
+++ b/src/Gtk/Internal.icl
@@ -26,6 +26,16 @@ where
 		ccall clean_g_signal_connect "IpsI:V:A"
 	}
 
+g_timeout_add :: !Int !Int !.a -> .a
+g_timeout_add interval id env = code {
+	ccall clean_g_timeout_add "II:V:A"
+}
+
+g_timeout_add_seconds :: !Int !Int !.a -> .a
+g_timeout_add_seconds interval id env = code {
+	ccall clean_g_timeout_add_seconds "II:V:A"
+}
+
 gtk_box_new :: !Bool !Int !.a -> (!Pointer, !.a)
 gtk_box_new vertical spacing env = code {
 	ccall gtk_box_new "II:p:A"
diff --git a/src/Gtk/Signal.dcl b/src/Gtk/Signal.dcl
index d92455e..692bf05 100644
--- a/src/Gtk/Signal.dcl
+++ b/src/Gtk/Signal.dcl
@@ -4,6 +4,7 @@ from System._Pointer import :: Pointer
 
 from Gtk.State import :: GtkM, :: GtkState
 from Gtk.Tune import class tune
+from Gtk.Types import :: GtkTimeout
 from Gtk.Widgets import class gtkWidget
 
 class signalHandler h
@@ -35,4 +36,7 @@ retrieveState :: GtkM GtkState
 //* Wrap functionality in `saveState` and `retrieveState` if it can be re-entrant.
 withPossibleCallback :: !(GtkM a) -> GtkM a
 
-handleSignal :: !Int !{#Int} -> Int
+handleSignal :: !Int !{#Int} -> Int // only for foreign export
+
+addTimeout :: !GtkTimeout !(GtkM Bool) -> GtkM ()
+handleTimeout :: !Int -> Int // only for foreign export
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)
diff --git a/src/Gtk/State.dcl b/src/Gtk/State.dcl
index 7e56fcf..43b5869 100644
--- a/src/Gtk/State.dcl
+++ b/src/Gtk/State.dcl
@@ -15,6 +15,8 @@ from Gtk.Signal import :: SignalHandlerInternal
 	, return          :: !Bool
 	, signal_handlers :: !Map Int SignalHandlerInternal
 	, signal_counter  :: !Int
+	, timeouts        :: !Map Int (GtkM Bool)
+	, timeout_counter :: !Int
 	, shares          :: !Map ShareId Dynamic // TODO: make this map strict to be able to free references in it
 	}
 
diff --git a/src/Gtk/State.icl b/src/Gtk/State.icl
index e9bb625..4db51af 100644
--- a/src/Gtk/State.icl
+++ b/src/Gtk/State.icl
@@ -19,6 +19,8 @@ newGtkState =
 	, return          = False
 	, signal_handlers = 'Data.Map'.newMap
 	, signal_counter  = 0
+	, timeouts        = 'Data.Map'.newMap
+	, timeout_counter = 0
 	, shares          = 'Data.Map'.newMap
 	}
 
diff --git a/src/Gtk/Types.dcl b/src/Gtk/Types.dcl
index d82ca0c..a3a722f 100644
--- a/src/Gtk/Types.dcl
+++ b/src/Gtk/Types.dcl
@@ -88,6 +88,10 @@ instance toInt GtkResponse
 
 instance toInt GtkStylePriority
 
+:: GtkTimeout
+	= Milliseconds !Int
+	| Seconds !Int
+
 :: GtkWrapMode
 	= WrapNone
 	| WrapChar
diff --git a/src/clean_gtk_support.c b/src/clean_gtk_support.c
index e0756cd..b223cb2 100644
--- a/src/clean_gtk_support.c
+++ b/src/clean_gtk_support.c
@@ -3,6 +3,7 @@
 typedef long CleanInt;
 
 extern CleanInt handleSignal (CleanInt,CleanInt*);
+extern CleanInt handleTimeout (CleanInt);
 
 static void *safe_malloc(size_t n) {
 	void *ptr=malloc (n);
@@ -49,3 +50,11 @@ void clean_g_signal_connect (int type,GtkWidget *widget,char *signal,CleanInt id
 
 	g_signal_connect (widget,signal,G_CALLBACK (callback),(gpointer)id);
 }
+
+void clean_g_timeout_add (CleanInt interval,CleanInt id) {
+	g_timeout_add (interval,G_SOURCE_FUNC (handleTimeout),(gpointer)id);
+}
+
+void clean_g_timeout_add_seconds (CleanInt interval,CleanInt id) {
+	g_timeout_add_seconds (interval,G_SOURCE_FUNC (handleTimeout),(gpointer)id);
+}