2006-03-19 19:37:01 -05:00
|
|
|
! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
IN: x11
|
2006-03-20 00:05:04 -05:00
|
|
|
USING: alien arrays errors gadgets hashtables io kernel math
|
|
|
|
namespaces prettyprint sequences threads ;
|
2006-03-19 19:37:01 -05:00
|
|
|
|
2006-07-23 21:38:58 -04:00
|
|
|
: >int-array ( seq -- <int-array> )
|
|
|
|
dup length dup "int" <c-array> -rot
|
|
|
|
[ pick set-int-nth ] 2each ;
|
|
|
|
|
2006-03-19 19:37:01 -05:00
|
|
|
SYMBOL: dpy
|
|
|
|
SYMBOL: scr
|
|
|
|
SYMBOL: root
|
|
|
|
|
|
|
|
: flush-dpy ( -- ) dpy get XFlush drop ;
|
|
|
|
|
|
|
|
: sync-dpy ( discard -- ) >r dpy get r> XSync ;
|
|
|
|
|
2006-03-21 23:32:02 -05:00
|
|
|
: x-atom ( string -- atom ) dpy get swap 0 XInternAtom ;
|
2006-03-19 23:17:14 -05:00
|
|
|
|
|
|
|
: check-display
|
|
|
|
[ "Cannot connect to X server - check $DISPLAY" throw ] unless* ;
|
|
|
|
|
2006-03-20 00:05:04 -05:00
|
|
|
: initialize-x ( display-string -- )
|
2006-08-01 19:25:12 -04:00
|
|
|
dup [ string>char-alien ] when
|
2006-06-03 22:21:14 -04:00
|
|
|
XOpenDisplay check-display dpy set-global
|
|
|
|
dpy get XDefaultScreen scr set-global
|
|
|
|
dpy get scr get XRootWindow root set-global ;
|
2006-03-19 23:17:14 -05:00
|
|
|
|
2006-03-22 17:22:05 -05:00
|
|
|
: close-x ( -- ) dpy get XCloseDisplay drop ;
|
|
|
|
|
2006-03-20 00:05:04 -05:00
|
|
|
: with-x ( display-string quot -- )
|
2006-06-03 22:21:14 -04:00
|
|
|
>r initialize-x r> [ close-x ] cleanup ;
|