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 (g_signal_connect
			(type handler_internal)
			(toPtr (gtkWidget widget))
			(signalName handler)
			id) >>|
	pure widget
where
	type handler = case handler of
		SHI_Void _                         -> 1
		SHI_Pointer_Bool _                 -> 2
		SHI_Int_Int_Pointer_Pointer_Bool _ -> 3

instance tune w SignalHandler | gtkWidget w
where
	tune (SignalHandler handler) widget = installSignalHandler handler widget

instance tune w GSignalHandler | gtkWidget w
where
	tune 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])

withPossibleCallback :: !(GtkM a) -> GtkM a
withPossibleCallback m = saveState >>| m >>= \r -> retrieveState >>| pure r

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_Pointer_Bool f
		-> toInt <$> f args.[0]
	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