ui.backend.gtk: clean up and rearrange the code
Anton Gorenko
parent
8812052ba9
commit
534402469c
|
|
@ -21,42 +21,106 @@ TUPLE: window-handle < handle window fullscreen? im-context ;
|
||||||
swap >>im-context
|
swap >>im-context
|
||||||
swap >>window ;
|
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 ;
|
TUPLE: gtk-clipboard handle ;
|
||||||
|
|
||||||
C: <gtk-clipboard> gtk-clipboard
|
C: <gtk-clipboard> gtk-clipboard
|
||||||
|
|
||||||
PIXEL-FORMAT-ATTRIBUTE-TABLE: gl-config-attribs ${ GDK_GL_USE_GL GDK_GL_RGBA } H{
|
M: gtk-clipboard clipboard-contents
|
||||||
{ double-buffered ${ GDK_GL_DOUBLEBUFFER } }
|
[
|
||||||
{ stereo ${ GDK_GL_STEREO } }
|
handle>> gtk_clipboard_wait_for_text
|
||||||
! { offscreen ${ GDK_GL_DRAWABLE_TYPE 2 } }
|
[ &g_free utf8 alien>string ] [ f ] if*
|
||||||
! { fullscreen ${ GDK_GL_DRAWABLE_TYPE 1 } }
|
] with-destructors ;
|
||||||
! { 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)
|
M: gtk-clipboard set-clipboard-contents
|
||||||
nip >gl-config-attribs-int-array gdk_gl_config_new ;
|
swap [ handle>> ] [ utf8 string>alien ] bi*
|
||||||
|
-1 gtk_clipboard_set_text ;
|
||||||
|
|
||||||
M: gtk-ui-backend (free-pixel-format)
|
: init-clipboard ( -- )
|
||||||
handle>> g_object_unref ;
|
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)
|
! IO events
|
||||||
[ handle>> ] [ >gl-config-attribs ] bi*
|
|
||||||
{ int } [ gdk_gl_config_get_attrib drop ]
|
: io-source-prepare ( source timeout -- ? )
|
||||||
with-out-parameters ;
|
2drop f ;
|
||||||
|
|
||||||
|
: io-source-check ( source -- ? )
|
||||||
|
poll_fds>> 0 g_slist_nth_data GPollFD memory>struct
|
||||||
|
revents>> 0 = not ;
|
||||||
|
|
||||||
|
: io-source-dispatch ( source callback user_data -- ? )
|
||||||
|
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* -- ? )
|
||||||
|
nip next-timeout get-global nano-count [-]
|
||||||
|
[ 1,000,000 /i set-timeout*-value ] keep 0 = ;
|
||||||
|
|
||||||
|
: timeout-check ( source -- ? )
|
||||||
|
drop next-timeout get-global nano-count [-] 0 = ;
|
||||||
|
|
||||||
|
: timeout-dispatch ( source callback user_data -- ? )
|
||||||
|
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 ;
|
||||||
|
|
||||||
|
! User input
|
||||||
|
|
||||||
CONSTANT: events-mask
|
CONSTANT: events-mask
|
||||||
flags{
|
flags{
|
||||||
|
|
@ -129,30 +193,30 @@ CONSTANT: action-key-codes
|
||||||
: mouse-event>gesture ( event -- modifiers button loc )
|
: mouse-event>gesture ( event -- modifiers button loc )
|
||||||
[ event-modifiers ] [ button>> ] [ event-loc ] tri ;
|
[ event-modifiers ] [ button>> ] [ event-loc ] tri ;
|
||||||
|
|
||||||
: on-motion ( sender event user-data -- result )
|
: on-motion ( win event user-data -- ? )
|
||||||
drop swap
|
drop swap
|
||||||
[ GdkEventMotion memory>struct event-loc ] dip window
|
[ GdkEventMotion memory>struct event-loc ] dip window
|
||||||
move-hand fire-motion t ;
|
move-hand fire-motion t ;
|
||||||
|
|
||||||
: on-enter ( sender event user-data -- result )
|
: on-enter ( win event user-data -- ? )
|
||||||
on-motion ;
|
on-motion ;
|
||||||
|
|
||||||
: on-leave ( sender event user-data -- result )
|
: on-leave ( win event user-data -- ? )
|
||||||
3drop forget-rollover t ;
|
3drop forget-rollover t ;
|
||||||
|
|
||||||
: on-button-press ( sender event user-data -- result )
|
: on-button-press ( win event user-data -- ? )
|
||||||
drop swap [
|
drop swap [
|
||||||
GdkEventButton memory>struct
|
GdkEventButton memory>struct
|
||||||
mouse-event>gesture [ <button-down> ] dip
|
mouse-event>gesture [ <button-down> ] dip
|
||||||
] dip window send-button-down t ;
|
] dip window send-button-down t ;
|
||||||
|
|
||||||
: on-button-release ( sender event user-data -- result )
|
: on-button-release ( win event user-data -- ? )
|
||||||
drop swap [
|
drop swap [
|
||||||
GdkEventButton memory>struct
|
GdkEventButton memory>struct
|
||||||
mouse-event>gesture [ <button-up> ] dip
|
mouse-event>gesture [ <button-up> ] dip
|
||||||
] dip window send-button-up t ;
|
] dip window send-button-up t ;
|
||||||
|
|
||||||
: on-scroll ( sender event user-data -- result )
|
: on-scroll ( win event user-data -- ? )
|
||||||
drop swap [
|
drop swap [
|
||||||
GdkEventScroll memory>struct
|
GdkEventScroll memory>struct
|
||||||
[ scroll-direction ] [ event-loc ] bi
|
[ scroll-direction ] [ event-loc ] bi
|
||||||
|
|
@ -166,133 +230,22 @@ CONSTANT: action-key-codes
|
||||||
GdkEventKey memory>struct
|
GdkEventKey memory>struct
|
||||||
[ event-modifiers ] [ key-sym ] bi ;
|
[ 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*
|
drop swap [ key-event>gesture <key-down> ] [ window ] bi*
|
||||||
propagate-key-gesture t ;
|
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*
|
drop swap [ key-event>gesture <key-up> ] [ window ] bi*
|
||||||
propagate-key-gesture t ;
|
propagate-key-gesture t ;
|
||||||
|
|
||||||
: on-focus-in ( sender event user-data -- result )
|
: on-focus-in ( win event user-data -- ? )
|
||||||
2drop window focus-world t ;
|
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 ;
|
2drop window unfocus-world t ;
|
||||||
|
|
||||||
: on-expose ( sender event user-data -- result )
|
:: connect-user-input-signals ( win -- )
|
||||||
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 ;
|
|
||||||
|
|
||||||
M: gtk-ui-backend (with-ui)
|
|
||||||
[
|
|
||||||
f f gtk_init
|
|
||||||
f f gtk_gl_init
|
|
||||||
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 -- )
|
|
||||||
win events-mask gtk_widget_add_events
|
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 ]
|
win "motion-notify-event" [ on-motion yield ]
|
||||||
GtkWidget:motion-notify-event connect-signal
|
GtkWidget:motion-notify-event connect-signal
|
||||||
win "leave-notify-event" [ on-leave yield ]
|
win "leave-notify-event" [ on-leave yield ]
|
||||||
|
|
@ -312,10 +265,31 @@ M: gtk-ui-backend (with-ui)
|
||||||
win "focus-in-event" [ on-focus-in yield ]
|
win "focus-in-event" [ on-focus-in yield ]
|
||||||
GtkWidget:focus-in-event connect-signal
|
GtkWidget:focus-in-event connect-signal
|
||||||
win "focus-out-event" [ on-focus-out yield ]
|
win "focus-out-event" [ on-focus-out yield ]
|
||||||
GtkWidget:focus-out-event connect-signal
|
GtkWidget:focus-out-event connect-signal ;
|
||||||
|
|
||||||
|
! Window state events
|
||||||
|
|
||||||
|
: on-expose ( win event user-data -- ? )
|
||||||
|
2drop window relayout t ;
|
||||||
|
|
||||||
|
: on-configure ( win event user-data -- ? )
|
||||||
|
drop [ window ] [ GdkEventConfigure memory>struct ] bi*
|
||||||
|
[ event-loc >>window-loc ] [ event-dim >>dim ] bi
|
||||||
|
relayout-1 f ;
|
||||||
|
|
||||||
|
: on-delete ( win event user-data -- ? )
|
||||||
|
2drop window ungraft t ;
|
||||||
|
|
||||||
|
:: 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 ]
|
win "delete-event" [ on-delete yield ]
|
||||||
GtkWidget:delete-event connect-signal ;
|
GtkWidget:delete-event connect-signal ;
|
||||||
|
|
||||||
|
! Input methods
|
||||||
|
|
||||||
GENERIC: support-input-methods? ( gadget -- ? )
|
GENERIC: support-input-methods? ( gadget -- ? )
|
||||||
GENERIC: get-cursor-surrounding ( gadget -- text cursor-pos )
|
GENERIC: get-cursor-surrounding ( gadget -- text cursor-pos )
|
||||||
GENERIC: delete-cursor-surrounding ( offset count gadget -- )
|
GENERIC: delete-cursor-surrounding ( offset count gadget -- )
|
||||||
|
|
@ -353,12 +327,12 @@ M: editor get-cursor-loc&dim
|
||||||
with-out-parameters
|
with-out-parameters
|
||||||
[ [ utf8 alien>string ] [ g_free ] bi ] dip ;
|
[ [ utf8 alien>string ] [ g_free ] bi ] dip ;
|
||||||
|
|
||||||
: on-preedit-changed ( im-context user-data -- )
|
: on-preedit-changed ( im-context win -- )
|
||||||
window world-focus dup support-input-methods? [
|
window world-focus dup support-input-methods? [
|
||||||
[ get-preedit-string ] dip set-preedit-string
|
[ get-preedit-string ] dip set-preedit-string
|
||||||
] [ 2drop ] if ;
|
] [ 2drop ] if ;
|
||||||
|
|
||||||
: on-commit ( sender str user_data -- )
|
: on-commit ( im-context str win -- )
|
||||||
[ drop ] [ utf8 alien>string ] [ window ] tri* user-input ;
|
[ drop ] [ utf8 alien>string ] [ window ] tri* user-input ;
|
||||||
|
|
||||||
: gadget-location ( gadget -- loc )
|
: gadget-location ( gadget -- loc )
|
||||||
|
|
@ -372,24 +346,26 @@ M: editor get-cursor-loc&dim
|
||||||
gadget-cursor-location gtk_im_context_set_cursor_location ;
|
gadget-cursor-location gtk_im_context_set_cursor_location ;
|
||||||
|
|
||||||
! has to be called before the window signal handler
|
! has to be called before the window signal handler
|
||||||
:: im-on-key-event ( sender event im-context -- result )
|
:: im-on-key-event ( win event im-context -- ? )
|
||||||
sender window world-focus :> gadget
|
win window world-focus :> gadget
|
||||||
gadget support-input-methods? [
|
gadget support-input-methods? [
|
||||||
im-context gadget update-cursor-location
|
im-context gadget update-cursor-location
|
||||||
im-context event gtk_im_context_filter_keypress
|
im-context event gtk_im_context_filter_keypress
|
||||||
] [ im-context gtk_im_context_reset f ] if ;
|
] [ im-context gtk_im_context_reset f ] if ;
|
||||||
|
|
||||||
: im-on-focus-in ( sender event user-data -- result )
|
: im-on-focus-in ( win event im-context -- ? )
|
||||||
2drop window handle>> im-context>>
|
2nip
|
||||||
[ gtk_im_context_focus_in ] [ gtk_im_context_reset ] bi f ;
|
[ gtk_im_context_focus_in ] [ gtk_im_context_reset ] bi f ;
|
||||||
|
|
||||||
: im-on-focus-out ( sender event user-data -- result )
|
: im-on-focus-out ( win event im-context -- ? )
|
||||||
2drop window handle>> im-context>>
|
2nip
|
||||||
[ gtk_im_context_focus_out ] [ gtk_im_context_reset ] bi f ;
|
[ 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 ]
|
nip [ f gtk_im_context_set_client_window ]
|
||||||
[ g_object_unref ] bi ;
|
! weird GLib-GObject-WARNING message appears after calling this code
|
||||||
|
! [ g_object_unref ] bi ;
|
||||||
|
[ drop ] bi ;
|
||||||
|
|
||||||
:: configure-im ( win im -- )
|
:: configure-im ( win im -- )
|
||||||
im win gtk_widget_get_window gtk_im_context_set_client_window
|
im win gtk_widget_get_window gtk_im_context_set_client_window
|
||||||
|
|
@ -415,6 +391,8 @@ M: editor get-cursor-loc&dim
|
||||||
win "destroy" [ im-on-destroy yield ]
|
win "destroy" [ im-on-destroy yield ]
|
||||||
GtkObject:destroy im connect-signal-with-data ;
|
GtkObject:destroy im connect-signal-with-data ;
|
||||||
|
|
||||||
|
! Window controls
|
||||||
|
|
||||||
CONSTANT: window-controls>decor-flags
|
CONSTANT: window-controls>decor-flags
|
||||||
H{
|
H{
|
||||||
{ close-button 0 }
|
{ close-button 0 }
|
||||||
|
|
@ -452,10 +430,58 @@ CONSTANT: window-controls>func-flags
|
||||||
GDK_FUNC_MOVE bitor gdk_window_set_functions
|
GDK_FUNC_MOVE bitor gdk_window_set_functions
|
||||||
] 2tri ;
|
] 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*
|
||||||
|
{ int } [ 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*
|
[ 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 ;
|
] with-world-pixel-format ;
|
||||||
|
|
||||||
: auto-position ( win loc -- )
|
: auto-position ( win loc -- )
|
||||||
|
|
@ -479,13 +505,14 @@ M:: gtk-ui-backend (open-window) ( world -- )
|
||||||
win "factor" "Factor" [ utf8 string>alien ] bi@
|
win "factor" "Factor" [ utf8 string>alien ] bi@
|
||||||
gtk_window_set_wmclass
|
gtk_window_set_wmclass
|
||||||
|
|
||||||
world setup-gl drop
|
world configure-gl
|
||||||
|
|
||||||
win gtk_widget_realize
|
win gtk_widget_realize
|
||||||
win world window-controls>> configure-window-controls
|
win world window-controls>> configure-window-controls
|
||||||
|
|
||||||
win im configure-im
|
win im configure-im
|
||||||
win connect-signals
|
win connect-user-input-signals
|
||||||
|
win connect-win-state-signals
|
||||||
|
|
||||||
win gtk_widget_show_all ;
|
win gtk_widget_show_all ;
|
||||||
|
|
||||||
|
|
@ -524,14 +551,7 @@ M: gtk-ui-backend (ungrab-input)
|
||||||
window>>
|
window>>
|
||||||
[ gtk_grab_remove ] [ GDK_LEFT_PTR set-cursor ] bi ;
|
[ gtk_grab_remove ] [ GDK_LEFT_PTR set-cursor ] bi ;
|
||||||
|
|
||||||
M: window-handle select-gl-context ( handle -- )
|
! Misc.
|
||||||
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 ;
|
|
||||||
|
|
||||||
M: gtk-ui-backend beep
|
M: gtk-ui-backend beep
|
||||||
gdk_beep ;
|
gdk_beep ;
|
||||||
|
|
@ -543,15 +563,19 @@ M:: gtk-ui-backend system-alert ( caption text -- )
|
||||||
[ gtk_dialog_run drop ]
|
[ gtk_dialog_run drop ]
|
||||||
[ gtk_widget_destroy ] tri ;
|
[ gtk_widget_destroy ] tri ;
|
||||||
|
|
||||||
M: gtk-clipboard clipboard-contents
|
M: gtk-ui-backend (with-ui)
|
||||||
[
|
[
|
||||||
handle>> gtk_clipboard_wait_for_text
|
f f gtk_init
|
||||||
[ &g_free utf8 alien>string ] [ f ] if*
|
f f gtk_gl_init
|
||||||
] with-destructors ;
|
init-clipboard
|
||||||
|
start-ui
|
||||||
M: gtk-clipboard set-clipboard-contents
|
stop-io-thread
|
||||||
swap [ handle>> ] [ utf8 string>alien ] bi*
|
[
|
||||||
-1 gtk_clipboard_set_text ;
|
init-io-event-source
|
||||||
|
init-timeout
|
||||||
|
gtk_main
|
||||||
|
] with-destructors
|
||||||
|
] ui-running ;
|
||||||
|
|
||||||
gtk-ui-backend ui-backend set-global
|
gtk-ui-backend ui-backend set-global
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue