| 
									
										
										
										
											2011-01-26 10:00:35 -05:00
										 |  |  | ! Copyright (C) 2011 Anton Gorenko. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2011-04-01 12:06:07 -04:00
										 |  |  | USING: accessors alien.c-types classes.struct continuations | 
					
						
							|  |  |  | glib.ffi io.backend.unix.multiplexers io.thread kernel libc | 
					
						
							|  |  |  | literals locals namespaces system threads ui.backend.gtk.io ;
 | 
					
						
							| 
									
										
										
										
											2011-01-26 10:00:35 -05:00
										 |  |  | IN: ui.backend.gtk.io.unix | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : prepare ( source timeout -- ? )
 | 
					
						
							|  |  |  |     2drop f ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : check ( source -- ? )
 | 
					
						
							|  |  |  |     poll_fds>> 0 g_slist_nth_data GPollFD memory>struct | 
					
						
							|  |  |  |     revents>> 0 = not ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : dispatch ( source callback user-data -- ? )
 | 
					
						
							|  |  |  |      3drop
 | 
					
						
							| 
									
										
										
										
											2012-08-01 19:22:23 -04:00
										 |  |  |      0 mx get-global wait-for-events | 
					
						
							| 
									
										
										
										
											2011-01-26 10:00:35 -05:00
										 |  |  |      yield t ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-04-01 12:06:07 -04:00
										 |  |  | : <funcs> ( -- funcs )
 | 
					
						
							|  |  |  |     GSourceFuncs malloc-struct | 
					
						
							|  |  |  |         [ prepare ] GSourceFuncsPrepareFunc >>prepare | 
					
						
							|  |  |  |         [ check ] GSourceFuncsCheckFunc >>check | 
					
						
							|  |  |  |         [ dispatch ] GSourceFuncsDispatchFunc >>dispatch ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-01-26 10:00:35 -05:00
										 |  |  | CONSTANT: poll-fd-events | 
					
						
							|  |  |  |     flags{ | 
					
						
							|  |  |  |         G_IO_IN | 
					
						
							|  |  |  |         G_IO_OUT | 
					
						
							|  |  |  |         G_IO_PRI | 
					
						
							|  |  |  |         G_IO_ERR | 
					
						
							|  |  |  |         G_IO_HUP | 
					
						
							|  |  |  |         G_IO_NVAL | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : <poll-fd> ( -- poll-fd )
 | 
					
						
							|  |  |  |     GPollFD malloc-struct &free | 
					
						
							| 
									
										
										
										
											2012-08-01 19:22:23 -04:00
										 |  |  |         mx get-global fd>> >>fd | 
					
						
							| 
									
										
										
										
											2011-01-26 10:00:35 -05:00
										 |  |  |         poll-fd-events >>events ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-04-01 12:06:07 -04:00
										 |  |  | M:: unix with-event-loop ( quot -- )
 | 
					
						
							| 
									
										
										
										
											2011-01-26 10:00:35 -05:00
										 |  |  |     stop-io-thread | 
					
						
							| 
									
										
										
										
											2011-04-01 12:06:07 -04:00
										 |  |  |     <funcs> &free | 
					
						
							|  |  |  |     GSource heap-size g_source_new &g_source_unref :> source | 
					
						
							|  |  |  |     source <poll-fd> g_source_add_poll | 
					
						
							|  |  |  |     source f g_source_attach drop
 | 
					
						
							|  |  |  |     [ quot call( -- ) ] | 
					
						
							|  |  |  |     [ | 
					
						
							|  |  |  |         source g_source_destroy | 
					
						
							|  |  |  |         start-io-thread | 
					
						
							|  |  |  |     ] [ ] cleanup ;
 |