fonts handle
window-loc ;
-TUPLE: offscreen-world < world ;
-
: find-world ( gadget -- world/f ) [ world? ] find-parent ;
: show-status ( string/f gadget -- )
: <world> ( gadget title status -- world )
world new-world ;
-: <offscreen-world> ( gadget title status -- world )
- offscreen-world new-world ;
M: world layout*
dup call-next-method
: XA_NET_WM_NAME ( -- atom ) "_NET_WM_NAME" x-atom ;
-TUPLE: x11-handle window glx xic ;
+TUPLE: x11-handle-base glx ;
+TUPLE: x11-handle < x11-handle-base xic window ;
+TUPLE: x11-pixmap-handle < x11-handle-base pixmap glx-pixmap ;
C: <x11-handle> x11-handle
+C: <x11-pixmap-handle> x11-pixmap-handle
M: world expose-event nip relayout ;
: gadget-window ( world -- )
dup window-loc>> over rect-dim glx-window
- over "Factor" create-xic <x11-handle>
+ over "Factor" create-xic rot <x11-handle>
2dup window>> register-window
>>handle drop ;
M: x11-handle select-gl-context ( handle -- )
dpy get swap
- dup window>> swap glx>> glXMakeCurrent
+ [ window>> ] [ glx>> ] bi glXMakeCurrent
[ "Failed to set current GLX context" throw ] unless ;
M: x11-handle flush-gl-context ( handle -- )
dpy get swap window>> glXSwapBuffers ;
+M: x11-pixmap-handle select-gl-context ( handle -- )
+ dpy get swap
+ [ glx-pixmap>> ] [ glx>> ] bi glXMakeCurrent
+ [ "Failed to set current GLX context" throw ] unless ;
+
+M: x11-pixmap-handle flush-gl-context ( handle -- )
+ drop ;
+
+M: x11-ui-backend (open-offscreen-buffer) ( world -- )
+ dup dim>> glx-pixmap <x11-pixmap-handle> >>handle drop ;
+M: x11-ui-backend (close-offscreen-buffer) ( handle -- )
+ dpy get swap
+ [ glx-pixmap>> glXDestroyGLXPixmap ]
+ [ pixmap>> XFreePixmap drop ]
+ [ glx>> glXDestroyContext ] 2tri ;
+
+M: x11-ui-backend offscreen-pixels ( world -- alien w h )
+ [ [ dim>> ] [ handle>> pixmap>> ] bi pixmap-bits ] [ dim>> first2 ] bi ;
+
M: x11-ui-backend ui ( -- )
[
f [
FUNCTION: void* glXGetProcAddressARB ( char* procname ) ;
! GLX Events
-! (also skipped for now. only has GLXPbufferClobberEvent, the rest is handled by xlib methinks
+! (also skipped for now. only has GLXPbufferClobberEvent, the rest is handled by xlib methinks)
-: choose-visual ( -- XVisualInfo* )
- dpy get scr get
+: choose-visual ( flags -- XVisualInfo* )
+ [ dpy get scr get ] dip
[
+ %
GLX_RGBA ,
- GLX_DOUBLEBUFFER ,
GLX_DEPTH_SIZE , 16 ,
0 ,
] int-array{ } make underlying>>
[ "Could not get a double-buffered GLX RGBA visual" throw ] unless* ;
: create-glx ( XVisualInfo* -- GLXContext )
- >r dpy get r> f 1 glXCreateContext
+ [ dpy get ] dip f 1 glXCreateContext
[ "Failed to create GLX context" throw ] unless* ;
: destroy-glx ( GLXContext -- )
- dpy get swap glXDestroyContext ;
\ No newline at end of file
+ dpy get swap glXDestroyContext ;
! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types hashtables kernel math math.vectors
-math.bitwise namespaces sequences x11.xlib x11.constants x11.glx ;
+math.bitwise namespaces sequences x11.xlib x11.constants x11.glx
+arrays fry ;
IN: x11.windows
: create-window-mask ( -- n )
dup r> auto-position ;
: glx-window ( loc dim -- window glx )
- choose-visual
+ GLX_DOUBLEBUFFER 1array choose-visual
[ create-window ] keep
[ create-glx ] keep
XFree ;
+: 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 ;
+
+: glx-pixmap ( dim -- glx pixmap glx-pixmap )
+ { } choose-visual
+ [ nip create-glx ] [ create-glx-pixmap ] [ nip XFree ] 2tri ;
+
: destroy-window ( win -- )
dpy get swap XDestroyWindow drop ;
: map-window ( win -- ) dpy get swap XMapWindow drop ;
: unmap-window ( win -- ) dpy get swap XUnmapWindow drop ;
+
+: pixmap-bits ( dim pixmap -- alien )
+ swap first2 '[ dpy get _ 0 0 _ _ AllPlanes ZPixmap XGetImage ] call
+ [ XImage-pixels ] [ XDestroyImage drop ] bi ;
FUNCTION: int XConvertSelection ( Display* display, Atom selection, Atom target, Atom property, Window requestor, Time time ) ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! 5 - Pixmap and Cursor Functions
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+! 5.1 - Creating and Freeing Pixmaps
+
+FUNCTION: Pixmap XCreatePixmap ( Display* display, Drawable d, uint width, uint height, uint depth ) ;
+FUNCTION: int XFreePixmap ( Display* display, Pixmap pixmap ) ;
+
+
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 6 - Color Management Functions
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
char* string,
int length ) ;
+! 8.7 - Transferring Images between Client and Server
+
+: XYBitmap 0 ; inline
+: XYPixmap 1 ; inline
+: ZPixmap 2 ; inline
+: AllPlanes -1 ; inline
+
+C-STRUCT: XImage-funcs
+ { "void*" "create_image" }
+ { "void*" "destroy_image" }
+ { "void*" "get_pixel" }
+ { "void*" "put_pixel" }
+ { "void*" "sub_image" }
+ { "void*" "add_pixel" } ;
+
+C-STRUCT: XImage
+ { "int" "width" }
+ { "int" "height" }
+ { "int" "xoffset" }
+ { "int" "format" }
+ { "char*" "data" }
+ { "int" "byte_order" }
+ { "int" "bitmap_unit" }
+ { "int" "bitmap_bit_order" }
+ { "int" "bitmap_pad" }
+ { "int" "depth" }
+ { "int" "bytes_per_line" }
+ { "int" "bits_per_pixel" }
+ { "ulong" "red_mask" }
+ { "ulong" "green_mask" }
+ { "ulong" "blue_mask" }
+ { "XPointer" "obdata" }
+ { "XImage-funcs" "f" } ;
+
+FUNCTION: XImage* XGetImage ( Display* display, Drawable d, int x, int y, uint width, uint height, ulong plane_mask, int format ) ;
+FUNCTION: int XDestroyImage ( XImage *ximage ) ;
+
+: XImage-size ( ximage -- size )
+ [ XImage-height ] [ XImage-bytes_per_line ] bi * ;
+
+: XImage-pixels ( ximage -- byte-array )
+ [ XImage-data ] [ XImage-size ] bi memory>byte-array ;
+
!
! 9 - Window and Session Manager Functions
!
[ reset-world ] tri ;
: open-offscreen ( gadget -- world )
- "" f <offscreen-world> [ open-world-window ] keep
+ "" f <offscreen-world>
+ [ open-world-window dup relayout-1 ] keep
notify-queued ;
: close-offscreen ( world -- )
projects / factor.git / commitdiff