-! Copyright (C) 2005, 2009 Eduardo Cavazos and Slava Pestov
+! Copyright (C) 2005, 2010 Eduardo Cavazos, 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
+USING: accessors arrays alien.c-types alien.data alien.syntax 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 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 ;
+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: libc => system ;
+SPECIALIZED-ARRAYS: uchar ulong ;
IN: ui.backend.x11
SINGLETON: x11-ui-backend
+: XA_NET_SUPPORTED ( -- atom ) "_NET_SUPPORTED" x-atom ;
: XA_NET_WM_NAME ( -- atom ) "_NET_WM_NAME" x-atom ;
+: XA_NET_WM_STATE ( -- atom ) "_NET_WM_STATE" x-atom ;
+: XA_NET_WM_STATE_FULLSCREEN ( -- atom ) "_NET_WM_STATE_FULLSCREEN" x-atom ;
+: XA_NET_ACTIVE_WINDOW ( -- atom ) "_NET_ACTIVE_WINDOW" x-atom ;
+
+: supported-net-wm-hints ( -- seq )
+ { Atom int ulong ulong pointer: Atom }
+ [| type format n-atoms bytes-after atoms |
+ dpy get
+ root get
+ XA_NET_SUPPORTED
+ 0
+ ulong c-type-interval nip
+ 0
+ XA_ATOM
+ type
+ format
+ n-atoms
+ bytes-after
+ atoms
+ XGetWindowProperty
+ Success assert=
+ ]
+ with-out-parameters
+ [| type format n-atoms bytes-after atoms |
+ atoms n-atoms ulong <c-direct-array> >array
+ atoms XFree
+ ] call ;
+
+: net-wm-hint-supported? ( atom -- ? )
+ supported-net-wm-hints member? ;
TUPLE: x11-handle-base glx ;
TUPLE: x11-handle < x11-handle-base window xic ;
! In case dimensions didn't change
relayout-1 ;
-PIXEL-FORMAT-ATTRIBUTE-TABLE: glx-visual { $ GLX_USE_GL $ GLX_RGBA } H{
+PIXEL-FORMAT-ATTRIBUTE-TABLE: glx-visual { $ GLX_RGBA } H{
{ double-buffered { $ GLX_DOUBLEBUFFER } }
{ stereo { $ GLX_STEREO } }
{ color-bits { $ GLX_BUFFER_SIZE } }
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
{
- { S+ HEX: 1 }
- { C+ HEX: 4 }
- { A+ HEX: 8 }
+ { S+ 0x1 }
+ { C+ 0x4 }
+ { A+ 0x8 }
}
CONSTANT: key-codes
H{
- { HEX: FF08 "BACKSPACE" }
- { HEX: FF09 "TAB" }
- { HEX: FF0D "RET" }
- { HEX: FF8D "ENTER" }
- { HEX: FF1B "ESC" }
- { HEX: FFFF "DELETE" }
- { HEX: FF50 "HOME" }
- { HEX: FF51 "LEFT" }
- { HEX: FF52 "UP" }
- { HEX: FF53 "RIGHT" }
- { HEX: FF54 "DOWN" }
- { HEX: FF55 "PAGE_UP" }
- { HEX: FF56 "PAGE_DOWN" }
- { HEX: FF57 "END" }
- { HEX: FF58 "BEGIN" }
- { HEX: FFBE "F1" }
- { HEX: FFBF "F2" }
- { HEX: FFC0 "F3" }
- { HEX: FFC1 "F4" }
- { HEX: FFC2 "F5" }
- { HEX: FFC3 "F6" }
- { HEX: FFC4 "F7" }
- { HEX: FFC5 "F8" }
- { HEX: FFC6 "F9" }
+ { 0xFF08 "BACKSPACE" }
+ { 0xFF09 "TAB" }
+ { 0xFF0D "RET" }
+ { 0xFF8D "ENTER" }
+ { 0xFF1B "ESC" }
+ { 0xFFFF "DELETE" }
+ { 0xFF50 "HOME" }
+ { 0xFF51 "LEFT" }
+ { 0xFF52 "UP" }
+ { 0xFF53 "RIGHT" }
+ { 0xFF54 "DOWN" }
+ { 0xFF55 "PAGE_UP" }
+ { 0xFF56 "PAGE_DOWN" }
+ { 0xFF57 "END" }
+ { 0xFF58 "BEGIN" }
+ { 0xFFBE "F1" }
+ { 0xFFBF "F2" }
+ { 0xFFC0 "F3" }
+ { 0xFFC1 "F4" }
+ { 0xFFC2 "F5" }
+ { 0xFFC3 "F6" }
+ { 0xFFC4 "F7" }
+ { 0xFFC5 "F8" }
+ { 0xFFC6 "F9" }
}
: key-code ( keysym -- keycode action? )
{ 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 ;
user-input ;
: supported-type? ( atom -- ? )
- { "UTF8_STRING" "STRING" "TEXT" }
- [ x-atom = ] with any? ;
+ XA_UTF8_STRING XA_STRING XA_TEXT 3array member? ;
: clipboard-for-atom ( atom -- clipboard )
{
M: world selection-request-event
drop dup target>> {
{ [ dup supported-type? ] [ drop dup set-selection-prop send-notify-success ] }
- { [ dup "TARGETS" x-atom = ] [ drop dup set-targets-prop send-notify-success ] }
- { [ dup "TIMESTAMP" x-atom = ] [ drop dup set-timestamp-prop send-notify-success ] }
+ { [ dup XA_TARGETS = ] [ drop dup set-targets-prop send-notify-success ] }
+ { [ dup XA_TIMESTAMP = ] [ drop dup set-timestamp-prop send-notify-success ] }
[ drop send-notify-failure ]
} cond ;
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 ;
handle>> window>> swap
[ dpy get ] 2dip [ set-title-old ] [ set-title-new ] 3bi ;
-: make-fullscreen-msg ( world ? -- msg )
+: make-fullscreen-msg ( window ? -- msg )
XClientMessageEvent <struct>
- ClientMessage >>type
- dpy get >>display
- "_NET_WM_STATE" x-atom >>message_type
- swap _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ? >>data0
- swap handle>> window>> >>window
- 32 >>format
- "_NET_WM_STATE_FULLSCREEN" x-atom >>data1 ;
+ ClientMessage >>type
+ dpy get >>display
+ XA_NET_WM_STATE >>message_type
+ swap _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ? >>data0
+ swap >>window
+ 32 >>format
+ XA_NET_WM_STATE_FULLSCREEN >>data1 ;
+
+: send-event ( event -- )
+ [
+ dpy get
+ root get
+ 0
+ SubstructureNotifyMask SubstructureRedirectMask bitor
+ ] dip XSendEvent drop ;
M: x11-ui-backend (set-fullscreen) ( world ? -- )
- [ dpy get root get 0 SubstructureNotifyMask ] 2dip
- make-fullscreen-msg XSendEvent drop ;
+ [ handle>> window>> ] dip make-fullscreen-msg send-event ;
M: x11-ui-backend (open-window) ( world -- )
- dup gadget-window
- handle>> window>>
- [ set-closable ] [ dpy get swap set-class ] [ map-window ] tri ;
+ dup gadget-window handle>> window>>
+ [ set-closable ]
+ [ [ dpy get ] dip set-class ]
+ [ map-window ]
+ tri ;
+
+: make-raise-window-msg ( window -- msg )
+ XClientMessageEvent <struct>
+ ClientMessage >>type
+ 1 >>send_event
+ dpy get >>display
+ swap >>window
+ XA_NET_ACTIVE_WINDOW >>message_type
+ 32 >>format ;
+
+: raise-window-new ( window -- )
+ make-raise-window-msg send-event ;
+
+: raise-window-old ( window -- )
+ [ dpy get ] dip
+ [ RevertToPointerRoot CurrentTime XSetInputFocus drop ]
+ [ XRaiseWindow drop ]
+ 2bi ;
M: x11-ui-backend raise-window* ( world -- )
handle>> [
- dpy get swap window>>
- [ RevertToPointerRoot CurrentTime XSetInputFocus drop ]
- [ XRaiseWindow drop ]
- 2bi
+ window>>
+ XA_NET_ACTIVE_WINDOW net-wm-hint-supported?
+ [ raise-window-new ] [ raise-window-old ] if
] when* ;
M: x11-handle select-gl-context ( handle -- )
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" ? ]
-main-vocab-hook set-global
+M: x11-ui-backend ui-backend-available?
+ "DISPLAY" os-env >boolean ;
projects / factor.git / blobdiff