-! Copyright (C) 2009 Anton Gorenko.
+! Copyright (C) 2010 Anton Gorenko.
! See http://factorcode.org/license.txt for BSD license.
- USING: alien alien.destructors alien.libraries alien.syntax
- combinators kernel gobject-introspection
- gobject-introspection.standard-types system ;
+ USING: accessors alien alien.c-types alien.destructors
+ alien.libraries alien.strings alien.syntax combinators
-gobject-introspection io.encodings.utf8 kernel system
-vocabs.parser words ;
++gobject-introspection gobject-introspection.standard-types
++io.encodings.utf8 kernel system vocabs.parser words ;
IN: glib.ffi
+LIBRARY: glib
+
<<
"glib" {
{ [ os winnt? ] [ "libglib-2.0-0.dll" cdecl add-library ] }
} cond
>>
- IMPLEMENT-STRUCTS: GPollFD GSource GSourceFuncs ;
++
+ TYPEDEF: char gchar
+ TYPEDEF: uchar guchar
+ TYPEDEF: short gshort
+ TYPEDEF: ushort gushort
+ TYPEDEF: long glong
+ TYPEDEF: ulong gulong
+ TYPEDEF: int gint
+ TYPEDEF: uint guint
+
+ <<
+ int c-type clone
+ [ >c-bool ] >>unboxer-quot
+ [ c-bool> ] >>boxer-quot
+ object >>boxed-class
+ "gboolean" current-vocab create typedef
+ >>
+
+ TYPEDEF: char gint8
+ TYPEDEF: uchar guint8
+ TYPEDEF: short gint16
+ TYPEDEF: ushort guint16
+ TYPEDEF: int gint32
+ TYPEDEF: uint guint32
+ TYPEDEF: longlong gint64
+ TYPEDEF: ulonglong guint64
+
+ TYPEDEF: float gfloat
+ TYPEDEF: double gdouble
+
+ TYPEDEF: long ssize_t
+ TYPEDEF: long time_t
+ TYPEDEF: size_t gsize
+ TYPEDEF: ssize_t gssize
+ TYPEDEF: size_t GType
+
+ TYPEDEF: void* gpointer
+ TYPEDEF: void* gconstpointer
+
+ TYPEDEF: guint8 GDateDay
+ TYPEDEF: guint16 GDateYear
+ TYPEDEF: gint GPid
+ TYPEDEF: guint32 GQuark
+ TYPEDEF: gint32 GTime
+ TYPEDEF: glong gintptr
+ TYPEDEF: gint64 goffset
+ TYPEDEF: gulong guintptr
+ TYPEDEF: guint32 gunichar
+ TYPEDEF: guint16 gunichar2
+
+ TYPEDEF: gpointer pointer
+
+ REPLACE-C-TYPE: long\sdouble double
+ REPLACE-C-TYPE: any gpointer
+
+ IMPLEMENT-STRUCTS: GError GPollFD GSource GSourceFuncs ;
+CONSTANT: G_MININT8 HEX: -80
+CONSTANT: G_MAXINT8 HEX: 7f
+CONSTANT: G_MAXUINT8 HEX: ff
+CONSTANT: G_MININT16 HEX: -8000
+CONSTANT: G_MAXINT16 HEX: 7fff
+CONSTANT: G_MAXUINT16 HEX: ffff
+CONSTANT: G_MININT32 HEX: -80000000
+CONSTANT: G_MAXINT32 HEX: 7fffffff
+CONSTANT: G_MAXUINT32 HEX: ffffffff
+CONSTANT: G_MININT64 HEX: -8000000000000000
+CONSTANT: G_MAXINT64 HEX: 7fffffffffffffff
+CONSTANT: G_MAXUINT64 HEX: ffffffffffffffff
+
GIR: vocab:glib/GLib-2.0.gir
DESTRUCTOR: g_source_unref
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.accessors alien.c-types alien.data
alien.strings arrays assocs classes.struct command-line
-destructors gdk.ffi gdk.gl.ffi gdk.pixbuf.ffi glib.ffi
+continuations destructors environment gdk.ffi gdk.gl.ffi
- glib.ffi gobject-introspection.standard-types gobject.ffi
- gtk.ffi gtk.gl.ffi io.encodings.utf8 kernel libc literals locals
- math math.bitwise math.order math.vectors namespaces sequences
- strings system threads ui ui.backend ui.backend.gtk.input-methods
- ui.backend.gtk.io ui.clipboards ui.event-loop ui.gadgets
- ui.gadgets.private ui.gadgets.worlds ui.gestures
- ui.pixel-formats ui.pixel-formats.private ui.private
- vocabs.loader combinators prettyprint io ;
++gdk.pixbuf.ffi glib.ffi
++gobject-introspection.standard-types
+ gobject.ffi gtk.ffi gtk.gl.ffi io.backend
+ io.backend.unix.multiplexers io.encodings.binary
+ io.encodings.utf8 io.files io.thread kernel libc literals
+ locals math math.bitwise math.order math.vectors namespaces
-sequences strings system threads ui ui.backend ui.clipboards
++sequences strings system threads ui ui.backend ui.backend.gtk.input-methods
++ui.backend.gtk.io ui.clipboards
+ ui.commands ui.event-loop ui.gadgets ui.gadgets.editors
+ ui.gadgets.menus ui.gadgets.private ui.gadgets.worlds
+ ui.gestures ui.pixel-formats ui.pixel-formats.private
-ui.private ;
++ui.private vocabs.loader combinators io ;
IN: ui.backend.gtk
SINGLETON: gtk-ui-backend
drop swap [ key-event>gesture <key-up> ] [ window ] bi*
propagate-key-gesture t ;
-: on-focus-in ( sender event user-data -- result )
+: on-focus-in ( win event user-data -- ? )
2drop window focus-world t ;
-: on-focus-out ( sender event user-data -- result )
+: on-focus-out ( win event user-data -- ? )
2drop window unfocus-world t ;
-: on-expose ( sender event user-data -- result )
- 2drop window relayout t ;
-
-: on-configure ( sender event user-data -- result )
- drop [ window ] dip GdkEventConfigure memory>struct
- [ event-loc >>window-loc ] [ event-dim >>dim ] bi
- relayout-1 f ;
-
-: on-delete ( sender event user-data -- result )
- 2drop window ungraft t ;
-
-: init-clipboard ( -- )
- selection "PRIMARY"
- clipboard "CLIPBOARD"
- [
- utf8 string>alien gdk_atom_intern_static_string
- gtk_clipboard_get <gtk-clipboard> swap set-global
- ] 2bi@ ;
-
-: io-source-prepare ( source timeout -- result )
- 2drop f ;
-
-: io-source-check ( source -- result )
- poll_fds>> 0 g_slist_nth_data GPollFD memory>struct
- revents>> 0 = not ;
-
-: io-source-dispatch ( source callback user_data -- result )
- 3drop
- 0 mx get wait-for-events
- yield t ;
-
-CONSTANT: poll-fd-events
- flags{
- G_IO_IN
- G_IO_OUT
- G_IO_PRI
- G_IO_ERR
- G_IO_HUP
- G_IO_NVAL
- }
-
-: create-poll-fd ( -- poll-fd )
- GPollFD malloc-struct &free
- mx get fd>> >>fd
- poll-fd-events >>events ;
-
-HOOK: init-io-event-source io-backend ( -- )
-
-M: f init-io-event-source ;
-M: c-io-backend init-io-event-source ;
-
-M: object init-io-event-source
- GSourceFuncs malloc-struct &free
- [ io-source-prepare ] GSourceFuncsPrepareFunc >>prepare
- [ io-source-check ] GSourceFuncsCheckFunc >>check
- [ io-source-dispatch ] GSourceFuncsDispatchFunc >>dispatch
- 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 ;
-
+ ! This word gets replaced when deploying. See 'Vocabulary icons'
+ ! in the docs and tools.deploy.shaker.gtk-icon
+ : get-icon-data ( -- byte-array )
+ "resource:misc/icons/Factor_48x48.png" binary file-contents ;
+
+ : load-icon ( -- )
+ get-icon-data [
+ data>GInputStream &g_object_unref
+ GInputStream>GdkPixbuf gtk_window_set_default_icon
+ ] with-destructors ;
+
-M: gtk-ui-backend (with-ui)
- [
- f f gtk_init
- f f gtk_gl_init
- load-icon
- init-clipboard
- start-ui
- stop-io-thread
- [
- init-io-event-source
- init-timeout
- gtk_main
- ] with-destructors
- ] ui-running ;
-
-: connect-signal-with-data ( object signal-name callback data -- )
- [ utf8 string>alien ] 2dip g_signal_connect drop ;
-
-: connect-signal ( object signal-name callback -- )
- f connect-signal-with-data ;
-
-:: connect-signals ( win -- )
+:: connect-user-input-signals ( win -- )
win events-mask gtk_widget_add_events
-
- win "expose-event" [ on-expose yield ]
- GtkWidget:expose-event connect-signal
- win "configure-event" [ on-configure yield ]
- GtkWidget:configure-event connect-signal
win "motion-notify-event" [ on-motion yield ]
GtkWidget:motion-notify-event connect-signal
win "leave-notify-event" [ on-leave yield ]
gdk_beep ;
M:: gtk-ui-backend system-alert ( caption text -- )
- f GTK_DIALOG_MODAL GTK_MESSAGE_WARNING GTK_BUTTONS_OK
- caption utf8 string>alien f gtk_message_dialog_new
- [ text utf8 string>alien f gtk_message_dialog_format_secondary_text ]
- [ gtk_dialog_run drop ]
- [ gtk_widget_destroy ] tri ;
-
-M: gtk-clipboard clipboard-contents
[
- handle>> gtk_clipboard_wait_for_text
- [ &g_free utf8 alien>string ] [ f ] if*
+ f GTK_DIALOG_MODAL GTK_MESSAGE_WARNING GTK_BUTTONS_OK
+ caption utf8 string>alien f
+ gtk_message_dialog_new >k_widget_destroy
+ [
+ text utf8 string>alien f
+ gtk_message_dialog_format_secondary_text
+ ] [ gtk_dialog_run drop ] bi
] with-destructors ;
-M: gtk-clipboard set-clipboard-contents
- swap [ handle>> ] [ utf8 string>alien ] bi*
- -1 gtk_clipboard_set_text ;
+M: gtk-ui-backend (with-ui)
+ [
+ 0 gint <ref> f void* <ref> gtk_init
+ 0 gint <ref> f void* <ref> gtk_gl_init
++ load-icon
+ init-clipboard
+ start-ui
+ [
+ [ [ gtk_main ] with-timer ] with-event-loop
+ ] with-destructors
+ ] ui-running ;
+
gtk-ui-backend ui-backend set-global
projects / factor.git / commitdiff