Merge branch 'master' of git://repo.or.cz/factor/jcg
commit
07ff3a4441
|
@ -55,10 +55,9 @@ PRIVATE>
|
|||
: with-multisample ( quot -- )
|
||||
t +multisample+ pick with-variable ; inline
|
||||
|
||||
: <PixelFormat> ( -- pixelfmt )
|
||||
NSOpenGLPixelFormat -> alloc [
|
||||
NSOpenGLPFAWindow ,
|
||||
NSOpenGLPFADoubleBuffer ,
|
||||
: <PixelFormat> ( attributes -- pixelfmt )
|
||||
NSOpenGLPixelFormat -> alloc swap [
|
||||
%
|
||||
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: ;
|
||||
|
|
|
@ -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 ( -- )
|
||||
|
||||
|
|
|
@ -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> 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 -- )
|
||||
view>> -> openGLContext -> makeCurrentContext ;
|
||||
: pixel-size ( pixel-format -- size )
|
||||
0 <int> [ 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 <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 ;
|
||||
|
|
|
@ -38,8 +38,8 @@ M: world request-focus-on ( child gadget -- )
|
|||
2dup eq?
|
||||
[ 2drop ] [ dup focused?>> (request-focus) ] if ;
|
||||
|
||||
: <world> ( 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 ;
|
||||
|
||||
: <world> ( gadget title status -- world )
|
||||
world new-world ;
|
||||
|
||||
M: world layout*
|
||||
dup call-next-method
|
||||
dup glass>> [
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 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> 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 -- )
|
||||
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 <win> ] 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" <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
|
||||
|
|
|
@ -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 [
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
dpy get swap glXDestroyContext ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
!
|
||||
|
|
|
@ -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 <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 ] }
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
|
@ -0,0 +1,4 @@
|
|||
USING: continuations kernel parser words ;
|
||||
IN: literals
|
||||
|
||||
: $ scan-word [ execute ] curry with-datastack ; parsing
|
|
@ -0,0 +1 @@
|
|||
Joe Groff
|
|
@ -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"
|
|
@ -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 ;
|
|
@ -0,0 +1 @@
|
|||
Offscreen world gadgets for rendering UI elements to bitmaps
|
|
@ -0,0 +1,3 @@
|
|||
unportable
|
||||
ui
|
||||
graphics
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue