Merge branch 'master' of git://factorcode.org/git/factor

basis/ui/backend/x11/x11.factor

@@ -1,14 +1,13 @@
 ! Copyright (C) 2005, 2009 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types arrays ui ui.private ui.gadgets
+USING: accessors alien.c-types arrays ascii assocs
-ui.gadgets.private ui.gestures ui.backend ui.clipboards
+classes.struct combinators io.encodings.ascii
-ui.gadgets.worlds ui.render ui.event-loop assocs kernel math
+io.encodings.string io.encodings.utf8 kernel literals math
-namespaces opengl sequences strings x11 x11.xlib x11.events x11.xim
+namespaces sequences strings ui ui.backend ui.clipboards
-x11.glx x11.clipboard x11.constants x11.windows x11.io
+ui.event-loop ui.gadgets ui.gadgets.private ui.gadgets.worlds
-io.encodings.string io.encodings.ascii io.encodings.utf8 combinators
+ui.gestures ui.pixel-formats ui.pixel-formats.private
-command-line math.vectors classes.tuple opengl.gl threads
+ui.private x11 x11.clipboard x11.constants x11.events x11.glx
-math.rectangles environment ascii literals
+x11.io x11.windows x11.xim x11.xlib environment command-line ;
-ui.pixel-formats ui.pixel-formats.private ;
 IN: ui.backend.x11
 
 SINGLETON: x11-ui-backend
@@ -25,8 +24,7 @@ C: <x11-pixmap-handle> x11-pixmap-handle
 M: world expose-event nip relayout ;
 
 M: world configure-event
-    over configured-loc >>window-loc
+    swap [ event-loc >>window-loc ] [ event-dim >>dim ] bi
-    swap configured-dim >>dim
     ! In case dimensions didn't change
     relayout-1 ;
 
@@ -103,7 +101,7 @@ CONSTANT: key-codes
     dup key-codes at [ t ] [ 1string f ] ?if ;
 
 : event-modifiers ( event -- seq )
-    XKeyEvent-state modifiers modifier ;
+    state>> modifiers modifier ;
 
 : valid-input? ( string gesture -- ? )
     over empty? [ 2drop f ] [
@@ -132,10 +130,7 @@ M: world key-up-event
     [ key-up-event>gesture ] dip propagate-key-gesture ;
 
 : mouse-event>gesture ( event -- modifiers button loc )
-    [ event-modifiers ]
+    [ event-modifiers ] [ button>> ] [ event-loc ] tri ;
-    [ XButtonEvent-button ]
-    [ mouse-event-loc ]
-    tri ;
 
 M: world button-down-event
     [ mouse-event>gesture [ <button-down> ] dip ] dip
@@ -146,7 +141,7 @@ M: world button-up-event
     send-button-up ;
 
 : mouse-event>scroll-direction ( event -- pair )
-    XButtonEvent-button {
+    button>> {
         { 4 { 0 -1 } }
         { 5 { 0 1 } }
         { 6 { -1 0 } }
@@ -154,7 +149,7 @@ M: world button-up-event
     } at ;
 
 M: world wheel-event
-    [ [ mouse-event>scroll-direction ] [ mouse-event-loc ] bi ] dip
+    [ [ mouse-event>scroll-direction ] [ event-loc ] bi ] dip
     send-wheel ;
 
 M: world enter-event motion-event ;
@@ -162,16 +157,13 @@ M: world enter-event motion-event ;
 M: world leave-event 2drop forget-rollover ;
 
 M: world motion-event
-    [ [ XMotionEvent-x ] [ XMotionEvent-y ] bi 2array ] dip
+    [ event-loc ] dip move-hand fire-motion ;
-    move-hand fire-motion ;
 
 M: world focus-in-event
-    nip
+    nip [ handle>> xic>> XSetICFocus ] [ focus-world ] bi ;
-    [ handle>> xic>> XSetICFocus ] [ focus-world ] bi ;
 
 M: world focus-out-event
-    nip
+    nip [ handle>> xic>> XUnsetICFocus ] [ unfocus-world ] bi ;
-    [ handle>> xic>> XUnsetICFocus ] [ unfocus-world ] bi ;
 
 M: world selection-notify-event
     [ handle>> window>> selection-from-event ] keep
@@ -189,22 +181,18 @@ M: world selection-notify-event
     } case ;
 
 : encode-clipboard ( string type -- bytes )
-    XSelectionRequestEvent-target
+    target>> XA_UTF8_STRING = utf8 ascii ? encode ;
-    XA_UTF8_STRING = utf8 ascii ? encode ;
 
 : set-selection-prop ( evt -- )
     dpy get swap
-    [ XSelectionRequestEvent-requestor ] keep
+    [ requestor>> ] keep
-    [ XSelectionRequestEvent-property ] keep
+    [ property>> ] keep
-    [ XSelectionRequestEvent-target ] keep
+    [ target>> 8 PropModeReplace ] keep
-    [ 8 PropModeReplace ] dip
+    [ selection>> clipboard-for-atom contents>> ] keep
-    [
+    encode-clipboard dup length XChangeProperty drop ;
-        XSelectionRequestEvent-selection
-        clipboard-for-atom contents>>
-    ] keep encode-clipboard dup length XChangeProperty drop ;
 
 M: world selection-request-event
-    drop dup XSelectionRequestEvent-target {
+    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 ] }
@@ -235,7 +223,7 @@ M: world client-event
     ] [ wait-for-display wait-event ] if ;
 
 M: x11-ui-backend do-events
-    wait-event dup XAnyEvent-window window dup
+    wait-event dup window>> window dup
     [ handle-event ] [ 2drop ] if ;
 
 : x-clipboard@ ( gadget clipboard -- prop win )
@@ -269,17 +257,13 @@ M: x11-ui-backend set-title ( string world -- )
     [ dpy get ] 2dip [ set-title-old ] [ set-title-new ] 3bi ;
 
 M: x11-ui-backend (set-fullscreen) ( world ? -- )
-    [
+    XClientMessageEvent <struct>
-        handle>> window>> "XClientMessageEvent" <c-object>
+    swap _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ? >>data0
-        [ set-XClientMessageEvent-window ] keep
+    swap handle>> window>> >>window
-    ] dip
+    dpy get >>display
-    _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ?
+    "_NET_WM_STATE" x-atom >>message_type
-    over set-XClientMessageEvent-data0
+    32 >>format
-    ClientMessage over set-XClientMessageEvent-type
+    "_NET_WM_STATE_FULLSCREEN" x-atom >>data1
-    dpy get over set-XClientMessageEvent-display
-    "_NET_WM_STATE" x-atom over set-XClientMessageEvent-message_type
-    32 over set-XClientMessageEvent-format
-    "_NET_WM_STATE_FULLSCREEN" x-atom over set-XClientMessageEvent-data1
     [ dpy get root get 0 SubstructureNotifyMask ] dip XSendEvent drop ;
 
 M: x11-ui-backend (open-window) ( world -- )
@@ -312,9 +296,9 @@ M: x11-pixmap-handle flush-gl-context ( handle -- )
     drop ;
 
 M: x11-ui-backend (open-offscreen-buffer) ( world -- )
-    dup [ [ dim>> ] [ handle>> ] bi* glx-pixmap ]
+    dup [ [ dim>> ] [ handle>> ] bi* glx-pixmap ] with-world-pixel-format
-    with-world-pixel-format
     <x11-pixmap-handle> >>handle drop ;
+
 M: x11-ui-backend (close-offscreen-buffer) ( handle -- )
     dpy get swap
     [ glx-pixmap>> glXDestroyGLXPixmap ]

basis/x11/clipboard/clipboard.factor

@@ -1,9 +1,8 @@
 ! Copyright (C) 2006, 2007 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings alien.syntax arrays
+USING: accessors alien.c-types alien.strings classes.struct
-kernel math namespaces sequences io.encodings.string
+io.encodings.utf8 kernel namespaces sequences
-io.encodings.utf8 io.encodings.ascii x11 x11.xlib x11.constants
+specialized-arrays.int x11 x11.constants x11.xlib ;
-specialized-arrays.int accessors ;
 IN: x11.clipboard
 
 ! This code was based on by McCLIM's Backends/CLX/port.lisp
@@ -34,20 +33,15 @@ TUPLE: x-clipboard atom contents ;
     [ XGetWindowProperty drop ] keep snarf-property ;
 
 : selection-from-event ( event window -- string )
-    swap XSelectionEvent-property zero? [
+    swap property>> 0 =
-        drop f
+    [ drop f ] [ selection-property 1 window-property ] if ;
-    ] [
-        selection-property 1 window-property
-    ] if ;
 
 : own-selection ( prop win -- )
     [ dpy get ] 2dip CurrentTime XSetSelectionOwner drop
     flush-dpy ;
 
 : set-targets-prop ( evt -- )
-    dpy get swap
+    [ dpy get ] dip [ requestor>> ] [ property>> ] bi
-    [ XSelectionRequestEvent-requestor ] keep
-    XSelectionRequestEvent-property
     "TARGETS" x-atom 32 PropModeReplace
     {
         "UTF8_STRING" "STRING" "TARGETS" "TIMESTAMP"
@@ -55,28 +49,27 @@ TUPLE: x-clipboard atom contents ;
     4 XChangeProperty drop ;
 
 : set-timestamp-prop ( evt -- )
-    dpy get swap
+    [ dpy get ] dip
-    [ XSelectionRequestEvent-requestor ] keep
+    [ requestor>> ]
-    [ XSelectionRequestEvent-property ] keep
+    [ property>> "TIMESTAMP" x-atom 32 PropModeReplace ]
-    [ "TIMESTAMP" x-atom 32 PropModeReplace ] dip
+    [ time>> <int> ] tri
-    XSelectionRequestEvent-time <int>
     1 XChangeProperty drop ;
 
 : send-notify ( evt prop -- )
-    "XSelectionEvent" <c-object>
+    XSelectionEvent <struct>
-    SelectionNotify over set-XSelectionEvent-type
+    SelectionNotify >>type
-    [ set-XSelectionEvent-property ] keep
+    swap >>property
-    over XSelectionRequestEvent-display   over set-XSelectionEvent-display
+    over display>>   >>display
-    over XSelectionRequestEvent-requestor over set-XSelectionEvent-requestor
+    over requestor>> >>requestor
-    over XSelectionRequestEvent-selection over set-XSelectionEvent-selection
+    over selection>> >>selection
-    over XSelectionRequestEvent-target    over set-XSelectionEvent-target
+    over target>>    >>target
-    over XSelectionRequestEvent-time      over set-XSelectionEvent-time
+    over time>>      >>time
-    [ dpy get swap XSelectionRequestEvent-requestor 0 0 ] dip
+    [ [ dpy get ] dip requestor>> 0 0 ] dip
     XSendEvent drop
     flush-dpy ;
 
 : send-notify-success ( evt -- )
-    dup XSelectionRequestEvent-property send-notify ;
+    dup property>> send-notify ;
 
 : send-notify-failure ( evt -- )
     0 send-notify ;

basis/x11/events/events.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays hashtables io kernel math
+USING: accessors arrays classes.struct combinators kernel
-math.order namespaces prettyprint sequences strings combinators
+math.order namespaces x11 x11.xlib ;
-x11 x11.xlib ;
 IN: x11.events
 
 GENERIC: expose-event ( event window -- )
@@ -36,14 +35,14 @@ GENERIC: selection-request-event ( event window -- )
 GENERIC: client-event ( event window -- )
 
 : next-event ( -- event )
-    dpy get "XEvent" <c-object> [ XNextEvent drop ] keep ;
+    dpy get XEvent <struct> [ XNextEvent drop ] keep ;
 
 : mask-event ( mask -- event )
-    [ dpy get ] dip "XEvent" <c-object> [ XMaskEvent drop ] keep ;
+    [ dpy get ] dip XEvent <struct> [ XMaskEvent drop ] keep ;
 
 : events-queued ( mode -- n ) [ dpy get ] dip XEventsQueued ;
 
-: wheel? ( event -- ? ) XButtonEvent-button 4 7 between? ;
+: wheel? ( event -- ? ) button>> 4 7 between? ;
 
 : button-down-event$ ( event window -- )
     over wheel? [ wheel-event ] [ button-down-event ] if ;
@@ -52,34 +51,31 @@ GENERIC: client-event ( event window -- )
     over wheel? [ 2drop ] [ button-up-event ] if ;
 
 : handle-event ( event window -- )
-    over XAnyEvent-type {
+    over type>> {
-        { Expose [ expose-event ] }
+        { Expose [ XExposeEvent>> expose-event ] }
-        { ConfigureNotify [ configure-event ] }
+        { ConfigureNotify [ XConfigureEvent>> configure-event ] }
-        { ButtonPress [ button-down-event$ ] }
+        { ButtonPress [ XButtonEvent>> button-down-event$ ] }
-        { ButtonRelease [ button-up-event$ ] }
+        { ButtonRelease [ XButtonEvent>> button-up-event$ ] }
-        { EnterNotify [ enter-event ] }
+        { EnterNotify [ XCrossingEvent>> enter-event ] }
-        { LeaveNotify [ leave-event ] }
+        { LeaveNotify [ XCrossingEvent>> leave-event ] }
-        { MotionNotify [ motion-event ] }
+        { MotionNotify [ XMotionEvent>> motion-event ] }
-        { KeyPress [ key-down-event ] }
+        { KeyPress [ XKeyEvent>> key-down-event ] }
-        { KeyRelease [ key-up-event ] }
+        { KeyRelease [ XKeyEvent>> key-up-event ] }
-        { FocusIn [ focus-in-event ] }
+        { FocusIn [ XFocusChangeEvent>> focus-in-event ] }
-        { FocusOut [ focus-out-event ] }
+        { FocusOut [ XFocusChangeEvent>> focus-out-event ] }
-        { SelectionNotify [ selection-notify-event ] }
+        { SelectionNotify [ XSelectionEvent>> selection-notify-event ] }
-        { SelectionRequest [ selection-request-event ] }
+        { SelectionRequest [ XSelectionRequestEvent>> selection-request-event ] }
-        { ClientMessage [ client-event ] }
+        { ClientMessage [ XClientMessageEvent>> client-event ] }
         [ 3drop ]
     } case ;
 
-: configured-loc ( event -- dim )
+: event-loc ( event -- loc )
-    [ XConfigureEvent-x ] [ XConfigureEvent-y ] bi 2array ;
+    [ x>> ] [ y>> ] bi 2array ;
 
-: configured-dim ( event -- dim )
+: event-dim ( event -- dim )
-    [ XConfigureEvent-width ] [ XConfigureEvent-height ] bi 2array ;
+    [ width>> ] [ height>> ] bi 2array ;
-
-: mouse-event-loc ( event -- loc )
-    [ XButtonEvent-x ] [ XButtonEvent-y ] bi 2array ;
 
 : close-box? ( event -- ? )
-    [ XClientMessageEvent-message_type "WM_PROTOCOLS" x-atom = ]
+    [ message_type>> "WM_PROTOCOLS" x-atom = ]
-    [ XClientMessageEvent-data0 "WM_DELETE_WINDOW" x-atom = ]
+    [ data0>> "WM_DELETE_WINDOW" x-atom = ]
     bi and ;

basis/x11/windows/windows.factor

@@ -1,15 +1,15 @@
 ! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types hashtables kernel math math.vectors
+USING: accessors kernel math math.bitwise math.vectors
-math.bitwise namespaces sequences x11 x11.xlib x11.constants x11.glx
+namespaces sequences x11 x11.xlib x11.constants x11.glx arrays
-arrays fry ;
+fry classes.struct ;
 IN: x11.windows
 
 : create-window-mask ( -- n )
     { CWBackPixel CWBorderPixel CWColormap CWEventMask } flags ;
 
 : create-colormap ( visinfo -- colormap )
-    [ dpy get root get ] dip XVisualInfo-visual AllocNone
+    [ dpy get root get ] dip visual>> AllocNone
     XCreateColormap ;
 
 : event-mask ( -- n )
@@ -28,15 +28,15 @@ IN: x11.windows
     } flags ;
 
 : window-attributes ( visinfo -- attributes )
-    "XSetWindowAttributes" <c-object>
+    XSetWindowAttributes <struct>
-    0 over set-XSetWindowAttributes-background_pixel
+    0 >>background_pixel
-    0 over set-XSetWindowAttributes-border_pixel
+    0 >>border_pixel
-    [ [ create-colormap ] dip set-XSetWindowAttributes-colormap ] keep
+    event-mask >>event_mask
-    event-mask over set-XSetWindowAttributes-event_mask ;
+    swap create-colormap >>colormap ;
 
 : set-size-hints ( window -- )
-    "XSizeHints" <c-object>
+    XSizeHints <struct>
-    USPosition over set-XSizeHints-flags
+    USPosition >>flags
     [ dpy get ] 2dip XSetWMNormalHints ;
 
 : auto-position ( window loc -- )
@@ -47,8 +47,8 @@ IN: x11.windows
 : create-window ( loc dim visinfo -- window )
     pick [
         [ [ [ dpy get root get ] dip >xy ] dip { 1 1 } vmax >xy 0 ] dip
-        [ XVisualInfo-depth InputOutput ] keep
+        [ depth>> InputOutput ] keep
-        [ XVisualInfo-visual create-window-mask ] keep
+        [ visual>> create-window-mask ] keep
         window-attributes XCreateWindow
         dup
     ] dip auto-position ;