Merge branch 'gtk' of git://github.com/Blei/factor
Anton Gorenko
commit
c8143dca73
|
|
@ -23,7 +23,7 @@ GdkEventScroll GdkEventMotion GdkEventExpose GdkEventVisibility
|
|||
GdkEventCrossing GdkEventFocus GdkEventConfigure GdkEventProperty
|
||||
GdkEventSelection GdkEventDND GdkEventProximity GdkEventClient
|
||||
GdkEventNoExpose GdkEventWindowState GdkEventSetting
|
||||
GdkEventOwnerChange GdkEventGrabBroken ;
|
||||
GdkEventOwnerChange GdkEventGrabBroken GdkRectangle ;
|
||||
|
||||
GIR: vocab:gdk/Gdk-2.0.gir
|
||||
|
||||
|
|
|
|||
|
|
@ -2,22 +2,27 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.accessors alien.c-types alien.data
|
||||
alien.enums alien.strings arrays ascii assocs classes.struct
|
||||
combinators.short-circuit command-line destructors
|
||||
io.backend.unix.multiplexers io.encodings.utf8 io.thread kernel
|
||||
libc literals locals math math.bitwise math.order namespaces
|
||||
sequences strings system threads ui ui.backend ui.clipboards
|
||||
ui.event-loop ui.gadgets ui.gadgets.private ui.gadgets.worlds
|
||||
ui.gestures ui.pixel-formats ui.pixel-formats.private ui.private
|
||||
glib.ffi gobject.ffi gtk.ffi gdk.ffi gdk.gl.ffi gtk.gl.ffi ;
|
||||
combinators combinators.short-circuit command-line destructors
|
||||
documents gdk.ffi gdk.gl.ffi glib.ffi gobject.ffi gtk.ffi
|
||||
gtk.gl.ffi io.backend.unix.multiplexers io.encodings.utf8
|
||||
io.thread kernel libc literals locals math math.bitwise
|
||||
math.order math.vectors namespaces sequences strings system
|
||||
threads ui ui.backend ui.clipboards ui.event-loop ui.gadgets
|
||||
ui.gadgets.editors ui.gadgets.line-support ui.gadgets.private
|
||||
ui.gadgets.worlds ui.gestures ui.pixel-formats
|
||||
ui.pixel-formats.private ui.private ;
|
||||
RENAME: windows ui.private => ui:windows
|
||||
IN: ui.backend.gtk
|
||||
|
||||
SINGLETON: gtk-ui-backend
|
||||
|
||||
TUPLE: handle ;
|
||||
TUPLE: window-handle < handle window fullscreen? ;
|
||||
TUPLE: window-handle < handle window fullscreen? im-context ;
|
||||
|
||||
: <window-handle> ( window -- window-handle )
|
||||
[ window-handle new ] dip >>window ;
|
||||
: <window-handle> ( window im-context -- window-handle )
|
||||
window-handle new
|
||||
swap >>im-context
|
||||
swap >>window ;
|
||||
|
||||
TUPLE: gtk-clipboard handle ;
|
||||
|
||||
|
|
@ -127,6 +132,22 @@ CONSTANT: action-key-codes
|
|||
: mouse-event>gesture ( event -- modifiers button loc )
|
||||
[ event-modifiers ] [ button>> ] [ event-loc ] tri ;
|
||||
|
||||
: gadget-location ( gadget -- loc )
|
||||
[ loc>> ] [ parent>> [ gadget-location v+ ] when* ] bi ;
|
||||
|
||||
: focusable-editor ( world -- editor/f )
|
||||
focusable-child dup editor? [ drop f ] unless ;
|
||||
|
||||
: get-cursor-location ( editor -- GdkRectangle )
|
||||
[ [ gadget-location ] [ caret-loc ] bi v+ first2 ]
|
||||
[ line-height ] bi 0 swap GdkRectangle <struct-boa> ;
|
||||
|
||||
: update-im-cursor-location ( world -- )
|
||||
dup focusable-editor [
|
||||
[ handle>> im-context>> ] [ get-cursor-location ] bi*
|
||||
gtk_im_context_set_cursor_location
|
||||
] [ drop ] if* ;
|
||||
|
||||
: on-motion ( sender event user-data -- result )
|
||||
drop swap
|
||||
[ GdkEventMotion memory>struct event-loc ] dip window
|
||||
|
|
@ -164,16 +185,17 @@ CONSTANT: action-key-codes
|
|||
GdkEventKey memory>struct
|
||||
[ event-modifiers ] [ key-sym ] bi ;
|
||||
|
||||
: send-key-gesture ( win gesture -- )
|
||||
swap window propagate-key-gesture ;
|
||||
: handle-key-gesture ( key-gesture world -- )
|
||||
[ propagate-key-gesture ]
|
||||
[ update-im-cursor-location ] bi ;
|
||||
|
||||
: on-key-press ( sender event user-data -- result )
|
||||
drop key-event>gesture over
|
||||
[ <key-down> send-key-gesture ] [ 3drop drop ] if t ;
|
||||
drop swap [ key-event>gesture <key-down> ] [ window ] bi*
|
||||
handle-key-gesture t ;
|
||||
|
||||
: on-key-release ( sender event user-data -- result )
|
||||
drop key-event>gesture over
|
||||
[ <key-up> send-key-gesture ] [ 3drop drop ] if t ;
|
||||
drop swap [ key-event>gesture <key-up> ] [ window ] bi*
|
||||
handle-key-gesture t ;
|
||||
|
||||
: on-focus-in ( sender event user-data -- result )
|
||||
2drop window focus-world t ;
|
||||
|
|
@ -313,32 +335,77 @@ M: gtk-ui-backend (with-ui)
|
|||
win "delete-event" [ on-delete yield ]
|
||||
GtkWidget:delete-event connect-signal ;
|
||||
|
||||
: on-key-event-for-im ( sender event user-data -- result )
|
||||
swap gtk_im_context_filter_keypress 2drop f ;
|
||||
: on-retrieve-surrounding ( im-context user-data -- ? )
|
||||
window focusable-editor [| im-context editor |
|
||||
editor editor-caret first2 :> ( x y )
|
||||
im-context
|
||||
y editor editor-line utf8 string>alien
|
||||
-1 x
|
||||
gtk_im_context_set_surrounding t
|
||||
] [ drop f ] if* ;
|
||||
|
||||
: on-focus-out-for-im ( sender event user-data -- result )
|
||||
2nip gtk_im_context_reset f ;
|
||||
:: on-delete-surrounding ( im-context offset n user-data -- ? )
|
||||
user-data window :> world
|
||||
world focusable-editor [| editor |
|
||||
editor editor-caret first2 :> ( x y )
|
||||
x offset + y [ 2array ] [ [ n + ] dip 2array ] 2bi
|
||||
editor remove-doc-range
|
||||
world update-im-cursor-location
|
||||
t
|
||||
] [ f ] if* ;
|
||||
|
||||
: on-destroy-for-im ( sender user-data -- result )
|
||||
nip g_object_unref f ;
|
||||
: on-commit ( sender str user_data -- )
|
||||
[ drop ] [ utf8 alien>string ] [ window ] tri*
|
||||
[ user-input ]
|
||||
[ [ f swap key-down boa ] dip handle-key-gesture ] 2bi ;
|
||||
|
||||
: on-im-commit ( sender str user_data -- )
|
||||
[ drop ] [ utf8 alien>string ] [ window ] tri* user-input ;
|
||||
! has to be called before the window signal handler
|
||||
: im-on-key-event ( sender event user-data -- result )
|
||||
[ drop ] 2dip swap gtk_im_context_filter_keypress ;
|
||||
|
||||
:: configure-im ( win -- )
|
||||
gtk_im_context_simple_new :> im
|
||||
im win gtk_im_context_set_client_window
|
||||
: im-on-focus-in ( sender event user-data -- result )
|
||||
2drop window
|
||||
[ handle>> im-context>> gtk_im_context_focus_in ]
|
||||
[ update-im-cursor-location ] bi f ;
|
||||
|
||||
: im-on-focus-out ( sender event user-data -- result )
|
||||
2drop window
|
||||
[ handle>> im-context>> gtk_im_context_focus_out ]
|
||||
[ update-im-cursor-location ] bi f ;
|
||||
|
||||
: im-on-motion ( sender event user-data -- result )
|
||||
2drop window update-im-cursor-location f ;
|
||||
|
||||
: im-on-destroy ( sender user-data -- result )
|
||||
nip [ f gtk_im_context_set_client_window ]
|
||||
[ g_object_unref ] bi f ;
|
||||
|
||||
:: configure-im ( win im -- )
|
||||
im win gtk_widget_get_window gtk_im_context_set_client_window
|
||||
im f gtk_im_context_set_use_preedit
|
||||
|
||||
im "commit" [ on-im-commit yield ]
|
||||
im "commit" [ on-commit yield ]
|
||||
GtkIMContext:commit win connect-signal-with-data
|
||||
im "retrieve-surrounding" [ on-retrieve-surrounding yield ]
|
||||
GtkIMContext:retrieve-surrounding win connect-signal-with-data
|
||||
im "delete-surrounding" [ on-delete-surrounding yield ]
|
||||
GtkIMContext:delete-surrounding win connect-signal-with-data
|
||||
|
||||
win "key-press-event" [ on-key-event-for-im ]
|
||||
win "key-press-event" [ im-on-key-event yield ]
|
||||
GtkWidget:key-press-event im connect-signal-with-data
|
||||
win "key-release-event" [ on-key-event-for-im ]
|
||||
win "key-release-event" [ im-on-key-event yield ]
|
||||
GtkWidget:key-release-event im connect-signal-with-data
|
||||
win "focus-out-event" [ on-focus-out-for-im ]
|
||||
win "focus-in-event" [ im-on-focus-in yield ]
|
||||
GtkWidget:focus-out-event im connect-signal-with-data
|
||||
win "destroy" [ on-destroy-for-im ]
|
||||
win "focus-out-event" [ im-on-focus-out yield ]
|
||||
GtkWidget:focus-out-event im connect-signal-with-data
|
||||
win "motion-notify-event" [ im-on-motion yield ]
|
||||
GtkWidget:motion-notify-event connect-signal
|
||||
win "enter-notify-event" [ im-on-motion yield ]
|
||||
GtkWidget:enter-notify-event connect-signal
|
||||
win "scroll-event" [ im-on-motion yield ]
|
||||
GtkWidget:scroll-event connect-signal
|
||||
win "destroy" [ im-on-destroy yield ]
|
||||
GtkObject:destroy im connect-signal-with-data ;
|
||||
|
||||
CONSTANT: window-controls>decor-flags
|
||||
|
|
@ -393,26 +460,27 @@ CONSTANT: window-controls>func-flags
|
|||
|
||||
M:: gtk-ui-backend (open-window) ( world -- )
|
||||
GTK_WINDOW_TOPLEVEL gtk_window_new :> win
|
||||
gtk_im_multicontext_new :> im
|
||||
|
||||
world win [ <window-handle> >>handle drop ]
|
||||
[ register-window ] 2bi
|
||||
win im <window-handle> world handle<<
|
||||
|
||||
world win register-window
|
||||
|
||||
win world [ window-loc>> auto-position ]
|
||||
[ dim>> first2 gtk_window_set_default_size ] 2bi
|
||||
|
||||
world setup-gl drop
|
||||
|
||||
win configure-im
|
||||
|
||||
win connect-signals
|
||||
|
||||
win gtk_widget_realize
|
||||
win world window-controls>> configure-window-controls
|
||||
|
||||
win im configure-im
|
||||
win connect-signals
|
||||
|
||||
win gtk_widget_show_all ;
|
||||
|
||||
M: gtk-ui-backend (close-window) ( handle -- )
|
||||
window>> [ unregister-window ] [ gtk_widget_destroy ] bi
|
||||
window>> [ gtk_widget_destroy ] [ unregister-window ] bi
|
||||
event-loop? [ gtk_main_quit ] unless ;
|
||||
|
||||
M: gtk-ui-backend set-title
|
||||
|
|
@ -420,10 +488,12 @@ M: gtk-ui-backend set-title
|
|||
gtk_window_set_title ;
|
||||
|
||||
M: gtk-ui-backend (set-fullscreen)
|
||||
[ handle>> ] dip [ >>fullscreen? ] keep
|
||||
[ window>> ] dip
|
||||
[ gtk_window_fullscreen ]
|
||||
[ gtk_window_unfullscreen ] if ;
|
||||
[
|
||||
[ handle>> ] dip [ >>fullscreen? ] keep
|
||||
[ window>> ] dip
|
||||
[ gtk_window_fullscreen ]
|
||||
[ gtk_window_unfullscreen ] if
|
||||
] [ drop update-im-cursor-location ] 2bi ;
|
||||
|
||||
M: gtk-ui-backend (fullscreen?)
|
||||
handle>> fullscreen?>> ;
|
||||
|
|
@ -478,4 +548,3 @@ M: gtk-clipboard set-clipboard-contents
|
|||
gtk-ui-backend ui-backend set-global
|
||||
|
||||
[ "ui.tools" ] main-vocab-hook set-global
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue