Merge branch 'master' of git://repo.or.cz/factor/jcg

basis/cocoa/views/views.factor

@@ -55,10 +55,9 @@ PRIVATE>
 : with-multisample ( quot -- )
     t +multisample+ pick with-variable ; inline
 
-: <PixelFormat> ( -- pixelfmt )
+: <PixelFormat> ( attributes -- pixelfmt )
-    NSOpenGLPixelFormat -> alloc [
+    NSOpenGLPixelFormat -> alloc swap [
-        NSOpenGLPFAWindow ,
+        %
-        NSOpenGLPFADoubleBuffer ,
         NSOpenGLPFADepthSize , 16 ,
         +software-renderer+ get [
             NSOpenGLPFARendererID , kCGLRendererGenericFloatID ,
@@ -74,7 +73,8 @@ PRIVATE>
     -> autorelease ;
 
 : <GLView> ( class dim -- view )
-    [ -> alloc 0 0 ] dip first2 <NSRect> <PixelFormat>
+    [ -> alloc 0 0 ] dip first2 <NSRect>
+    NSOpenGLPFAWindow NSOpenGLPFADoubleBuffer 2array <PixelFormat>
     -> initWithFrame:pixelFormat:
     dup 1 -> setPostsBoundsChangedNotifications:
     dup 1 -> setPostsFrameChangedNotifications: ;

basis/ui/backend/backend.factor

@@ -17,11 +17,17 @@ HOOK: (open-window) ui-backend ( world -- )
 
 HOOK: (close-window) ui-backend ( handle -- )
 
+HOOK: (open-offscreen-buffer) ui-backend ( world -- )
+
+HOOK: (close-offscreen-buffer) ui-backend ( handle -- )
+
 HOOK: raise-window* ui-backend ( world -- )
 
-HOOK: select-gl-context ui-backend ( handle -- )
+GENERIC: select-gl-context ( handle -- )
 
-HOOK: flush-gl-context ui-backend ( handle -- )
+GENERIC: flush-gl-context ( handle -- )
+
+HOOK: offscreen-pixels ui-backend ( world -- alien w h )
 
 HOOK: beep ui-backend ( -- )
 

basis/ui/cocoa/cocoa.factor

@@ -3,15 +3,18 @@
 USING: accessors math arrays assocs cocoa cocoa.application
 command-line kernel memory namespaces cocoa.messages
 cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
-cocoa.windows cocoa.classes cocoa.application cocoa.nibs
+cocoa.windows cocoa.classes cocoa.nibs sequences system
-sequences system ui ui.backend ui.clipboards ui.gadgets
+ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
-ui.gadgets.worlds ui.cocoa.views core-foundation threads
+ui.cocoa.views core-foundation threads math.geometry.rect fry
-math.geometry.rect fry ;
+libc generalizations alien.c-types cocoa.views combinators ;
 IN: ui.cocoa
 
-TUPLE: handle view window ;
+TUPLE: handle ;
+TUPLE: window-handle < handle view window ;
+TUPLE: offscreen-handle < handle context buffer ;
 
-C: <handle> handle
+C: <window-handle> window-handle
+C: <offscreen-handle> offscreen-handle
 
 SINGLETON: cocoa-ui-backend
 
@@ -39,7 +42,8 @@ M: pasteboard set-clipboard-contents
 : gadget-window ( world -- )
     dup <FactorView>
     2dup swap world>NSRect <ViewWindow>
-    [ [ -> release ] [ install-window-delegate ] bi* ] [ <handle> ] 2bi
+    [ [ -> release ] [ install-window-delegate ] bi* ]
+    [ <window-handle> ] 2bi
     >>handle drop ;
 
 M: cocoa-ui-backend set-title ( string world -- )
@@ -88,11 +92,39 @@ M: cocoa-ui-backend raise-window* ( world -- )
         NSApp 1 -> activateIgnoringOtherApps:
     ] when* ;
 
-M: cocoa-ui-backend select-gl-context ( handle -- )
+: pixel-size ( pixel-format -- size )
-    view>> -> openGLContext -> makeCurrentContext ;
+    0 <int> [ NSOpenGLPFAColorSize 0 -> getValues:forAttribute:forVirtualScreen: ]
+    keep *int -3 shift ;
 
-M: cocoa-ui-backend flush-gl-context ( handle -- )
+: offscreen-buffer ( world pixel-format -- alien w h pitch )
-    view>> -> openGLContext -> flushBuffer ;
+    [ dim>> first2 ] [ pixel-size ] bi*
+    { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ;
+
+: gadget-offscreen-context ( world -- context buffer )
+    NSOpenGLPFAOffScreen 1array <PixelFormat>
+    [ nip NSOpenGLContext -> alloc swap f -> initWithFormat:shareContext: dup ]
+    [ offscreen-buffer ] 2bi
+    4 npick [ -> setOffScreen:width:height:rowbytes: ] dip ;
+
+M: cocoa-ui-backend (open-offscreen-buffer) ( world -- )
+    dup gadget-offscreen-context <offscreen-handle> >>handle drop ;
+
+M: cocoa-ui-backend (close-offscreen-buffer) ( handle -- )
+    [ context>> -> release ]
+    [ buffer>> free ] bi ;
+
+GENERIC: (gl-context) ( handle -- context )
+M: window-handle (gl-context) view>> -> openGLContext ;
+M: offscreen-handle (gl-context) context>> ;
+
+M: handle select-gl-context ( handle -- )
+    (gl-context) -> makeCurrentContext ;
+
+M: handle flush-gl-context ( handle -- )
+    (gl-context) -> flushBuffer ;
+
+M: cocoa-ui-backend offscreen-pixels ( world -- alien w h )
+    [ handle>> buffer>> ] [ dim>> first2 neg ] bi ;
 
 M: cocoa-ui-backend beep ( -- )
     NSBeep ;

basis/ui/gadgets/worlds/worlds.factor

@@ -38,8 +38,8 @@ M: world request-focus-on ( child gadget -- )
     2dup eq?
     [ 2drop ] [ dup focused?>> (request-focus) ] if ;
 
-: <world> ( gadget title status -- world )
+: new-world ( gadget title status class -- world )
-    { 0 1 } world new-track
+    { 0 1 } swap new-track
         t >>root?
         t >>active?
         H{ } clone >>fonts
@@ -49,6 +49,9 @@ M: world request-focus-on ( child gadget -- )
         swap 1 track-add
     dup request-focus ;
 
+: <world> ( gadget title status -- world )
+    world new-world ;
+
 M: world layout*
     dup call-next-method
     dup glass>> [

basis/ui/ui.factor

@@ -60,23 +60,26 @@ SYMBOL: stop-after-last-window?
     focus-path f swap focus-gestures ;
 
 M: world graft*
-    dup (open-window)
+    [ (open-window) ]
-    dup title>> over set-title
+    [ [ title>> ] keep set-title ]
-    request-focus ;
+    [ request-focus ] tri ;
 
 : reset-world ( world -- )
     #! This is used when a window is being closed, but also
     #! when restoring saved worlds on image startup.
-    dup fonts>> clear-assoc
+    [ fonts>> clear-assoc ]
-    dup unfocus-world
+    [ unfocus-world ]
-    f >>handle drop ;
+    [ f >>handle drop ] tri ;
+
+: (ungraft-world) ( world -- )
+    [ free-fonts ]
+    [ hand-clicked close-global ]
+    [ hand-gadget close-global ] tri ;
 
 M: world ungraft*
-    dup free-fonts
+    [ (ungraft-world) ]
-    dup hand-clicked close-global
+    [ handle>> (close-window) ]
-    dup hand-gadget close-global
+    [ reset-world ] tri ;
-    dup handle>> (close-window)
-    reset-world ;
 
 : find-window ( quot -- world )
     windows get values

basis/ui/windows/windows.factor

@@ -6,7 +6,7 @@ ui.gadgets ui.backend ui.clipboards ui.gadgets.worlds
 ui.gestures io kernel math math.vectors namespaces make
 sequences strings vectors words windows.kernel32 windows.gdi32
 windows.user32 windows.opengl32 windows.messages windows.types
-windows.nt windows threads libc combinators
+windows.nt windows threads libc combinators fry
 combinators.short-circuit continuations command-line shuffle
 opengl ui.render ascii math.bitwise locals symbols accessors
 math.geometry.rect math.order ascii calendar
@@ -70,9 +70,11 @@ M: pasteboard set-clipboard-contents drop copy ;
     <pasteboard> clipboard set-global
     <clipboard> selection set-global ;
 
-! world-handle is a <win>
+TUPLE: win-base hDC hRC ;
-TUPLE: win hWnd hDC hRC world title ;
+TUPLE: win < win-base hWnd world title ;
+TUPLE: win-offscreen < win-base hBitmap bits ;
 C: <win> win
+C: <win-offscreen> win-offscreen
 
 SYMBOLS: msg-obj class-name-ptr mouse-captured ;
 
@@ -479,8 +481,8 @@ M: windows-ui-backend do-events
     f class-name-ptr set-global
     f msg-obj set-global ;
 
-: setup-pixel-format ( hdc -- )
+: setup-pixel-format ( hdc flags -- )
-    16 make-pfd [ ChoosePixelFormat dup win32-error=0/f ] 2keep
+    32 make-pfd [ ChoosePixelFormat dup win32-error=0/f ] 2keep
     swapd SetPixelFormat win32-error=0/f ;
 
 : get-dc ( hWnd -- hDC ) GetDC dup win32-error=0/f ;
@@ -490,22 +492,73 @@ M: windows-ui-backend do-events
     [ wglMakeCurrent win32-error=0/f ] keep ;
 
 : setup-gl ( hwnd -- hDC hRC )
-    get-dc dup setup-pixel-format dup get-rc ;
+    get-dc dup windowed-pfd-dwFlags setup-pixel-format dup get-rc ;
 
 M: windows-ui-backend (open-window) ( world -- )
-    [ create-window dup setup-gl ] keep
+    [ create-window [ setup-gl ] keep ] keep
     [ f <win> ] keep
     [ swap hWnd>> register-window ] 2keep
     dupd (>>handle)
     hWnd>> show-window ;
 
-M: windows-ui-backend select-gl-context ( handle -- )
+M: win-base select-gl-context ( handle -- )
-    [ hDC>> ] keep hRC>> wglMakeCurrent win32-error=0/f ;
+    [ hDC>> ] keep hRC>> wglMakeCurrent win32-error=0/f
+    GdiFlush drop ;
 
-M: windows-ui-backend flush-gl-context ( handle -- )
+M: win-base flush-gl-context ( handle -- )
     hDC>> SwapBuffers win32-error=0/f ;
 
-! Move window to front
+: (bitmap-info) ( dim -- BITMAPINFO )
+    "BITMAPINFO" <c-object> [
+        BITMAPINFO-bmiHeader {
+            [ nip "BITMAPINFOHEADER" heap-size swap set-BITMAPINFOHEADER-biSize ]
+            [ [ first ] dip set-BITMAPINFOHEADER-biWidth ]
+            [ [ second ] dip set-BITMAPINFOHEADER-biHeight ]
+            [ nip 1 swap set-BITMAPINFOHEADER-biPlanes ]
+            [ nip 32 swap set-BITMAPINFOHEADER-biBitCount ]
+            [ nip BI_RGB swap set-BITMAPINFOHEADER-biCompression ]
+            [ [ first2 * 4 * ] dip set-BITMAPINFOHEADER-biSizeImage ]
+            [ nip 72 swap set-BITMAPINFOHEADER-biXPelsPerMeter ]
+            [ nip 72 swap set-BITMAPINFOHEADER-biYPelsPerMeter ]
+            [ nip 0 swap set-BITMAPINFOHEADER-biClrUsed ]
+            [ nip 0 swap set-BITMAPINFOHEADER-biClrImportant ]
+        } 2cleave
+    ] keep ;
+
+: make-offscreen-dc-and-bitmap ( dim -- hDC hBitmap bits )
+    f CreateCompatibleDC
+    dup rot (bitmap-info) DIB_RGB_COLORS f <void*>
+    [ f 0 CreateDIBSection ] keep *void*
+    [ 2dup SelectObject drop ] dip ;
+
+: setup-offscreen-gl ( dim -- hDC hRC hBitmap bits )
+    make-offscreen-dc-and-bitmap [
+        [ dup offscreen-pfd-dwFlags setup-pixel-format ]
+        [ get-rc ] bi
+    ] 2dip ;
+
+M: windows-ui-backend (open-offscreen-buffer) ( world -- )
+    dup dim>> setup-offscreen-gl <win-offscreen>
+    >>handle drop ;
+M: windows-ui-backend (close-offscreen-buffer) ( handle -- )
+    [ hDC>> DeleteDC drop ]
+    [ hBitmap>> DeleteObject drop ] bi ;
+
+! Windows 32-bit bitmaps don't actually use the alpha byte of
+! each pixel; it's left as zero
+
+: (make-opaque) ( byte-array -- byte-array' )
+    [ length 4 / ]
+    [ '[ 255 swap 4 * 3 + _ set-nth ] each ]
+    [ ] tri ;
+
+: (opaque-pixels) ( world -- pixels )
+    [ handle>> bits>> ] [ dim>> first2 * 4 * ] bi
+    memory>byte-array (make-opaque) ;
+
+M: windows-ui-backend offscreen-pixels ( world -- alien w h )
+    [ (opaque-pixels) ] [ dim>> first2 ] bi ;
+
 M: windows-ui-backend raise-window* ( world -- )
     handle>> [
         hWnd>> SetFocus drop

basis/ui/x11/x11.factor

@@ -14,9 +14,12 @@ SINGLETON: x11-ui-backend
 
 : 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 ;
 
@@ -184,7 +187,7 @@ M: world client-event
 
 : 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 ;
 
@@ -247,14 +250,33 @@ M: x11-ui-backend raise-window* ( world -- )
         dpy get swap window>> XRaiseWindow drop
     ] when* ;
 
-M: x11-ui-backend select-gl-context ( handle -- )
+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-ui-backend flush-gl-context ( handle -- )
+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 [

basis/windows/gdi32/gdi32.factor

@@ -26,6 +26,14 @@ IN: windows.gdi32
 : DC_BRUSH            18 ; inline
 : DC_PEN              19 ; inline
 
+: BI_RGB        0 ; inline
+: BI_RLE8       1 ; inline
+: BI_RLE4       2 ; inline
+: BI_BITFIELDS  3 ; inline
+
+: DIB_RGB_COLORS 0 ; inline
+: DIB_PAL_COLORS 1 ; inline
+
 LIBRARY: gdi32
 
 ! FUNCTION: AbortPath
@@ -75,13 +83,13 @@ FUNCTION: int ChoosePixelFormat ( HDC hDC, PFD* ppfd ) ;
 ! FUNCTION: CreateColorSpaceA
 ! FUNCTION: CreateColorSpaceW
 ! FUNCTION: CreateCompatibleBitmap
-! FUNCTION: CreateCompatibleDC
+FUNCTION: HDC CreateCompatibleDC ( HDC hdc ) ;
 ! FUNCTION: CreateDCA
 ! FUNCTION: CreateDCW
 ! FUNCTION: CreateDIBitmap
 ! FUNCTION: CreateDIBPatternBrush
 ! FUNCTION: CreateDIBPatternBrushPt
-! FUNCTION: CreateDIBSection
+FUNCTION: HBITMAP CreateDIBSection ( HDC hdc, BITMAPINFO* pbmi, UINT iUsage, void** ppvBits, HANDLE hSection, DWORD dwOffset ) ;
 ! FUNCTION: CreateDiscardableBitmap
 ! FUNCTION: CreateEllipticRgn
 ! FUNCTION: CreateEllipticRgnIndirect
@@ -169,7 +177,7 @@ FUNCTION: HRGN CreateRectRgn ( int x, int y, int w, int h ) ;
 ! FUNCTION: DdEntry8
 ! FUNCTION: DdEntry9
 ! FUNCTION: DeleteColorSpace
-! FUNCTION: DeleteDC
+FUNCTION: BOOL DeleteDC ( HDC hdc ) ;
 ! FUNCTION: DeleteEnhMetaFile
 ! FUNCTION: DeleteMetaFile
 FUNCTION: BOOL DeleteObject ( HGDIOBJ hObject ) ;
@@ -313,7 +321,7 @@ FUNCTION: BOOL DeleteObject ( HGDIOBJ hObject ) ;
 ! FUNCTION: GdiEntry8
 ! FUNCTION: GdiEntry9
 ! FUNCTION: GdiFixUpHandle
-! FUNCTION: GdiFlush
+FUNCTION: BOOL GdiFlush ( ) ;
 ! FUNCTION: GdiFullscreenControl
 ! FUNCTION: GdiGetBatchLimit
 ! FUNCTION: GdiGetCharDimensions
@@ -552,7 +560,7 @@ FUNCTION: HGDIOBJ GetStockObject ( int fnObject ) ;
 ! FUNCTION: SelectClipPath
 FUNCTION: int SelectClipRgn ( HDC hDC, HRGN hrgn ) ;
 ! FUNCTION: SelectFontLocal
-! FUNCTION: SelectObject
+FUNCTION: HGDIOBJ SelectObject ( HDC hdc, HGDIOBJ hgdiobj ) ;
 ! FUNCTION: SelectPalette
 ! FUNCTION: SetAbortProc
 ! FUNCTION: SetArcDirection

basis/windows/opengl32/opengl32.factor

@@ -71,15 +71,17 @@ IN: windows.opengl32
 : WGL_SWAP_UNDERLAY14     HEX: 20000000 ; inline
 : WGL_SWAP_UNDERLAY15     HEX: 40000000 ; inline
 
-: pfd-dwFlags ( -- n )
+: windowed-pfd-dwFlags ( -- n )
     { PFD_DRAW_TO_WINDOW PFD_SUPPORT_OPENGL PFD_DOUBLEBUFFER } flags ;
+: offscreen-pfd-dwFlags ( -- n )
+    { PFD_DRAW_TO_BITMAP PFD_SUPPORT_OPENGL } flags ;
 
 ! TODO: compare to http://www.nullterminator.net/opengl32.html
-: make-pfd ( bits -- pfd )
+: make-pfd ( flags bits -- pfd )
     "PIXELFORMATDESCRIPTOR" <c-object>
     "PIXELFORMATDESCRIPTOR" heap-size over set-PIXELFORMATDESCRIPTOR-nSize
     1 over set-PIXELFORMATDESCRIPTOR-nVersion
-    pfd-dwFlags over set-PIXELFORMATDESCRIPTOR-dwFlags
+    rot over set-PIXELFORMATDESCRIPTOR-dwFlags
     PFD_TYPE_RGBA over set-PIXELFORMATDESCRIPTOR-iPixelType
     [ set-PIXELFORMATDESCRIPTOR-cColorBits ] keep
     16 over set-PIXELFORMATDESCRIPTOR-cDepthBits

basis/windows/types/types.factor

@@ -253,6 +253,29 @@ C-STRUCT: RECT
     ! { "BYTE[32]" "rgbReserved" }
 ! ;
 
+C-STRUCT: BITMAPINFOHEADER
+    { "DWORD"  "biSize" }
+    { "LONG"   "biWidth" }
+    { "LONG"   "biHeight" }
+    { "WORD"   "biPlanes" }
+    { "WORD"   "biBitCount" }
+    { "DWORD"  "biCompression" }
+    { "DWORD"  "biSizeImage" }
+    { "LONG"   "biXPelsPerMeter" }
+    { "LONG"   "biYPelsPerMeter" }
+    { "DWORD"  "biClrUsed" }
+    { "DWORD"  "biClrImportant" } ;
+
+C-STRUCT: RGBQUAD
+    { "BYTE" "rgbBlue" }
+    { "BYTE" "rgbGreen" }
+    { "BYTE" "rgbRed" }
+    { "BYTE" "rgbReserved" } ;
+
+C-STRUCT: BITMAPINFO
+    { "BITMAPINFOHEADER" "bmiHeader" }
+    { "RGBQUAD[1]" "bmiColors" } ;
+
 TYPEDEF: void* LPPAINTSTRUCT
 TYPEDEF: void* PAINTSTRUCT
 

basis/x11/glx/glx.factor

@@ -84,13 +84,13 @@ FUNCTION: void* glXGetProcAddress ( char* procname ) ;
 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* )
+: choose-visual ( flags -- XVisualInfo* )
-    dpy get scr get
+    [ dpy get scr get ] dip
     [
+        %
         GLX_RGBA ,
-        GLX_DOUBLEBUFFER ,
         GLX_DEPTH_SIZE , 16 ,
         0 ,
     ] int-array{ } make underlying>>
@@ -98,8 +98,8 @@ FUNCTION: void* glXGetProcAddressARB ( char* procname ) ;
     [ "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 ;
+    dpy get swap glXDestroyContext ;

basis/x11/windows/windows.factor

@@ -1,7 +1,8 @@
 ! 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 )
@@ -50,11 +51,30 @@ IN: x11.windows
     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 ;
 
@@ -65,3 +85,7 @@ IN: x11.windows
 : 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 ;

basis/x11/xlib/xlib.factor

@@ -272,6 +272,17 @@ FUNCTION: Window XGetSelectionOwner ( Display* display, Atom selection ) ;
 
 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
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -429,6 +440,49 @@ FUNCTION: Status XDrawString (
         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
 !

extra/graphics/bitmap/bitmap.factor

@@ -4,24 +4,35 @@
 USING: alien arrays byte-arrays combinators summary io.backend
 graphics.viewer io io.binary io.files kernel libc math
 math.functions math.bitwise namespaces opengl opengl.gl
-prettyprint sequences strings ui ui.gadgets.panes
+prettyprint sequences strings ui ui.gadgets.panes fry
-io.encodings.binary accessors grouping ;
+io.encodings.binary accessors grouping macros alien.c-types ;
 IN: graphics.bitmap
 
-! Currently can only handle 24bit bitmaps.
+! Currently can only handle 24/32bit bitmaps.
 ! Handles row-reversed bitmaps (their height is negative)
 
 TUPLE: bitmap magic size reserved offset header-length width
     height planes bit-count compression size-image
     x-pels y-pels color-used color-important rgb-quads color-index array ;
 
+: (array-copy) ( bitmap array -- bitmap array' )
+    over size-image>> abs memory>byte-array ;
+
+MACRO: (nbits>bitmap) ( bits -- )
+    [ -3 shift ] keep '[
+        bitmap new
+            2over * _ * >>size-image
+            swap >>height
+            swap >>width
+            swap (array-copy) [ >>array ] [ >>color-index ] bi
+            _ >>bit-count
+    ] ;
+
 : bgr>bitmap ( array height width -- bitmap )
-    bitmap new
+    24 (nbits>bitmap) ;
-        2over * 3 * >>size-image
+
-        swap >>height
+: bgra>bitmap ( array height width -- bitmap )
-        swap >>width
+    32 (nbits>bitmap) ;
-        swap [ >>array ] [ >>color-index ] bi
-        24 >>bit-count ;
 
 : 8bit>array ( bitmap -- array )
     [ rgb-quads>> 4 <sliced-groups> [ 3 head-slice ] map ]
@@ -124,7 +135,7 @@ M: bitmap draw-image ( bitmap -- )
     [
         [ height>> abs ] keep
         bit-count>> {
-            ! { 32 [ GL_BGRA GL_UNSIGNED_INT_8_8_8_8 ] } ! broken
+            { 32 [ GL_BGRA GL_UNSIGNED_BYTE ] }
             { 24 [ GL_BGR GL_UNSIGNED_BYTE ] }
             { 8 [ GL_BGR GL_UNSIGNED_BYTE ] }
             { 4 [ GL_BGR GL_UNSIGNED_BYTE ] }

extra/key-caps/key-caps.factor

@@ -139,7 +139,7 @@ TUPLE: key-caps-gadget < gadget keys alarm ;
 : make-key-gadget ( scancode dim array -- )
     [ 
         swap [ 
-            " " [ ] <bevel-button>
+            " " [ drop ] <bevel-button>
             swap [ first >>loc ] [ second >>dim ] bi
         ] [ execute ] bi*
     ] dip set-nth ;

extra/literals/literals-tests.factor

@@ -0,0 +1,12 @@
+USING: kernel literals tools.test ;
+IN: literals.tests
+
+<<
+: five 5 ;
+: seven-eleven 7 11 ;
+: six-six-six 6 6 6 ;
+>>
+
+[ { 5 } ] [ { $ five } ] unit-test
+[ { 7 11 } ] [ { $ seven-eleven } ] unit-test
+[ { 6 6 6 } ] [ { $ six-six-six } ] unit-test

extra/literals/literals.factor

@@ -0,0 +1,4 @@
+USING: continuations kernel parser words ;
+IN: literals
+
+: $ scan-word [ execute ] curry with-datastack ; parsing

extra/ui/offscreen/authors.txt

@@ -0,0 +1 @@
+Joe Groff

extra/ui/offscreen/offscreen-docs.factor

@@ -0,0 +1,63 @@
+! Copyright (C) 2008 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel quotations ui.gadgets
+graphics.bitmap strings ui.gadgets.worlds ;
+IN: ui.offscreen
+
+HELP: <offscreen-world>
+{ $values
+     { "gadget" gadget } { "title" string } { "status" "a boolean" }
+     { "world" offscreen-world }
+}
+{ $description "Constructs an " { $link offscreen-world } " gadget with " { $snippet "gadget" } " as its only child. Generally you should use " { $link open-offscreen } " or " { $link do-offscreen } " instead of calling this word directly." } ;
+
+HELP: close-offscreen
+{ $values
+     { "world" offscreen-world }
+}
+{ $description "Releases the resources used by the rendering buffer for " { $snippet "world" } "." } ;
+
+HELP: do-offscreen
+{ $values
+     { "gadget" gadget } { "quot" quotation }
+}
+{ $description "Constructs an " { $link offscreen-world } " around " { $snippet "gadget" } " with " { $link open-offscreen } ", calls " { $snippet "quotation" } " with the world on the top of the stack, and cleans up the world with " { $link close-offscreen } " at the end of " { $snippet "quotation" } "." } ;
+
+HELP: gadget>bitmap
+{ $values
+     { "gadget" gadget }
+     { "bitmap" bitmap }
+}
+{ $description "Renders " { $snippet "gadget" } " to an " { $link offscreen-world } " and creates a " { $link bitmap } " from its contents." } ;
+
+HELP: offscreen-world
+{ $class-description "The class of " { $link world } " objects that render to an offscreen buffer." } ;
+
+HELP: offscreen-world>bitmap
+{ $values
+     { "world" offscreen-world }
+     { "bitmap" bitmap }
+}
+{ $description "Saves a copy of the contents of " { $snippet "world" } " to a " { $link bitmap } " object." } ;
+
+HELP: open-offscreen
+{ $values
+     { "gadget" gadget }
+     { "world" offscreen-world }
+}
+{ $description "Creates and sets up an " { $link offscreen-world } " with " { $snippet "gadget" } " as its only child." } ;
+
+{ offscreen-world open-offscreen close-offscreen do-offscreen } related-words
+
+ARTICLE: "ui.offscreen" "Offscreen UI rendering"
+"The " { $vocab-link "ui.offscreen" } " provides words for rendering gadgets to an offscreen buffer so that bitmaps can be made from their contents."
+{ $subsection offscreen-world }
+"Opening gadgets offscreen:"
+{ $subsection open-offscreen }
+{ $subsection close-offscreen }
+{ $subsection do-offscreen }
+"Creating bitmaps from offscreen buffers:"
+{ $subsection offscreen-world>bitmap }
+{ $subsection gadget>bitmap } ;
+
+ABOUT: "ui.offscreen"

extra/ui/offscreen/offscreen.factor

@@ -0,0 +1,37 @@
+USING: accessors continuations graphics.bitmap kernel math
+sequences ui.gadgets ui.gadgets.worlds ui ui.backend
+destructors ;
+IN: ui.offscreen
+
+TUPLE: offscreen-world < world ;
+
+: <offscreen-world> ( gadget title status -- world )
+    offscreen-world new-world ;
+
+M: offscreen-world graft*
+    (open-offscreen-buffer) ;
+
+M: offscreen-world ungraft*
+    [ (ungraft-world) ]
+    [ handle>> (close-offscreen-buffer) ]
+    [ reset-world ] tri ;
+
+: open-offscreen ( gadget -- world )
+    "" f <offscreen-world>
+    [ open-world-window dup relayout-1 ] keep
+    notify-queued ;
+
+: close-offscreen ( world -- )
+    ungraft notify-queued ;
+
+M: offscreen-world dispose close-offscreen ;
+
+: offscreen-world>bitmap ( world -- bitmap )
+    offscreen-pixels bgra>bitmap ;
+
+: do-offscreen ( gadget quot: ( offscreen-world -- ) -- )
+    [ open-offscreen ] dip
+    over [ slip ] [ close-offscreen ] [ ] cleanup ; inline
+
+: gadget>bitmap ( gadget -- bitmap )
+    [ offscreen-world>bitmap ] do-offscreen ;

extra/ui/offscreen/summary.txt

@@ -0,0 +1 @@
+Offscreen world gadgets for rendering UI elements to bitmaps

extra/ui/offscreen/tags.txt

@@ -0,0 +1,3 @@
+unportable
+ui
+graphics

vm/Config.macosx

@@ -6,7 +6,7 @@ PLAF_DLL_OBJS += vm/os-macosx.o vm/mach_signal.o
 DLL_EXTENSION = .dylib
 
 ifdef X11
-	LIBS = -lm -framework Foundation $(X11_UI_LIBS) -Wl,-dylib_file,/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib:/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib
+	LIBS = -lm -framework Cocoa $(X11_UI_LIBS) -Wl,-dylib_file,/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib:/System/Library/Frameworks/OpenGL.framework/Versions/A/Libraries/libGL.dylib
 else
     LIBS = -lm -framework Cocoa -framework AppKit
 endif