1 files changed, 57 insertions, 0 deletions
diff --git a/src/Gtk/State.icl b/src/Gtk/State.icl
new file mode 100644
index 0000000..16312b2
--- /dev/null
+++ b/src/Gtk/State.icl
@@ -0,0 +1,57 @@
+implementation module Gtk.State
+
+import StdEnv
+
+import Control.Monad
+import Control.Monad.Identity
+import Control.Monad.State
+import qualified Data.Map as M
+from Data.Map import :: Map
+import Data.Maybe
+
+import qualified Gtk.Internal as I
+from Gtk.Internal import :: GSignalArgs{..}
+import Gtk.Signal
+
+newGtkState :: GtkState
+newGtkState =
+	{ world           = ()
+	, return          = False
+	, signal_handlers = 'M'.newMap
+	, signal_counter  = 0
+	}
+
+runGtk :: !(State GtkState a) !*World -> (!a, !*World)
+runGtk f w = (evalState wrapped_f newGtkState, w)
+where
+	wrapped_f =
+		toState 'I'.gtk_init >>|
+		f >>= \x ->
+		main >>|
+		pure x
+	main =
+		toStateR 'I'.gtk_main_iteration >>|
+		handle_signals >>|
+		gets (\st -> st.return) >>= \return
+			| return    -> pure ()
+			| otherwise -> main
+	handle_signals =
+		toStateR 'I'.g_signal_pop >>= \sig_args -> case sig_args of
+			Nothing ->
+				pure ()
+			Just sig_args ->
+				gets (\st -> 'M'.get sig_args.sig_id st.signal_handlers) >>= \(Just handler) ->
+				run handler >>|
+				handle_signals
+			with
+				run handler = case handler of
+					GSHI_Void st -> st >>| handle_signals
+
+toState :: !(A.a: a -> a) -> State GtkState ()
+toState f = state \st -> let w = f st.world in ((), {st & world=w})
+
+toStateR :: !(A.a: a -> (r,a)) -> State GtkState r
+toStateR f = state \st -> let (r,w) = f st.world in (r, {st & world=w})
+
+quit :: State GtkState ()
+quit = modify \st -> {st & return=True}