Split off some code from ui.backend.windows into windows.offscreen
parent
84b5ace863
commit
a58ce33bb3
|
@ -1,16 +1,16 @@
|
|||
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||
! Portions copyright (C) 2007, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.strings arrays assocs ui
|
||||
ui.private ui.gadgets ui.gadgets.private ui.backend
|
||||
ui.clipboards ui.gadgets.worlds ui.gestures ui.event-loop 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 fry combinators.short-circuit
|
||||
continuations command-line shuffle opengl ui.render ascii
|
||||
math.bitwise locals accessors math.rectangles math.order ascii
|
||||
calendar io.encodings.utf16n ;
|
||||
USING: alien alien.c-types alien.strings arrays assocs ui ui.private
|
||||
ui.gadgets ui.gadgets.private ui.backend ui.clipboards
|
||||
ui.gadgets.worlds ui.gestures ui.event-loop io kernel math
|
||||
math.vectors namespaces make sequences strings vectors words
|
||||
windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
|
||||
windows.messages windows.types windows.offscreen windows.nt windows
|
||||
threads libc combinators fry combinators.short-circuit continuations
|
||||
command-line shuffle opengl ui.render ascii math.bitwise locals
|
||||
accessors math.rectangles math.order ascii calendar
|
||||
io.encodings.utf16n ;
|
||||
IN: ui.backend.windows
|
||||
|
||||
SINGLETON: windows-ui-backend
|
||||
|
@ -501,35 +501,12 @@ M: windows-ui-backend (open-window) ( world -- )
|
|||
hWnd>> show-window ;
|
||||
|
||||
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 ;
|
||||
|
||||
M: win-base flush-gl-context ( handle -- )
|
||||
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 )
|
||||
make-offscreen-dc-and-bitmap [
|
||||
[ 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
|
||||
|
||||
: (make-opaque) ( byte-array -- byte-array' )
|
||||
[ length 4 / ]
|
||||
[ length 4 /i ]
|
||||
[ '[ 255 swap 4 * 3 + _ set-nth ] each ]
|
||||
[ ] tri ;
|
||||
|
||||
: (opaque-pixels) ( world -- pixels )
|
||||
[ handle>> bits>> ] [ dim>> first2 * 4 * ] bi
|
||||
memory>byte-array (make-opaque) ;
|
||||
[ handle>> bits>> ] [ dim>> ] bi bitmap>byte-array (make-opaque) ;
|
||||
|
||||
M: windows-ui-backend offscreen-pixels ( world -- alien w h )
|
||||
[ (opaque-pixels) ] [ dim>> first2 ] bi ;
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
! FUNCTION: AbortDoc
|
||||
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||
! 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
|
||||
|
||||
! Stock Logical Objects
|
||||
|
@ -36,6 +35,7 @@ CONSTANT: DIB_PAL_COLORS 1
|
|||
|
||||
LIBRARY: gdi32
|
||||
|
||||
! FUNCTION: AbortDoc
|
||||
! FUNCTION: AbortPath
|
||||
! FUNCTION: AddFontMemResourceEx
|
||||
! FUNCTION: AddFontResourceA
|
||||
|
@ -178,9 +178,11 @@ FUNCTION: HRGN CreateRectRgn ( int x, int y, int w, int h ) ;
|
|||
! FUNCTION: DdEntry9
|
||||
! FUNCTION: DeleteColorSpace
|
||||
FUNCTION: BOOL DeleteDC ( HDC hdc ) ;
|
||||
DESTRUCTOR: DeleteDC
|
||||
! FUNCTION: DeleteEnhMetaFile
|
||||
! FUNCTION: DeleteMetaFile
|
||||
FUNCTION: BOOL DeleteObject ( HGDIOBJ hObject ) ;
|
||||
DESTRUCTOR: DeleteObject
|
||||
! FUNCTION: DescribePixelFormat
|
||||
! FUNCTION: DeviceCapabilitiesExA
|
||||
! 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
|
||||
USING: accessors continuations images.bitmap kernel math
|
||||
sequences ui.gadgets ui.gadgets.worlds ui ui.backend
|
||||
destructors ;
|
||||
sequences ui.gadgets ui.gadgets.private ui.gadgets.worlds
|
||||
ui.private ui ui.backend destructors ;
|
||||
IN: ui.offscreen
|
||||
|
||||
TUPLE: offscreen-world < world ;
|
||||
|
|
|
@ -1,3 +1,2 @@
|
|||
unportable
|
||||
ui
|
||||
graphics
|
||||
|
|
Loading…
Reference in New Issue