diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 9938224d12..676eb4b3a2 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -13,6 +13,7 @@ + io: - httpd fep +- httpd timeouts too quickly? - stream server can hang because of exception handler limitations - better i/o scheduler - out of memory error when printing global namespace diff --git a/library/x11/events.factor b/library/x11/events.factor new file mode 100644 index 0000000000..5ad753d4a8 --- /dev/null +++ b/library/x11/events.factor @@ -0,0 +1,50 @@ +! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +IN: x11 +USING: alien arrays errors gadgets hashtables io kernel math +namespaces prettyprint sequences threads ; + +GENERIC: expose-event ( event window -- ) + +GENERIC: resize-event ( event window -- ) + +GENERIC: button-down-event ( event window -- ) + +GENERIC: button-up-event ( event window -- ) + +GENERIC: motion-event ( event window -- ) + +GENERIC: key-event ( event window -- ) + +GENERIC: client-event ( event window -- ) + +: next-event ( -- event ) + dpy get "XEvent" dup >r XNextEvent drop r> ; + +: mask-event ( mask -- event ) + >r dpy get r> "XEvent" dup >r XMaskEvent drop r> ; + +: events-queued ( mode -- n ) >r dpy get r> XEventsQueued ; + +: next-event ( -- event ) + dpy get "XEvent" dup >r XNextEvent drop r> ; + +: wait-event ( -- event ) + QueuedAfterFlush events-queued 0 > + [ next-event ] [ ui-step wait-event ] if ; + +: handle-event ( event window -- ) + over XAnyEvent-type { + { [ dup Expose = ] [ drop expose-event ] } + { [ dup ConfigureNotify = ] [ drop resize-event ] } + { [ dup ButtonPress = ] [ drop button-down-event ] } + { [ dup ButtonRelease = ] [ drop button-up-event ] } + { [ dup MotionNotify = ] [ drop motion-event ] } + { [ dup KeyPress = ] [ drop key-event ] } + { [ dup ClientMessage = ] [ drop client-event ] } + { [ t ] [ 3drop ] } + } cond ; + +: event-loop ( -- ) + wait-event dup XAnyEvent-window windows get hash dup + [ handle-event ] [ 2drop ] if event-loop ; diff --git a/library/x11/glx-utils.factor b/library/x11/glx-utils.factor new file mode 100644 index 0000000000..daa9caff13 --- /dev/null +++ b/library/x11/glx-utils.factor @@ -0,0 +1,18 @@ +! Copyright (C) 2005, 2006 Eduardo Cavazos +! See http://factorcode.org/license.txt for BSD license. +IN: x11 +USING: alien arrays errors kernel namespaces sequences ; + +: >int-array ( seq -- ) + dup length dup "int" -rot + [ pick set-int-nth ] 2each ; + +: choose-visual ( -- XVisualInfo* ) + dpy get scr get + GLX_RGBA GLX_DOUBLEBUFFER 0 3array >int-array + glXChooseVisual + [ "Could not get a double-buffered GLX RGBA visual" throw ] unless* ; + +: create-context ( XVisualInfo* -- GLXContext ) + >r dpy get r> f 1 glXCreateContext + [ "Failed to create GLX context" throw ] unless* ; diff --git a/library/x11/load.factor b/library/x11/load.factor index dfa709b8fe..388ed46a16 100644 --- a/library/x11/load.factor +++ b/library/x11/load.factor @@ -7,6 +7,9 @@ USING: kernel parser words compiler sequences ; "/library/x11/glx.factor" "/library/x11/constants.factor" "/library/x11/utilities.factor" + "/library/x11/events.factor" + "/library/x11/windows.factor" + "/library/x11/glx-utils.factor" "/library/x11/ui.factor" } [ run-resource ] each diff --git a/library/x11/ui.factor b/library/x11/ui.factor index b30bd6b332..a2025db6b0 100644 --- a/library/x11/ui.factor +++ b/library/x11/ui.factor @@ -1,8 +1,14 @@ +! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov +! See http://factorcode.org/license.txt for BSD license. IN: x11 USING: arrays errors freetype gadgets gadgets-launchpad gadgets-layouts gadgets-listener hashtables kernel kernel-internals math namespaces opengl sequences x11 ; +! In the X11 backend, world-handle is a pair { window context }. +! The window is an X11 window ID, and the context is a +! GLX context pointer. + M: world expose-event ( event world -- ) nip draw-world ; M: world resize-event ( event world -- ) @@ -23,9 +29,21 @@ M: world motion-event ( event world -- ) M: world key-event ( event world -- ) 2drop ; +: close-box? ( event -- ) + dup XClientMessageEvent-type "WM_PROTOCOLS" x-atom = + swap XClientMessageEvent-data "WM_DELETE_WINDOW" x-atom = + and ; + +M: world client-event ( event world -- ) + swap close-box? [ + dup close-world world-handle destroy-window* + ] [ + drop + ] if ; + : gadget-window ( world -- window ) dup rect-dim first2 choose-visual [ - create-window 2dup windows get set-hash dup map-window + create-window 2dup map-window* ] keep create-context 2array swap set-world-handle ; IN: gadgets diff --git a/library/x11/utilities.factor b/library/x11/utilities.factor index eacf2afb0a..8d76590348 100644 --- a/library/x11/utilities.factor +++ b/library/x11/utilities.factor @@ -4,125 +4,19 @@ IN: x11 USING: alien arrays errors gadgets hashtables io kernel math namespaces prettyprint sequences threads ; +! Global variable; maps X11 window handles to objects responding +! to the event protocol in /library/x11/events.factor +SYMBOL: windows + SYMBOL: dpy SYMBOL: scr SYMBOL: root -! Window management -: create-window-mask ( -- n ) - CWBackPixel CWBorderPixel bitor - CWColormap bitor CWEventMask bitor ; - -: create-colormap ( visinfo -- colormap ) - dpy get root get rot XVisualInfo-visual AllocNone - XCreateColormap ; - -: event-mask ( -- n ) - StructureNotifyMask ExposureMask bitor - KeyPressMask bitor - KeyReleaseMask bitor - ButtonPressMask bitor - ButtonReleaseMask bitor - PointerMotionMask bitor ; - -: window-attributes ( visinfo -- attributes ) - "XSetWindowAttributes" - 0 over set-XSetWindowAttributes-background_pixel - 0 over set-XSetWindowAttributes-border_pixel - [ >r create-colormap r> set-XSetWindowAttributes-colormap ] keep - event-mask over set-XSetWindowAttributes-event_mask ; - -: create-window ( w h visinfo -- window ) - >r >r >r dpy get root get 0 0 r> r> 0 r> - [ XVisualInfo-depth InputOutput ] keep - [ XVisualInfo-visual create-window-mask ] keep - window-attributes XCreateWindow ; - -: destroy-window ( win -- ) - dpy get swap XDestroyWindow drop ; - -: map-window ( win -- ) - dpy get swap XMapWindow drop ; - -: map-subwindows ( win -- ) - dpy get swap XMapSubwindows drop ; - -: unmap-window ( win -- ) - dpy get swap XUnmapWindow drop ; - -: unmap-subwindows ( win -- ) - dpy get swap XUnmapSubwindows drop ; - -! Event handling - -: select-input ( win mask -- ) - >r dpy get swap r> XSelectInput drop ; - : flush-dpy ( -- ) dpy get XFlush drop ; : sync-dpy ( discard -- ) >r dpy get r> XSync ; -: next-event ( -- event ) - dpy get "XEvent" dup >r XNextEvent drop r> ; - -: mask-event ( mask -- event ) - >r dpy get r> "XEvent" dup >r XMaskEvent drop r> ; - -: events-queued ( mode -- n ) >r dpy get r> XEventsQueued ; - -: next-event ( -- event ) - dpy get "XEvent" dup >r XNextEvent drop r> ; - -: wait-event ( -- event ) - QueuedAfterFlush events-queued 0 > - [ next-event ] [ ui-step wait-event ] if ; - -GENERIC: expose-event ( event window -- ) - -GENERIC: resize-event ( event window -- ) - -GENERIC: button-down-event ( event window -- ) - -GENERIC: button-up-event ( event window -- ) - -GENERIC: motion-event ( event window -- ) - -GENERIC: key-event ( event window -- ) - -: handle-event ( event window -- ) - over XAnyEvent-type { - { [ dup Expose = ] [ drop expose-event ] } - { [ dup ConfigureNotify = ] [ drop resize-event ] } - { [ dup ButtonPress = ] [ drop button-down-event ] } - { [ dup ButtonRelease = ] [ drop button-up-event ] } - { [ dup MotionNotify = ] [ drop motion-event ] } - { [ dup KeyPress = ] [ drop key-event ] } - { [ t ] [ 3drop ] } - } cond ; - -SYMBOL: windows - -: event-loop ( -- ) - wait-event dup XAnyEvent-window windows get hash dup - [ handle-event ] [ 2drop ] if event-loop ; - -! GLX - -: >int-array ( seq -- ) - dup length dup "int" -rot - [ pick set-int-nth ] 2each ; - -: choose-visual ( -- XVisualInfo* ) - dpy get scr get - GLX_RGBA GLX_DOUBLEBUFFER 0 3array >int-array - glXChooseVisual - [ "Could not get a double-buffered GLX RGBA visual" throw ] unless* ; - -: create-context ( XVisualInfo* -- GLXContext ) - >r dpy get r> f 1 glXCreateContext - [ "Failed to create GLX context" throw ] unless* ; - -! Initialization +: x-atom ( string -- atom ) dpy get swap 0 XInternAtom ; : check-display [ "Cannot connect to X server - check $DISPLAY" throw ] unless* ; diff --git a/library/x11/windows.factor b/library/x11/windows.factor new file mode 100644 index 0000000000..e1a3564820 --- /dev/null +++ b/library/x11/windows.factor @@ -0,0 +1,54 @@ +! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +IN: x11 +USING: alien hashtables kernel math namespaces ; + +: create-window-mask ( -- n ) + CWBackPixel CWBorderPixel bitor + CWColormap bitor CWEventMask bitor ; + +: create-colormap ( visinfo -- colormap ) + dpy get root get rot XVisualInfo-visual AllocNone + XCreateColormap ; + +: event-mask ( -- n ) + StructureNotifyMask ExposureMask bitor + KeyPressMask bitor + KeyReleaseMask bitor + ButtonPressMask bitor + ButtonReleaseMask bitor + PointerMotionMask bitor ; + +: window-attributes ( visinfo -- attributes ) + "XSetWindowAttributes" + 0 over set-XSetWindowAttributes-background_pixel + 0 over set-XSetWindowAttributes-border_pixel + [ >r create-colormap r> set-XSetWindowAttributes-colormap ] keep + event-mask over set-XSetWindowAttributes-event_mask ; + +: create-window ( w h visinfo -- window ) + >r >r >r dpy get root get 0 0 r> r> 0 r> + [ XVisualInfo-depth InputOutput ] keep + [ XVisualInfo-visual create-window-mask ] keep + window-attributes XCreateWindow ; + +: destroy-window ( win -- ) + dpy get swap XDestroyWindow drop ; + +: destroy-window* ( win -- ) + dup windows get remove-hash destroy-window ; + +: map-window ( win -- ) + dpy get swap XMapWindow drop ; + +: map-window* ( world win -- ) + [ windows get set-hash ] keep map-window ; + +: map-subwindows ( win -- ) + dpy get swap XMapSubwindows drop ; + +: unmap-window ( win -- ) + dpy get swap XUnmapWindow drop ; + +: unmap-subwindows ( win -- ) + dpy get swap XUnmapSubwindows drop ; diff --git a/library/x11/xlib.factor b/library/x11/xlib.factor index a92e7701f9..2d87d3f59e 100644 --- a/library/x11/xlib.factor +++ b/library/x11/xlib.factor @@ -937,6 +937,7 @@ BEGIN-STRUCT: XClientMessageEvent FIELD: Window window FIELD: Atom message_type FIELD: int format + FIELD: long data ! union { ! char b[20]; ! short s[10];