Split off some code from ui.backend.windows into windows.offscreen

db4
Slava Pestov 2009-03-28 22:27:18 -05:00
parent 84b5ace863
commit a58ce33bb3
6 changed files with 67 additions and 42 deletions
basis
ui/backend/windows
extra/ui/offscreen

View File

@ -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 ;

View File

@ -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

View File

@ -0,0 +1 @@
Slava Pestov

View File

@ -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

View File

@ -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 ;

View File

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