-! Copyright (C) 2005, 2009 Eduardo Cavazos and Slava Pestov
+! Copyright (C) 2005, 2010 Eduardo Cavazos and Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays ascii assocs colors
-classes.struct combinators io.encodings.ascii
-io.encodings.string io.encodings.utf8 kernel literals math
-namespaces sequences strings 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 x11 x11.clipboard x11.constants x11.events x11.glx
-x11.io x11.windows x11.xim x11.xlib environment command-line
-combinators.short-circuit ;
+USING: accessors alien.c-types ascii assocs classes.struct combinators
+combinators.short-circuit command-line environment io.encodings.ascii
+io.encodings.string io.encodings.utf8 kernel literals locals math
+namespaces sequences specialized-arrays.instances.alien.c-types.uchar
+strings 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 x11 x11.clipboard x11.constants
+x11.events x11.glx x11.io x11.windows x11.xim x11.xlib ;
+FROM: unix.ffi => system ;
IN: ui.backend.x11
SINGLETON: x11-ui-backend
M: x11-ui-backend (make-pixel-format)
[ drop dpy get scr get ] dip
- >glx-visual-int-array glXChooseVisual
- XVisualInfo memory>struct ;
+ >glx-visual-int-array glXChooseVisual ;
M: x11-ui-backend (free-pixel-format)
handle>> XFree ;
[ handle>> ] [ >glx-visual ] bi*
[ 2drop f ] [
first
- 0 <int> [ glXGetConfig drop ] keep *int
+ { int } [ glXGetConfig drop ] with-out-parameters
] if-empty ;
CONSTANT: modifiers
{ 7 { 1 0 } }
} at ;
-M: world wheel-event
+M: world scroll-event
[ [ mouse-event>scroll-direction ] [ event-loc ] bi ] dip
- send-wheel ;
+ send-scroll ;
M: world enter-event motion-event ;
M: x-clipboard copy-clipboard
[ x-clipboard@ own-selection ] keep
- (>>contents) ;
+ contents<< ;
M: x-clipboard paste-clipboard
[ find-world handle>> window>> ] dip atom>> convert-selection ;
M: x11-ui-backend beep ( -- )
dpy get 100 XBell drop ;
+<PRIVATE
+: escape-' ( string -- string' )
+ [ dup CHAR: ' = [ drop "'\\''" ] [ 1string ] if ] { } map-as concat ;
+
+: xmessage ( string -- )
+ escape-' "/usr/bin/env xmessage '" "'" surround system drop ;
+PRIVATE>
+
+M: x11-ui-backend system-alert
+ "\n\n" glue xmessage ;
+
+: black ( -- xcolor ) 0 0 0 0 0 0 XColor <struct-boa> ; inline
+
+M:: x11-ui-backend (grab-input) ( handle -- )
+ handle window>> :> wnd
+ dpy get :> dpy
+ dpy wnd uchar-array{ 0 0 0 0 0 0 0 0 } 8 8 XCreateBitmapFromData :> pixmap
+ dpy pixmap dup black dup 0 0 XCreatePixmapCursor :> cursor
+
+ dpy wnd 1 NoEventMask GrabModeAsync dup wnd cursor CurrentTime XGrabPointer drop
+
+ dpy cursor XFreeCursor drop
+ dpy pixmap XFreePixmap drop ;
+
+M: x11-ui-backend (ungrab-input)
+ drop dpy get CurrentTime XUngrabPointer drop ;
+
x11-ui-backend ui-backend set-global
[ "DISPLAY" os-env "ui.tools" "listener" ? ]