diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor index be67f03184..03cafd0a0a 100644 --- a/basis/cocoa/views/views.factor +++ b/basis/cocoa/views/views.factor @@ -55,10 +55,9 @@ PRIVATE> : with-multisample ( quot -- ) t +multisample+ pick with-variable ; inline -: ( -- pixelfmt ) - NSOpenGLPixelFormat -> alloc [ - NSOpenGLPFAWindow , - NSOpenGLPFADoubleBuffer , +: ( attributes -- pixelfmt ) + NSOpenGLPixelFormat -> alloc swap [ + % NSOpenGLPFADepthSize , 16 , +software-renderer+ get [ NSOpenGLPFARendererID , kCGLRendererGenericFloatID , @@ -74,7 +73,8 @@ PRIVATE> -> autorelease ; : ( class dim -- view ) - [ -> alloc 0 0 ] dip first2 + [ -> alloc 0 0 ] dip first2 + NSOpenGLPFAWindow NSOpenGLPFADoubleBuffer 2array -> initWithFrame:pixelFormat: dup 1 -> setPostsBoundsChangedNotifications: dup 1 -> setPostsFrameChangedNotifications: ; diff --git a/basis/ui/backend/backend.factor b/basis/ui/backend/backend.factor old mode 100644 new mode 100755 index 0840d07cbc..aa84419d64 --- a/basis/ui/backend/backend.factor +++ b/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 ( -- ) diff --git a/basis/ui/cocoa/cocoa.factor b/basis/ui/cocoa/cocoa.factor old mode 100644 new mode 100755 index b90f4d34fe..fecbb52a25 --- a/basis/ui/cocoa/cocoa.factor +++ b/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 -sequences system ui ui.backend ui.clipboards ui.gadgets -ui.gadgets.worlds ui.cocoa.views core-foundation threads -math.geometry.rect fry ; +cocoa.windows cocoa.classes cocoa.nibs sequences system +ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds +ui.cocoa.views core-foundation threads 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 +C: window-handle +C: offscreen-handle SINGLETON: cocoa-ui-backend @@ -39,7 +42,8 @@ M: pasteboard set-clipboard-contents : gadget-window ( world -- ) dup 2dup swap world>NSRect - [ [ -> release ] [ install-window-delegate ] bi* ] [ ] 2bi + [ [ -> release ] [ install-window-delegate ] bi* ] + [ ] 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 -- ) - view>> -> openGLContext -> makeCurrentContext ; +: pixel-size ( pixel-format -- size ) + 0 [ NSOpenGLPFAColorSize 0 -> getValues:forAttribute:forVirtualScreen: ] + keep *int -3 shift ; -M: cocoa-ui-backend flush-gl-context ( handle -- ) - view>> -> openGLContext -> flushBuffer ; +: offscreen-buffer ( world pixel-format -- alien w h pitch ) + [ dim>> first2 ] [ pixel-size ] bi* + { [ * * malloc ] [ 2drop ] [ drop nip ] [ nip * ] } 3cleave ; + +: gadget-offscreen-context ( world -- context buffer ) + NSOpenGLPFAOffScreen 1array + [ 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 >>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 ; diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index 3b9b2fa1f3..732a438203 100644 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/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 ; -: ( gadget title status -- world ) - { 0 1 } world new-track +: new-world ( gadget title status class -- world ) + { 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 ; +: ( gadget title status -- world ) + world new-world ; + M: world layout* dup call-next-method dup glass>> [ diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index d9ff287014..1ee860c974 100644 --- a/basis/ui/ui.factor +++ b/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) - dup title>> over set-title - request-focus ; + [ (open-window) ] + [ [ title>> ] keep set-title ] + [ 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 - dup unfocus-world - f >>handle drop ; + [ fonts>> clear-assoc ] + [ unfocus-world ] + [ f >>handle drop ] tri ; + +: (ungraft-world) ( world -- ) + [ free-fonts ] + [ hand-clicked close-global ] + [ hand-gadget close-global ] tri ; M: world ungraft* - dup free-fonts - dup hand-clicked close-global - dup hand-gadget close-global - dup handle>> (close-window) - reset-world ; + [ (ungraft-world) ] + [ handle>> (close-window) ] + [ reset-world ] tri ; : find-window ( quot -- world ) windows get values diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index 10539df8e7..35ee9f9a60 100755 --- a/basis/ui/windows/windows.factor +++ b/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 ; clipboard set-global selection set-global ; -! world-handle is a -TUPLE: win hWnd hDC hRC world title ; +TUPLE: win-base hDC hRC ; +TUPLE: win < win-base hWnd world title ; +TUPLE: win-offscreen < win-base hBitmap bits ; C: win +C: 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 -- ) - 16 make-pfd [ ChoosePixelFormat dup win32-error=0/f ] 2keep +: setup-pixel-format ( hdc flags -- ) + 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 ] keep [ swap hWnd>> register-window ] 2keep dupd (>>handle) hWnd>> show-window ; -M: windows-ui-backend select-gl-context ( handle -- ) - [ hDC>> ] keep hRC>> wglMakeCurrent win32-error=0/f ; +M: win-base select-gl-context ( handle -- ) + [ 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" [ + 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 + [ 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 + >>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 diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor index 563b98aa34..817e356712 100755 --- a/basis/ui/x11/x11.factor +++ b/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 +C: 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 + over "Factor" create-xic rot 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 >>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 [ diff --git a/basis/windows/gdi32/gdi32.factor b/basis/windows/gdi32/gdi32.factor old mode 100644 new mode 100755 index b9ba51844c..32e4f3cd8a --- a/basis/windows/gdi32/gdi32.factor +++ b/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 diff --git a/basis/windows/opengl32/opengl32.factor b/basis/windows/opengl32/opengl32.factor old mode 100644 new mode 100755 index df09d9327a..63384e8858 --- a/basis/windows/opengl32/opengl32.factor +++ b/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" "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 diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor old mode 100644 new mode 100755 index 63ee6627c4..8cc18d4039 --- a/basis/windows/types/types.factor +++ b/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 diff --git a/basis/x11/glx/glx.factor b/basis/x11/glx/glx.factor index 1fab283242..e0b786ce7d 100644 --- a/basis/x11/glx/glx.factor +++ b/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* ) - 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>> @@ -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 ; \ No newline at end of file + dpy get swap glXDestroyContext ; diff --git a/basis/x11/windows/windows.factor b/basis/x11/windows/windows.factor index aed45655f6..3c41a78584 100644 --- a/basis/x11/windows/windows.factor +++ b/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 ; diff --git a/basis/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor index 555eb573fc..996932e697 100644 --- a/basis/x11/xlib/xlib.factor +++ b/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 ! diff --git a/extra/graphics/bitmap/bitmap.factor b/extra/graphics/bitmap/bitmap.factor index 4c35e3d7d0..9bb8db0f6d 100755 --- a/extra/graphics/bitmap/bitmap.factor +++ b/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 -io.encodings.binary accessors grouping ; +prettyprint sequences strings ui ui.gadgets.panes fry +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 - 2over * 3 * >>size-image - swap >>height - swap >>width - swap [ >>array ] [ >>color-index ] bi - 24 >>bit-count ; + 24 (nbits>bitmap) ; + +: bgra>bitmap ( array height width -- bitmap ) + 32 (nbits>bitmap) ; : 8bit>array ( bitmap -- array ) [ rgb-quads>> 4 [ 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 ] } diff --git a/extra/key-caps/key-caps.factor b/extra/key-caps/key-caps.factor index 0865b0ada2..05edb205d2 100755 --- a/extra/key-caps/key-caps.factor +++ b/extra/key-caps/key-caps.factor @@ -139,7 +139,7 @@ TUPLE: key-caps-gadget < gadget keys alarm ; : make-key-gadget ( scancode dim array -- ) [ swap [ - " " [ ] + " " [ drop ] swap [ first >>loc ] [ second >>dim ] bi ] [ execute ] bi* ] dip set-nth ; diff --git a/extra/literals/literals-tests.factor b/extra/literals/literals-tests.factor new file mode 100644 index 0000000000..b88a286a59 --- /dev/null +++ b/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 diff --git a/extra/literals/literals.factor b/extra/literals/literals.factor new file mode 100644 index 0000000000..d46f492cd4 --- /dev/null +++ b/extra/literals/literals.factor @@ -0,0 +1,4 @@ +USING: continuations kernel parser words ; +IN: literals + +: $ scan-word [ execute ] curry with-datastack ; parsing diff --git a/extra/ui/offscreen/authors.txt b/extra/ui/offscreen/authors.txt new file mode 100644 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/ui/offscreen/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/ui/offscreen/offscreen-docs.factor b/extra/ui/offscreen/offscreen-docs.factor new file mode 100644 index 0000000000..5d800981bf --- /dev/null +++ b/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: +{ $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" diff --git a/extra/ui/offscreen/offscreen.factor b/extra/ui/offscreen/offscreen.factor new file mode 100755 index 0000000000..3897df71fa --- /dev/null +++ b/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 ; + +: ( 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 + [ 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 ; diff --git a/extra/ui/offscreen/summary.txt b/extra/ui/offscreen/summary.txt new file mode 100644 index 0000000000..51ef124d97 --- /dev/null +++ b/extra/ui/offscreen/summary.txt @@ -0,0 +1 @@ +Offscreen world gadgets for rendering UI elements to bitmaps diff --git a/extra/ui/offscreen/tags.txt b/extra/ui/offscreen/tags.txt new file mode 100644 index 0000000000..b796ebde91 --- /dev/null +++ b/extra/ui/offscreen/tags.txt @@ -0,0 +1,3 @@ +unportable +ui +graphics diff --git a/vm/Config.macosx b/vm/Config.macosx index 54078cfe8d..e5aac32b54 100644 --- a/vm/Config.macosx +++ b/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