implementation module Gtk.State

import StdEnv

import Control.Monad
import Control.Monad.Identity
import Control.Monad.State
import qualified Data.Map
from Data.Map import :: Map
import Data.Maybe

import Gtk.Internal
import Gtk.Signal

newGtkState :: GtkState
newGtkState =
	{ world           = ()
	, return          = False
	, signal_handlers = 'Data.Map'.newMap
	, signal_counter  = 0
	}

runGtk :: !(GtkM a) !*World -> (!a, !*World)
runGtk f w = (evalState wrapped_f newGtkState, w)
where
	wrapped_f =
		toState gtk_init >>|
		f >>= \x ->
		main >>|
		pure x
	main =
		toStateR gtk_main_iteration >>|
		handle_signals >>|
		gets (\st -> st.return) >>= \return
			| return    -> pure ()
			| otherwise -> main
	handle_signals =
		toStateR g_signal_pop >>= \sig_args -> case sig_args of
			Nothing ->
				pure ()
			Just sig_args ->
				gets (\st -> 'Data.Map'.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) -> GtkM ()
toState f = state \st -> let w = f st.world in ((), {st & world=w})

toStateR :: !(A.a: a -> (r,a)) -> GtkM r
toStateR f = state \st -> let (r,w) = f st.world in (r, {st & world=w})

appWorld :: !(*World -> *World) -> GtkM ()
appWorld f = state \st
	# w = f (voidToWorld st.world)
	-> ((), {st & world=worldToVoid w})

accWorld :: !(*World -> (r,*World)) -> GtkM r
accWorld f = state \st
	# (r,w) = f (voidToWorld st.world)
	-> (r, {st & world=worldToVoid w})

voidToWorld :: !() -> *World
voidToWorld _ = code {
	fill_a 0 1
	pop_a 1
}

worldToVoid :: !*World -> ()
worldToVoid _ = ()

quit :: GtkM ()
quit = modify \st -> {st & return=True}