-! Copyright (C) 2010 Anton Gorenko, Philipp Brüschweiler.
+! Copyright (C) 2010, 2011 Anton Gorenko, Philipp Bruschweiler.
! 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
TUPLE: handle ;
-TUPLE: window-handle < handle window fullscreen? im-context im-menu ;
+TUPLE: window-handle < handle window fullscreen? im-context ;
: <window-handle> ( window im-context -- window-handle )
window-handle new
swap >>im-context
swap >>window ;
+: 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 ;
+
+! Clipboards
+
TUPLE: gtk-clipboard handle ;
C: <gtk-clipboard> gtk-clipboard
-PIXEL-FORMAT-ATTRIBUTE-TABLE: gl-config-attribs ${ GDK_GL_USE_GL GDK_GL_RGBA } H{
- { double-buffered ${ GDK_GL_DOUBLEBUFFER } }
- { stereo ${ GDK_GL_STEREO } }
- ! { offscreen ${ GDK_GL_DRAWABLE_TYPE 2 } }
- ! { fullscreen ${ GDK_GL_DRAWABLE_TYPE 1 } }
- ! { windowed ${ GDK_GL_DRAWABLE_TYPE 1 } }
- { color-bits ${ GDK_GL_BUFFER_SIZE } }
- { red-bits ${ GDK_GL_RED_SIZE } }
- { green-bits ${ GDK_GL_GREEN_SIZE } }
- { blue-bits ${ GDK_GL_BLUE_SIZE } }
- { alpha-bits ${ GDK_GL_ALPHA_SIZE } }
- { accum-red-bits ${ GDK_GL_ACCUM_RED_SIZE } }
- { accum-green-bits ${ GDK_GL_ACCUM_GREEN_SIZE } }
- { accum-blue-bits ${ GDK_GL_ACCUM_BLUE_SIZE } }
- { accum-alpha-bits ${ GDK_GL_ACCUM_ALPHA_SIZE } }
- { depth-bits ${ GDK_GL_DEPTH_SIZE } }
- { stencil-bits ${ GDK_GL_STENCIL_SIZE } }
- { aux-buffers ${ GDK_GL_AUX_BUFFERS } }
- { sample-buffers ${ GDK_GL_SAMPLE_BUFFERS } }
- { samples ${ GDK_GL_SAMPLES } }
-}
+M: gtk-clipboard clipboard-contents
+ [
+ handle>> gtk_clipboard_wait_for_text
+ [ &g_free utf8 alien>string ] [ f ] if*
+ ] with-destructors ;
-M: gtk-ui-backend (make-pixel-format)
- nip >gl-config-attribs-int-array gdk_gl_config_new ;
+M: gtk-clipboard set-clipboard-contents
+ swap [ handle>> ] [ utf8 string>alien ] bi*
+ -1 gtk_clipboard_set_text ;
-M: gtk-ui-backend (free-pixel-format)
- handle>> g_object_unref ;
+: init-clipboard ( -- )
+ selection "PRIMARY"
+ clipboard "CLIPBOARD"
+ [
+ utf8 string>alien gdk_atom_intern_static_string
+ gtk_clipboard_get <gtk-clipboard> swap set-global
+ ] 2bi@ ;
-M: gtk-ui-backend (pixel-format-attribute)
- [ handle>> ] [ >gl-config-attribs ] bi*
- { int } [ gdk_gl_config_get_attrib drop ]
- with-out-parameters ;
+! Timer
+
+SYMBOL: next-fire-time
+
+: set-timeout*-value ( alien value -- )
+ swap 0 set-alien-signed-4 ; inline
+
+: timer-prepare ( source timeout* -- ? )
+ nip next-fire-time get-global nano-count [-]
+ [ 1,000,000 /i set-timeout*-value ] keep 0 = ;
+
+: timer-check ( source -- ? )
+ drop next-fire-time get-global nano-count [-] 0 = ;
+
+: timer-dispatch ( source callback user_data -- ? )
+ 3drop sleep-time [ 1,000,000,000 ] unless* nano-count +
+ next-fire-time set-global
+ yield t ;
+
+: <timer-funcs> ( -- timer-funcs )
+ GSourceFuncs malloc-struct
+ [ timer-prepare ] GSourceFuncsPrepareFunc >>prepare
+ [ timer-check ] GSourceFuncsCheckFunc >>check
+ [ timer-dispatch ] GSourceFuncsDispatchFunc >>dispatch ;
+
+:: with-timer ( quot -- )
+ nano-count next-fire-time set-global
+ <timer-funcs> &free
+ GSource heap-size g_source_new &g_source_unref :> source
+ source f g_source_attach drop
+ [ quot call( -- ) ]
+ [ source g_source_destroy ] [ ] cleanup ;
+
+! User input
CONSTANT: events-mask
flags{
CONSTANT: action-key-codes
H{
- { $ GDK_BackSpace "BACKSPACE" }
- { $ GDK_Tab "TAB" }
- { $ GDK_Return "RET" }
- { $ GDK_KP_Enter "ENTER" }
- { $ GDK_Escape "ESC" }
- { $ GDK_Delete "DELETE" }
- { $ GDK_Home "HOME" }
- { $ GDK_Left "LEFT" }
- { $ GDK_Up "UP" }
- { $ GDK_Right "RIGHT" }
- { $ GDK_Down "DOWN" }
- { $ GDK_Page_Up "PAGE_UP" }
- { $ GDK_Page_Down "PAGE_DOWN" }
- { $ GDK_End "END" }
- { $ GDK_Begin "BEGIN" }
- { $ GDK_F1 "F1" }
- { $ GDK_F2 "F2" }
- { $ GDK_F3 "F3" }
- { $ GDK_F4 "F4" }
- { $ GDK_F5 "F5" }
- { $ GDK_F6 "F6" }
- { $ GDK_F7 "F7" }
- { $ GDK_F8 "F8" }
- { $ GDK_F9 "F9" }
- { $ GDK_F10 "F10" }
- { $ GDK_F11 "F11" }
- { $ GDK_F12 "F12" }
+ { $ GDK_KEY_BackSpace "BACKSPACE" }
+ { $ GDK_KEY_Tab "TAB" }
+ { $ GDK_KEY_Return "RET" }
+ { $ GDK_KEY_KP_Enter "ENTER" }
+ { $ GDK_KEY_Escape "ESC" }
+ { $ GDK_KEY_Delete "DELETE" }
+ { $ GDK_KEY_Home "HOME" }
+ { $ GDK_KEY_Left "LEFT" }
+ { $ GDK_KEY_Up "UP" }
+ { $ GDK_KEY_Right "RIGHT" }
+ { $ GDK_KEY_Down "DOWN" }
+ { $ GDK_KEY_Page_Up "PAGE_UP" }
+ { $ GDK_KEY_Page_Down "PAGE_DOWN" }
+ { $ GDK_KEY_End "END" }
+ { $ GDK_KEY_Begin "BEGIN" }
+ { $ GDK_KEY_F1 "F1" }
+ { $ GDK_KEY_F2 "F2" }
+ { $ GDK_KEY_F3 "F3" }
+ { $ GDK_KEY_F4 "F4" }
+ { $ GDK_KEY_F5 "F5" }
+ { $ GDK_KEY_F6 "F6" }
+ { $ GDK_KEY_F7 "F7" }
+ { $ GDK_KEY_F8 "F8" }
+ { $ GDK_KEY_F9 "F9" }
+ { $ GDK_KEY_F10 "F10" }
+ { $ GDK_KEY_F11 "F11" }
+ { $ GDK_KEY_F12 "F12" }
}
: event-modifiers ( event -- seq )
: mouse-event>gesture ( event -- modifiers button loc )
[ event-modifiers ] [ button>> ] [ event-loc ] tri ;
-: on-motion ( sender event user-data -- result )
+: on-motion ( win event user-data -- ? )
drop swap
- [ GdkEventMotion memory>struct event-loc ] dip window
+ [ event-loc ] dip window
move-hand fire-motion t ;
-: on-enter ( sender event user-data -- result )
- on-motion ;
-
-: on-leave ( sender event user-data -- result )
+: on-leave ( win event user-data -- ? )
3drop forget-rollover t ;
-: on-button-press ( sender event user-data -- result )
- drop swap [
- GdkEventButton memory>struct
- mouse-event>gesture [ <button-down> ] dip
- ] dip window send-button-down t ;
-
-: on-button-release ( sender event user-data -- result )
+:: on-button-press ( win event user-data -- ? )
+ win window :> world
+ event mouse-event>gesture :> ( modifiers button loc )
+ button {
+ { 8 [ ] }
+ { 9 [ ] }
+ [ modifiers swap <button-down> loc world
+ send-button-down ]
+ } case t ;
+
+:: on-button-release ( win event user-data -- ? )
+ win window :> world
+ event mouse-event>gesture :> ( modifiers button loc )
+ button {
+ { 8 [ world left-action send-action ] }
+ { 9 [ world right-action send-action ] }
+ [ modifiers swap <button-up> loc world
+ send-button-up ]
+ } case t ;
+
+: on-scroll ( win event user-data -- ? )
drop swap [
- GdkEventButton memory>struct
- mouse-event>gesture [ <button-up> ] dip
- ] dip window send-button-up t ;
-
-: on-scroll ( sender event user-data -- result )
- drop swap [
- GdkEventScroll memory>struct
[ scroll-direction ] [ event-loc ] bi
] dip window send-scroll t ;
[ gdk_keyval_to_unicode [ f ] [ 1string ] if-zero f ] ?if ;
: key-event>gesture ( event -- mods sym/f action? )
- GdkEventKey memory>struct
[ event-modifiers ] [ key-sym ] bi ;
-: on-key-press ( sender event user-data -- result )
+: on-key-press ( win event user-data -- ? )
drop swap [ key-event>gesture <key-down> ] [ window ] bi*
propagate-key-gesture t ;
-: on-key-release ( sender event user-data -- result )
+: on-key-release ( win event user-data -- ? )
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 ]
GtkWidget:leave-notify-event connect-signal
- win "enter-notify-event" [ on-enter yield ]
- GtkWidget:enter-notify-event connect-signal
win "button-press-event" [ on-button-press yield ]
GtkWidget:button-press-event connect-signal
win "button-release-event" [ on-button-release yield ]
win "focus-in-event" [ on-focus-in yield ]
GtkWidget:focus-in-event connect-signal
win "focus-out-event" [ on-focus-out yield ]
- GtkWidget:focus-out-event connect-signal
- win "delete-event" [ on-delete yield ]
- GtkWidget:delete-event connect-signal ;
-
-! ----------------------
+ GtkWidget:focus-out-event connect-signal ;
-GENERIC: support-input-methods? ( gadget -- ? )
-GENERIC: get-cursor-surrounding ( gadget -- text cursor-pos )
-GENERIC: delete-cursor-surrounding ( offset count gadget -- )
-GENERIC: set-preedit-string ( str cursor-pos gadget -- )
-GENERIC: get-cursor-loc&dim ( gadget -- loc dim )
+! Window state events
-M: gadget support-input-methods? drop f ;
-
-M: editor support-input-methods? drop t ;
-
-M: editor get-cursor-surrounding
- dup editor-caret first2 [ swap editor-line ] dip ;
+: on-expose ( win event user-data -- ? )
+ 2drop window relayout t ;
-M: editor delete-cursor-surrounding
- 3drop ;
+: on-configure ( win event user-data -- ? )
+ drop [ window ] [ GdkEventConfigure memory>struct ] bi*
+ [ event-loc >>window-loc ] [ event-dim >>dim ] bi
+ relayout-1 f ;
-M: editor set-preedit-string
- nip dup [ editor-caret ] keep
- [ user-input* drop ] 2dip
- set-caret ;
+: on-delete ( win event user-data -- ? )
+ 2drop window ungraft t ;
-M: editor get-cursor-loc&dim
- [ caret-loc ] [ caret-dim ] bi ;
+:: connect-win-state-signals ( win -- )
+ win "expose-event" [ on-expose yield ]
+ GtkWidget:expose-event connect-signal
+ win "configure-event" [ on-configure yield ]
+ GtkWidget:configure-event connect-signal
+ win "delete-event" [ on-delete yield ]
+ GtkWidget:delete-event connect-signal ;
-! ----------------------
+! Input methods
: on-retrieve-surrounding ( im-context win -- ? )
window world-focus dup support-input-methods? [
- get-cursor-surrounding [ utf8 string>alien -1 ] dip
+ cursor-surrounding [ utf8 string>alien -1 ] dip
gtk_im_context_set_surrounding t
] [ 2drop f ] if ;
window world-focus dup support-input-methods?
[ delete-cursor-surrounding t ] [ 3drop f ] if nip ;
-: get-preedit-string ( im-context -- str cursor-pos )
- { void* int } [ f swap gtk_im_context_get_preedit_string ]
- with-out-parameters
- [ [ utf8 alien>string ] [ g_free ] bi ] dip ;
-
-: on-preedit-changed ( im-context user-data -- )
- window world-focus dup support-input-methods? [
- [ get-preedit-string ] dip set-preedit-string
- ] [ 2drop ] if ;
-
-: on-commit ( sender str user_data -- )
+: on-commit ( im-context str win -- )
[ drop ] [ utf8 alien>string ] [ window ] tri* user-input ;
-: gadget-location ( gadget -- loc )
- [ loc>> ] [ parent>> [ gadget-location v+ ] when* ] bi ;
-
: gadget-cursor-location ( gadget -- rectangle )
- [ gadget-location ] [ get-cursor-loc&dim ] bi [ v+ ] dip
- [ first2 ] bi@ GdkRectangle <struct-boa> ;
+ [ screen-loc ] [ cursor-loc&dim ] bi [ v+ ] dip
+ [ first2 [ >fixnum ] bi@ ] bi@
+ cairo_rectangle_int_t <struct-boa> ;
: update-cursor-location ( im-context gadget -- )
gadget-cursor-location gtk_im_context_set_cursor_location ;
! has to be called before the window signal handler
-:: im-on-key-event ( sender event im-context -- result )
- sender window world-focus :> gadget
+:: im-on-key-event ( win event im-context -- ? )
+ win window world-focus :> gadget
gadget support-input-methods? [
im-context gadget update-cursor-location
im-context event gtk_im_context_filter_keypress
] [ im-context gtk_im_context_reset f ] if ;
-: im-on-focus-in ( sender event user-data -- result )
- 2drop window handle>> im-context>>
+: im-on-focus-in ( win event im-context -- ? )
+ 2nip
[ gtk_im_context_focus_in ] [ gtk_im_context_reset ] bi f ;
-: im-on-focus-out ( sender event user-data -- result )
- 2drop window handle>> im-context>>
+: im-on-focus-out ( win event im-context -- ? )
+ 2nip
[ gtk_im_context_focus_out ] [ gtk_im_context_reset ] bi f ;
-: im-on-destroy ( sender user-data -- )
+: im-on-destroy ( win im-context -- )
nip [ f gtk_im_context_set_client_window ]
- [ g_object_unref ] bi ;
-
-! for testing only
-
-: com-input-method ( world -- )
- find-world handle>> im-menu>> f f f f 0
- gtk_get_current_event_time gtk_menu_popup ;
-
-: im-menu ( world -- )
- { com-input-method } show-commands-menu ;
-
-editor "input-method" f {
- { T{ button-down f { S+ C+ } 3 } im-menu }
-} define-command-map
-
-! --------
+ ! weird GLib-GObject-WARNING message appears after calling this code
+ ! [ g_object_unref ] bi ;
+ [ drop ] bi ;
:: configure-im ( win im -- )
im win gtk_widget_get_window gtk_im_context_set_client_window
im f gtk_im_context_set_use_preedit
-
- gtk_menu_new :> menu
- im menu gtk_im_multicontext_append_menuitems
- menu win window handle>> im-menu<<
im "commit" [ on-commit yield ]
GtkIMContext:commit win connect-signal-with-data
GtkIMContext:retrieve-surrounding win connect-signal-with-data
im "delete-surrounding" [ on-delete-surrounding yield ]
GtkIMContext:delete-surrounding win connect-signal-with-data
- im "preedit-changed" [ on-preedit-changed yield ]
- GtkIMContext:preedit-changed win connect-signal-with-data
win "key-press-event" [ im-on-key-event yield ]
GtkWidget:key-press-event im connect-signal-with-data
win "destroy" [ im-on-destroy yield ]
GtkObject:destroy im connect-signal-with-data ;
+! Window controls
+
CONSTANT: window-controls>decor-flags
H{
{ close-button 0 }
GDK_FUNC_MOVE bitor gdk_window_set_functions
] 2tri ;
-: setup-gl ( world -- ? )
+! OpenGL and Pixel formats
+
+PIXEL-FORMAT-ATTRIBUTE-TABLE: gl-config-attribs
+ ${ GDK_GL_USE_GL GDK_GL_RGBA }
+ H{
+ { double-buffered ${ GDK_GL_DOUBLEBUFFER } }
+ { stereo ${ GDK_GL_STEREO } }
+ ! { offscreen ${ GDK_GL_DRAWABLE_TYPE 2 } }
+ ! { fullscreen ${ GDK_GL_DRAWABLE_TYPE 1 } }
+ ! { windowed ${ GDK_GL_DRAWABLE_TYPE 1 } }
+ { color-bits ${ GDK_GL_BUFFER_SIZE } }
+ { red-bits ${ GDK_GL_RED_SIZE } }
+ { green-bits ${ GDK_GL_GREEN_SIZE } }
+ { blue-bits ${ GDK_GL_BLUE_SIZE } }
+ { alpha-bits ${ GDK_GL_ALPHA_SIZE } }
+ { accum-red-bits ${ GDK_GL_ACCUM_RED_SIZE } }
+ { accum-green-bits ${ GDK_GL_ACCUM_GREEN_SIZE } }
+ { accum-blue-bits ${ GDK_GL_ACCUM_BLUE_SIZE } }
+ { accum-alpha-bits ${ GDK_GL_ACCUM_ALPHA_SIZE } }
+ { depth-bits ${ GDK_GL_DEPTH_SIZE } }
+ { stencil-bits ${ GDK_GL_STENCIL_SIZE } }
+ { aux-buffers ${ GDK_GL_AUX_BUFFERS } }
+ { sample-buffers ${ GDK_GL_SAMPLE_BUFFERS } }
+ { samples ${ GDK_GL_SAMPLES } }
+ }
+
+M: gtk-ui-backend (make-pixel-format)
+ nip >gl-config-attribs-int-array gdk_gl_config_new ;
+
+M: gtk-ui-backend (free-pixel-format)
+ handle>> g_object_unref ;
+
+M: gtk-ui-backend (pixel-format-attribute)
+ [ handle>> ] [ >gl-config-attribs ] bi*
+ { gint } [ gdk_gl_config_get_attrib drop ]
+ with-out-parameters ;
+
+M: window-handle select-gl-context ( handle -- )
+ window>>
+ [ gtk_widget_get_gl_window ] [ gtk_widget_get_gl_context ] bi
+ gdk_gl_drawable_make_current drop ;
+
+M: window-handle flush-gl-context ( handle -- )
+ window>> gtk_widget_get_gl_window
+ gdk_gl_drawable_swap_buffers ;
+
+! Window
+
+: configure-gl ( world -- )
[
[ handle>> window>> ] [ handle>> ] bi*
- f t GDK_GL_RGBA_TYPE gtk_widget_set_gl_capability
+ f t GDK_GL_RGBA_TYPE gtk_widget_set_gl_capability drop
] with-world-pixel-format ;
: auto-position ( win loc -- )
M:: gtk-ui-backend (open-window) ( world -- )
GTK_WINDOW_TOPLEVEL gtk_window_new :> win
gtk_im_multicontext_new :> im
-
+
win im <window-handle> world handle<<
world win register-window
win world [ window-loc>> auto-position ]
[ dim>> first2 gtk_window_set_default_size ] 2bi
+
+ win "factor" "Factor" [ utf8 string>alien ] bi@
+ gtk_window_set_wmclass
- world setup-gl drop
+ world configure-gl
win gtk_widget_realize
win world window-controls>> configure-window-controls
win im configure-im
- win connect-signals
+ win connect-user-input-signals
+ win connect-win-state-signals
win gtk_widget_show_all ;
window>>
[ gtk_grab_remove ] [ GDK_LEFT_PTR set-cursor ] bi ;
-M: window-handle select-gl-context ( handle -- )
- window>>
- [ gtk_widget_get_gl_window ] [ gtk_widget_get_gl_context ] bi
- gdk_gl_drawable_make_current drop ;
-
-M: window-handle flush-gl-context ( handle -- )
- window>> gtk_widget_get_gl_window
- gdk_gl_drawable_swap_buffers ;
+! Misc.
M: gtk-ui-backend beep
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
-[ "ui.tools" ] main-vocab-hook set-global
+{ "ui.backend.gtk" "io.backend.unix" }
+"ui.backend.gtk.io.unix" require-when
+
+{ "ui.backend.gtk" "ui.gadgets.editors" }
+"ui.backend.gtk.input-methods.editors" require-when
+
+[ "DISPLAY" os-env "ui.tools" "listener" ? ] main-vocab-hook set-global
projects / factor.git / commitdiff