! Copyright (C) 2010 Anton Gorenko. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.enums alien.strings arrays ascii assocs classes.struct combinators.short-circuit command-line destructors io.encodings.utf8 kernel literals locals math namespaces sequences strings ui ui.backend ui.clipboards ui.event-loop ui.gadgets ui.gadgets.private ui.gestures ui.private glib glib.ffi gobject gobject.ffi gtk gtk.ffi gdk gdk.ffi gdk.gl gtk.gl gdk.gl.ffi gtk.gl.ffi ; IN: ui.backend.gtk SINGLETON: gtk-ui-backend TUPLE: handle ; TUPLE: window-handle < handle window fullscreen? ; : ( window -- window-handle ) [ window-handle new ] dip >>window ; TUPLE: gtk-clipboard handle ; C: gtk-clipboard CONSTANT: events-mask { GDK_POINTER_MOTION_MASK GDK_POINTER_MOTION_HINT_MASK GDK_ENTER_NOTIFY_MASK GDK_LEAVE_NOTIFY_MASK GDK_BUTTON_PRESS_MASK GDK_BUTTON_RELEASE_MASK GDK_KEY_PRESS_MASK GDK_KEY_RELEASE_MASK GDK_FOCUS_CHANGE_MASK } CONSTANT: modifiers { { S+ $[ GDK_SHIFT_MASK enum>number ] } { C+ $[ GDK_CONTROL_MASK enum>number ] } { A+ $[ GDK_META_MASK enum>number ] } } 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" } } : event-modifiers ( event -- seq ) state>> modifiers modifier ; : event-loc ( event -- loc ) [ x>> ] [ y>> ] bi [ >fixnum ] bi@ 2array ; : event-dim ( event -- dim ) [ width>> ] [ height>> ] bi 2array ; : scroll-direction ( event -- pair ) direction>> { ${ GDK_SCROLL_UP { 0 -1 } } ${ GDK_SCROLL_DOWN { 0 1 } } ${ GDK_SCROLL_LEFT { -1 0 } } ${ GDK_SCROLL_RIGHT { 1 0 } } } at ; : mouse-event>gesture ( event -- modifiers button loc ) [ event-modifiers ] [ button>> ] [ event-loc ] tri ; : on-motion ( sender event user-data -- result ) drop swap [ GdkEventMotion memory>struct 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 ) 3drop forget-rollover t ; : on-button-press ( sender event user-data -- result ) drop swap [ GdkEventButton memory>struct mouse-event>gesture [ ] dip ] dip window send-button-down t ; : on-button-release ( sender event user-data -- result ) drop swap [ GdkEventButton memory>struct mouse-event>gesture [ ] 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 ; : key-sym ( event -- sym action? ) keyval>> dup action-key-codes at [ t ] [ gdk_keyval_to_unicode 1string f ] ?if ; : key-event>gesture ( event -- modifiers sym action? ) [ event-modifiers ] [ key-sym ] bi ; : valid-input? ( string gesture -- ? ) over empty? [ 2drop f ] [ mods>> { f { S+ } } member? [ [ { [ 127 = not ] [ CHAR: \s >= ] } 1&& ] all? ] [ [ { [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] } 1&& ] all? ] if ] if ; :: on-key-press ( sender event user-data -- result ) sender window :> world event GdkEventKey memory>struct :> ev ev key-event>gesture :> gesture gesture world propagate-key-gesture ev keyval>> gdk_keyval_to_unicode 1string dup gesture valid-input? [ world user-input ] [ drop ] if t ; : on-key-release ( sender event user-data -- result ) drop swap [ GdkEventKey memory>struct key-event>gesture ] dip window propagate-key-gesture t ; : on-focus-in ( sender event user-data -- result ) 2drop window focus-world t ; : on-focus-out ( sender event user-data -- result ) 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 t ; : 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 swap set-global ] 2bi@ ; M: gtk-ui-backend do-events f gtk_main_iteration_do drop ui-wait ; M: gtk-ui-backend (with-ui) [ f f gtk_init f f gtk_gl_init init-clipboard start-ui event-loop ] ui-running ; : connect-signal ( object signal-name callback -- ) [ utf8 string>alien ] dip f f 0 g_signal_connect_data drop ; :: connect-signals ( win -- ) win events-mask [ enum>number ] [ bitor ] map-reduce gtk_widget_add_events win "expose-event" [ on-expose ] GtkWidget:expose-event connect-signal win "configure-event" [ on-configure ] GtkWidget:configure-event connect-signal win "motion-notify-event" [ on-motion ] GtkWidget:motion-notify-event connect-signal win "leave-notify-event" [ on-leave ] GtkWidget:leave-notify-event connect-signal win "enter-notify-event" [ on-enter ] GtkWidget:enter-notify-event connect-signal win "button-press-event" [ on-button-press ] GtkWidget:button-press-event connect-signal win "button-release-event" [ on-button-release ] GtkWidget:button-release-event connect-signal win "scroll-event" [ on-scroll ] GtkWidget:scroll-event connect-signal win "key-press-event" [ on-key-press ] GtkWidget:key-press-event connect-signal win "key-release-event" [ on-key-release ] GtkWidget:key-release-event connect-signal win "focus-in-event" [ on-focus-in ] GtkWidget:focus-in-event connect-signal win "focus-out-event" [ on-focus-out ] GtkWidget:focus-out-event connect-signal win "delete-event" [ on-delete ] GtkWidget:delete-event connect-signal ; : enable-gl ( win -- ? ) ${ GDK_GL_MODE_RGBA GDK_GL_MODE_DOUBLE GDK_GL_MODE_DEPTH GDK_GL_MODE_STENCIL GDK_GL_MODE_ALPHA } [ enum>number ] [ bitor ] map-reduce gdk_gl_config_new_by_mode f t GDK_GL_RGBA_TYPE enum>number gtk_widget_set_gl_capability ; M:: gtk-ui-backend (open-window) ( world -- ) GTK_WINDOW_TOPLEVEL gtk_window_new :> win world [ window-loc>> win swap first2 gtk_window_move ] [ dim>> win swap first2 gtk_window_set_default_size ] bi win enable-gl drop ! сделать проверку на доступность OpenGL win connect-signals win world handle<< world win register-window win gtk_widget_show_all ; M: gtk-ui-backend (close-window) ( handle -- ) window>> [ unregister-window ] [ gtk_widget_destroy ] bi ; M: gtk-ui-backend set-title swap [ handle>> window>> ] [ utf8 string>alien ] bi* gtk_window_set_title ; M: gtk-ui-backend (set-fullscreen) [ handle>> ] dip [ >>fullscreen? ] keep [ window>> ] dip [ gtk_window_fullscreen ] [ gtk_window_unfullscreen ] if ; M: gtk-ui-backend (fullscreen?) handle>> fullscreen?>> ; M: gtk-ui-backend raise-window* handle>> window>> gtk_window_present ; : set-cursor ( win cursor -- ) [ [ gtk_widget_get_window ] dip gdk_cursor_new &gdk_cursor_unref gdk_window_set_cursor ] with-destructors ; M: gtk-ui-backend (grab-input) handle>> window>> [ gtk_grab_add ] [ GDK_BLANK_CURSOR set-cursor ] bi ; M: gtk-ui-backend (ungrab-input) handle>> window>> [ gtk_grab_remove ] [ GDK_ARROW 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 ; 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 utf8 alien>string ; M: gtk-clipboard set-clipboard-contents swap [ handle>> ] [ utf8 string>alien ] bi* -1 gtk_clipboard_set_text ; gtk-ui-backend ui-backend set-global [ "ui.tools" ] main-vocab-hook set-global