Split off some code from ui.backend.windows into windows.offscreen
parent
84b5ace863
commit
a58ce33bb3
basis
ui/backend/windows
windows
gdi32
offscreen
extra/ui/offscreen
|
@ -1,16 +1,16 @@
|
||||||
! Copyright (C) 2005, 2006 Doug Coleman.
|
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||||
! Portions copyright (C) 2007, 2009 Slava Pestov.
|
! Portions copyright (C) 2007, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types alien.strings arrays assocs ui
|
USING: alien alien.c-types alien.strings arrays assocs ui ui.private
|
||||||
ui.private ui.gadgets ui.gadgets.private ui.backend
|
ui.gadgets ui.gadgets.private ui.backend ui.clipboards
|
||||||
ui.clipboards ui.gadgets.worlds ui.gestures ui.event-loop io
|
ui.gadgets.worlds ui.gestures ui.event-loop io kernel math
|
||||||
kernel math math.vectors namespaces make sequences strings
|
math.vectors namespaces make sequences strings vectors words
|
||||||
vectors words windows.kernel32 windows.gdi32 windows.user32
|
windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
|
||||||
windows.opengl32 windows.messages windows.types windows.nt
|
windows.messages windows.types windows.offscreen windows.nt windows
|
||||||
windows threads libc combinators fry combinators.short-circuit
|
threads libc combinators fry combinators.short-circuit continuations
|
||||||
continuations command-line shuffle opengl ui.render ascii
|
command-line shuffle opengl ui.render ascii math.bitwise locals
|
||||||
math.bitwise locals accessors math.rectangles math.order ascii
|
accessors math.rectangles math.order ascii calendar
|
||||||
calendar io.encodings.utf16n ;
|
io.encodings.utf16n ;
|
||||||
IN: ui.backend.windows
|
IN: ui.backend.windows
|
||||||
|
|
||||||
SINGLETON: windows-ui-backend
|
SINGLETON: windows-ui-backend
|
||||||
|
@ -501,35 +501,12 @@ M: windows-ui-backend (open-window) ( world -- )
|
||||||
hWnd>> show-window ;
|
hWnd>> show-window ;
|
||||||
|
|
||||||
M: win-base select-gl-context ( handle -- )
|
M: win-base select-gl-context ( handle -- )
|
||||||
[ hDC>> ] keep hRC>> wglMakeCurrent win32-error=0/f
|
[ hDC>> ] [ hRC>> ] bi wglMakeCurrent win32-error=0/f
|
||||||
GdiFlush drop ;
|
GdiFlush drop ;
|
||||||
|
|
||||||
M: win-base flush-gl-context ( handle -- )
|
M: win-base flush-gl-context ( handle -- )
|
||||||
hDC>> SwapBuffers win32-error=0/f ;
|
hDC>> SwapBuffers win32-error=0/f ;
|
||||||
|
|
||||||
: (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 )
|
: setup-offscreen-gl ( dim -- hDC hRC hBitmap bits )
|
||||||
make-offscreen-dc-and-bitmap [
|
make-offscreen-dc-and-bitmap [
|
||||||
[ dup offscreen-pfd-dwFlags setup-pixel-format ]
|
[ dup offscreen-pfd-dwFlags setup-pixel-format ]
|
||||||
|
@ -548,13 +525,12 @@ M: windows-ui-backend (close-offscreen-buffer) ( handle -- )
|
||||||
! each pixel; it's left as zero
|
! each pixel; it's left as zero
|
||||||
|
|
||||||
: (make-opaque) ( byte-array -- byte-array' )
|
: (make-opaque) ( byte-array -- byte-array' )
|
||||||
[ length 4 / ]
|
[ length 4 /i ]
|
||||||
[ '[ 255 swap 4 * 3 + _ set-nth ] each ]
|
[ '[ 255 swap 4 * 3 + _ set-nth ] each ]
|
||||||
[ ] tri ;
|
[ ] tri ;
|
||||||
|
|
||||||
: (opaque-pixels) ( world -- pixels )
|
: (opaque-pixels) ( world -- pixels )
|
||||||
[ handle>> bits>> ] [ dim>> first2 * 4 * ] bi
|
[ handle>> bits>> ] [ dim>> ] bi bitmap>byte-array (make-opaque) ;
|
||||||
memory>byte-array (make-opaque) ;
|
|
||||||
|
|
||||||
M: windows-ui-backend offscreen-pixels ( world -- alien w h )
|
M: windows-ui-backend offscreen-pixels ( world -- alien w h )
|
||||||
[ (opaque-pixels) ] [ dim>> first2 ] bi ;
|
[ (opaque-pixels) ] [ dim>> first2 ] bi ;
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
! FUNCTION: AbortDoc
|
|
||||||
! Copyright (C) 2005, 2006 Doug Coleman.
|
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.syntax kernel windows.types ;
|
USING: alien alien.syntax alien.destructors kernel windows.types ;
|
||||||
IN: windows.gdi32
|
IN: windows.gdi32
|
||||||
|
|
||||||
! Stock Logical Objects
|
! Stock Logical Objects
|
||||||
|
@ -36,6 +35,7 @@ CONSTANT: DIB_PAL_COLORS 1
|
||||||
|
|
||||||
LIBRARY: gdi32
|
LIBRARY: gdi32
|
||||||
|
|
||||||
|
! FUNCTION: AbortDoc
|
||||||
! FUNCTION: AbortPath
|
! FUNCTION: AbortPath
|
||||||
! FUNCTION: AddFontMemResourceEx
|
! FUNCTION: AddFontMemResourceEx
|
||||||
! FUNCTION: AddFontResourceA
|
! FUNCTION: AddFontResourceA
|
||||||
|
@ -178,9 +178,11 @@ FUNCTION: HRGN CreateRectRgn ( int x, int y, int w, int h ) ;
|
||||||
! FUNCTION: DdEntry9
|
! FUNCTION: DdEntry9
|
||||||
! FUNCTION: DeleteColorSpace
|
! FUNCTION: DeleteColorSpace
|
||||||
FUNCTION: BOOL DeleteDC ( HDC hdc ) ;
|
FUNCTION: BOOL DeleteDC ( HDC hdc ) ;
|
||||||
|
DESTRUCTOR: DeleteDC
|
||||||
! FUNCTION: DeleteEnhMetaFile
|
! FUNCTION: DeleteEnhMetaFile
|
||||||
! FUNCTION: DeleteMetaFile
|
! FUNCTION: DeleteMetaFile
|
||||||
FUNCTION: BOOL DeleteObject ( HGDIOBJ hObject ) ;
|
FUNCTION: BOOL DeleteObject ( HGDIOBJ hObject ) ;
|
||||||
|
DESTRUCTOR: DeleteObject
|
||||||
! FUNCTION: DescribePixelFormat
|
! FUNCTION: DescribePixelFormat
|
||||||
! FUNCTION: DeviceCapabilitiesExA
|
! FUNCTION: DeviceCapabilitiesExA
|
||||||
! FUNCTION: DeviceCapabilitiesExW
|
! FUNCTION: DeviceCapabilitiesExW
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Slava Pestov
|
|
@ -0,0 +1,47 @@
|
||||||
|
! Copyright (C) 2009 Joe Groff, Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: alien.c-types kernel combinators sequences
|
||||||
|
math windows.gdi32 windows.types images destructors
|
||||||
|
accessors fry ;
|
||||||
|
IN: windows.offscreen
|
||||||
|
|
||||||
|
: (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
|
||||||
|
[ nip ]
|
||||||
|
[
|
||||||
|
swap (bitmap-info) DIB_RGB_COLORS f <void*>
|
||||||
|
[ f 0 CreateDIBSection ] keep *void*
|
||||||
|
] 2bi
|
||||||
|
[ 2dup SelectObject drop ] dip ;
|
||||||
|
|
||||||
|
: bitmap>byte-array ( bits dim -- byte-array )
|
||||||
|
product 4 * memory>byte-array ;
|
||||||
|
|
||||||
|
: bitmap>image ( bits dim -- image )
|
||||||
|
[ bitmap>byte-array ] keep
|
||||||
|
<image> swap >>dim swap >>bitmap XBGR >>component-order ;
|
||||||
|
|
||||||
|
: make-bitmap-image ( dim quot: ( hDC -- ) -- image )
|
||||||
|
'[
|
||||||
|
[
|
||||||
|
make-offscreen-dc-and-bitmap
|
||||||
|
[ &DeleteDC @ ] [ &DeleteObject drop ] [ ] tri*
|
||||||
|
] keep bitmap>byte-array
|
||||||
|
] with-destructors ; inline
|
|
@ -1,7 +1,7 @@
|
||||||
! (c) 2008 Joe Groff, see license for details
|
! (c) 2008 Joe Groff, see license for details
|
||||||
USING: accessors continuations images.bitmap kernel math
|
USING: accessors continuations images.bitmap kernel math
|
||||||
sequences ui.gadgets ui.gadgets.worlds ui ui.backend
|
sequences ui.gadgets ui.gadgets.private ui.gadgets.worlds
|
||||||
destructors ;
|
ui.private ui ui.backend destructors ;
|
||||||
IN: ui.offscreen
|
IN: ui.offscreen
|
||||||
|
|
||||||
TUPLE: offscreen-world < world ;
|
TUPLE: offscreen-world < world ;
|
||||||
|
|
|
@ -1,3 +1,2 @@
|
||||||
unportable
|
|
||||||
ui
|
ui
|
||||||
graphics
|
graphics
|
||||||
|
|
Loading…
Reference in New Issue