factor/basis/x11/windows/windows.factor

91 lines
2.6 KiB
Factor
Raw Normal View History

2010-06-02 02:58:48 -04:00
! Copyright (C) 2005, 2010 Eduardo Cavazos, Slava Pestov.
2007-09-20 18:09:08 -04:00
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.data classes.struct fry kernel literals math
math.vectors namespaces sequences x11 x11.X x11.events x11.glx
x11.xlib ;
2007-09-20 18:09:08 -04:00
IN: x11.windows
CONSTANT: create-window-mask
flags{ CWBackPixel CWBorderPixel CWColormap CWEventMask }
2007-09-20 18:09:08 -04:00
: create-colormap ( visinfo -- colormap )
[ dpy get root get ] dip visual>> AllocNone
2007-09-20 18:09:08 -04:00
XCreateColormap ;
CONSTANT: event-mask
flags{
2008-02-02 14:29:09 -05:00
ExposureMask
StructureNotifyMask
KeyPressMask
KeyReleaseMask
ButtonPressMask
ButtonReleaseMask
PointerMotionMask
FocusChangeMask
EnterWindowMask
LeaveWindowMask
PropertyChangeMask
}
2007-09-20 18:09:08 -04:00
: window-attributes ( visinfo -- attributes )
XSetWindowAttributes <struct>
0 >>background_pixel
0 >>border_pixel
event-mask >>event_mask
swap create-colormap >>colormap ;
2007-09-20 18:09:08 -04:00
: set-size-hints ( window -- )
XSizeHints <struct>
USPosition >>flags
2009-01-23 19:20:47 -05:00
[ dpy get ] 2dip XSetWMNormalHints ;
2007-09-20 18:09:08 -04:00
: auto-position ( window loc -- )
{ 0 0 } = [ drop ] [ set-size-hints ] if ;
2009-03-02 03:55:54 -05:00
: >xy ( pair -- x y ) first2 [ >integer ] bi@ ;
2007-09-20 18:09:08 -04:00
: create-window ( loc dim visinfo -- window )
2008-12-15 21:34:57 -05:00
pick [
2009-03-02 03:55:54 -05:00
[ [ [ dpy get root get ] dip >xy ] dip { 1 1 } vmax >xy 0 ] dip
[ depth>> InputOutput ] keep
[ visual>> create-window-mask ] keep
2008-12-15 21:34:57 -05:00
window-attributes XCreateWindow
dup
] dip auto-position ;
2007-09-20 18:09:08 -04:00
2009-05-02 17:39:31 -04:00
: glx-window ( loc dim visual -- window glx )
[ create-window ] [ create-glx ] bi ;
2007-09-20 18:09:08 -04:00
2008-12-11 19:50:37 -05:00
: create-pixmap ( dim visual -- pixmap )
[ [ { 0 0 } swap ] dip create-window ] [
drop [ dpy get ] 2dip first2 24 XCreatePixmap
[ "Failed to create offscreen pixmap" throw ] unless*
] 2bi ;
: (create-glx-pixmap) ( pixmap visual -- pixmap glx-pixmap )
[ drop ] [
[ dpy get ] 2dip swap glXCreateGLXPixmap
[ "Failed to create offscreen GLXPixmap" throw ] unless*
] 2bi ;
: create-glx-pixmap ( dim visual -- pixmap glx-pixmap )
[ create-pixmap ] [ (create-glx-pixmap) ] bi ;
2009-05-02 17:39:31 -04:00
: glx-pixmap ( dim visual -- glx pixmap glx-pixmap )
[ nip create-glx ] [ create-glx-pixmap ] 2bi ;
2008-12-11 19:50:37 -05:00
2007-09-20 18:09:08 -04:00
: destroy-window ( win -- )
dpy get swap XDestroyWindow drop ;
: set-closable ( win -- )
dpy get swap XA_WM_DELETE_WINDOW Atom <ref> 1
2007-09-20 18:09:08 -04:00
XSetWMProtocols drop ;
: map-window ( win -- ) dpy get swap XMapWindow drop ;
: unmap-window ( win -- ) dpy get swap XUnmapWindow drop ;
2008-12-11 19:50:37 -05:00
: pixmap-bits ( dim pixmap -- alien )
swap first2 '[ dpy get _ 0 0 _ _ AllPlanes ZPixmap XGetImage ] call
[ XImage-pixels ] [ XDestroyImage drop ] bi ;