basis/ui/backend/gtk/io/io.factor

   1 ! Copyright (C) 2011 Anton Gorenko.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien.c-types classes.struct continuations glib.ffi
   4 io.backend.unix.multiplexers io.thread kernel libc literals locals
   5 namespaces threads ;
   6 IN: ui.backend.gtk.io
   7
   8 : prepare ( source timeout -- ? )
   9     2drop f ;
  10
  11 : check ( source -- ? )
  12     poll_fds>> 0 g_slist_nth_data GPollFD memory>struct
  13     revents>> 0 = not ;
  14
  15 : dispatch ( source callback user-data -- ? )
  16      3drop
  17      0 mx get-global wait-for-events
  18      yield t ;
  19
  20 : <funcs> ( -- funcs )
  21     GSourceFuncs malloc-struct
  22         [ prepare ] GSourceFuncsPrepareFunc >>prepare
  23         [ check ] GSourceFuncsCheckFunc >>check
  24         [ dispatch ] GSourceFuncsDispatchFunc >>dispatch ;
  25
  26 CONSTANT: poll-fd-events
  27     flags{
  28         G_IO_IN
  29         G_IO_OUT
  30         G_IO_PRI
  31         G_IO_ERR
  32         G_IO_HUP
  33         G_IO_NVAL
  34     }
  35
  36 : <poll-fd> ( -- poll-fd )
  37     GPollFD malloc-struct &free
  38         mx get-global fd>> >>fd
  39         poll-fd-events >>events ;
  40
  41 :: with-event-loop ( quot -- )
  42     stop-io-thread
  43     <funcs> &free
  44     GSource heap-size g_source_new &g_source_unref :> source
  45     source <poll-fd> g_source_add_poll
  46     source f g_source_attach drop
  47     [ quot call( -- ) ]
  48     [
  49         source g_source_destroy
  50         start-io-thread
  51     ] finally ;