2006-03-21 23:32:02 -05:00
|
|
|
! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
IN: x11
|
2006-05-27 17:39:38 -04:00
|
|
|
USING: alien gadgets hashtables kernel math namespaces sequences ;
|
2006-03-21 23:32:02 -05:00
|
|
|
|
|
|
|
: 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 )
|
2006-03-23 16:14:53 -05:00
|
|
|
ExposureMask
|
|
|
|
StructureNotifyMask bitor
|
2006-03-21 23:32:02 -05:00
|
|
|
KeyPressMask bitor
|
|
|
|
KeyReleaseMask bitor
|
|
|
|
ButtonPressMask bitor
|
|
|
|
ButtonReleaseMask bitor
|
2006-05-28 20:23:54 -04:00
|
|
|
PointerMotionMask bitor
|
|
|
|
FocusChangeMask bitor ;
|
2006-03-21 23:32:02 -05:00
|
|
|
|
|
|
|
: window-attributes ( visinfo -- attributes )
|
|
|
|
"XSetWindowAttributes" <c-object>
|
|
|
|
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 ;
|
|
|
|
|
2006-06-02 19:34:29 -04:00
|
|
|
: set-size-hints ( window -- )
|
|
|
|
"XSizeHints" <c-object>
|
|
|
|
USPosition over set-XSizeHints-flags
|
|
|
|
dpy get -rot XSetNormalWMHints ;
|
|
|
|
|
2006-05-29 02:13:07 -04:00
|
|
|
: create-window ( loc dim visinfo -- window )
|
|
|
|
>r >r >r dpy get root get r> first2 r> first2 0 r>
|
2006-03-21 23:32:02 -05:00
|
|
|
[ XVisualInfo-depth InputOutput ] keep
|
|
|
|
[ XVisualInfo-visual create-window-mask ] keep
|
2006-06-02 19:34:29 -04:00
|
|
|
window-attributes XCreateWindow
|
|
|
|
dup size-size-hints ;
|
|
|
|
|
2006-05-29 02:13:07 -04:00
|
|
|
: glx-window ( loc dim -- window context )
|
|
|
|
choose-visual
|
|
|
|
[ create-window ] keep [ create-context ] keep
|
|
|
|
XFree ;
|
2006-03-21 23:32:02 -05:00
|
|
|
|
|
|
|
: destroy-window ( win -- )
|
|
|
|
dpy get swap XDestroyWindow drop ;
|
|
|
|
|
2006-03-23 16:24:26 -05:00
|
|
|
: destroy-window* ( win context -- )
|
2006-05-29 00:27:11 -04:00
|
|
|
destroy-context dup unregister-window destroy-window ;
|
2006-03-23 16:24:26 -05:00
|
|
|
|
2006-03-22 02:27:07 -05:00
|
|
|
: set-closable ( win -- )
|
|
|
|
dpy get swap "WM_DELETE_WINDOW" x-atom <Atom> 1
|
|
|
|
XSetWMProtocols drop ;
|
2006-03-21 23:32:02 -05:00
|
|
|
|
2006-03-22 02:07:21 -05:00
|
|
|
: map-window ( win -- ) dpy get swap XMapWindow drop ;
|
2006-03-21 23:32:02 -05:00
|
|
|
|
2006-05-26 02:58:11 -04:00
|
|
|
: map-window* ( world win -- ) dup set-closable map-window ;
|
2006-03-21 23:32:02 -05:00
|
|
|
|
2006-03-22 02:07:21 -05:00
|
|
|
: unmap-window ( win -- ) dpy get swap XUnmapWindow drop ;
|