1 ! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.c-types hashtables kernel math math.vectors
4 math.bitwise namespaces sequences x11.xlib x11.constants x11.glx
8 : create-window-mask ( -- n )
9 { CWBackPixel CWBorderPixel CWColormap CWEventMask } flags ;
11 : create-colormap ( visinfo -- colormap )
12 dpy get root get rot XVisualInfo-visual AllocNone
30 : window-attributes ( visinfo -- attributes )
31 "XSetWindowAttributes" <c-object>
32 0 over set-XSetWindowAttributes-background_pixel
33 0 over set-XSetWindowAttributes-border_pixel
34 [ [ create-colormap ] dip set-XSetWindowAttributes-colormap ] keep
35 event-mask over set-XSetWindowAttributes-event_mask ;
37 : set-size-hints ( window -- )
38 "XSizeHints" <c-object>
39 USPosition over set-XSizeHints-flags
40 [ dpy get ] 2dip XSetWMNormalHints ;
42 : auto-position ( window loc -- )
43 { 0 0 } = [ drop ] [ set-size-hints ] if ;
45 : >xy ( pair -- x y ) first2 [ >integer ] bi@ ;
47 : create-window ( loc dim visinfo -- window )
49 [ [ [ dpy get root get ] dip >xy ] dip { 1 1 } vmax >xy 0 ] dip
50 [ XVisualInfo-depth InputOutput ] keep
51 [ XVisualInfo-visual create-window-mask ] keep
52 window-attributes XCreateWindow
56 : glx-window ( loc dim -- window glx )
57 GLX_DOUBLEBUFFER 1array choose-visual
58 [ create-window ] keep
62 : create-pixmap ( dim visual -- pixmap )
63 [ [ { 0 0 } swap ] dip create-window ] [
64 drop [ dpy get ] 2dip first2 24 XCreatePixmap
65 [ "Failed to create offscreen pixmap" throw ] unless*
68 : (create-glx-pixmap) ( pixmap visual -- pixmap glx-pixmap )
70 [ dpy get ] 2dip swap glXCreateGLXPixmap
71 [ "Failed to create offscreen GLXPixmap" throw ] unless*
74 : create-glx-pixmap ( dim visual -- pixmap glx-pixmap )
75 [ create-pixmap ] [ (create-glx-pixmap) ] bi ;
77 : glx-pixmap ( dim -- glx pixmap glx-pixmap )
79 [ nip create-glx ] [ create-glx-pixmap ] [ nip XFree ] 2tri ;
81 : destroy-window ( win -- )
82 dpy get swap XDestroyWindow drop ;
84 : set-closable ( win -- )
85 dpy get swap "WM_DELETE_WINDOW" x-atom <Atom> 1
86 XSetWMProtocols drop ;
88 : map-window ( win -- ) dpy get swap XMapWindow drop ;
90 : unmap-window ( win -- ) dpy get swap XUnmapWindow drop ;
92 : pixmap-bits ( dim pixmap -- alien )
93 swap first2 '[ dpy get _ 0 0 _ _ AllPlanes ZPixmap XGetImage ] call
94 [ XImage-pixels ] [ XDestroyImage drop ] bi ;