1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
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 {
no_op
}
worldToVoid :: !*World -> ()
worldToVoid _ = ()
quit :: GtkM ()
quit = modify \st -> {st & return=True}
|
