     GSource heap-size g_source_new &g_source_unref
     [ create-poll-fd g_source_add_poll ]
     [ f g_source_attach drop ] bi ;
+
+SYMBOL: next-timeout
+
+: set-timeout*-value ( alien value -- )
+    swap 0 set-alien-signed-4 ; inline
+
+: timeout-prepare ( source timeout* -- result )
+    nip next-timeout get-global nano-count [-]
+    [ 1,000,000 /i set-timeout*-value ] keep 0 = ;
+
+: timeout-check ( source -- result )
+    drop next-timeout get-global nano-count [-] 0 = ;
+
+: timeout-dispatch ( source callback user_data -- result )
+    3drop sleep-time [ 1,000,000,000 ] unless* nano-count +
+    next-timeout set-global
+    yield t ;
+
+: init-timeout ( -- )
+    GSourceFuncs malloc-struct &free
+        [ timeout-prepare ] GSourceFuncsPrepareFunc >>prepare
+        [ timeout-check ] GSourceFuncsCheckFunc >>check
+        [ timeout-dispatch ] GSourceFuncsDispatchFunc >>dispatch
+    GSource heap-size g_source_new &g_source_unref
+    f g_source_attach drop
+    nano-count next-timeout set-global ;
 
 M: gtk-ui-backend (with-ui)
     [

        f io-thread-running? set-global
        [
            init-io-event-source
            ! is it correct to use timeouts with 'yield'?
            10 init-timeout
            gtk_main
        ] with-destructors
    ] ui-running ;

     0 mx get wait-for-events
     yield t ;

CONSTANT: poll-fd-events
    {
        G_IO_IN
