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

diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 80dd313e8543e9d913ef4ae71452eaccbe80184c..12ce2bed80a6cf9b8f07407b06f5d12943238415 100755 (executable)
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -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.
 ! 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
 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 -- )
     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 ;
 
     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 ]
 : 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' )
 ! 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 )
     [ '[ 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 ;
 
 M: windows-ui-backend offscreen-pixels ( world -- alien w h )
     [ (opaque-pixels) ] [ dim>> first2 ] bi ;

diff --git a/basis/windows/gdi32/gdi32.factor b/basis/windows/gdi32/gdi32.factor
index 077adf1961bc75eb4731cf5d78c0777b4737925f..2281255a4f571940c77334d2cbc167896a928736 100755 (executable)
--- a/basis/windows/gdi32/gdi32.factor
+++ b/basis/windows/gdi32/gdi32.factor
@@ -1,7 +1,6 @@
-! FUNCTION: AbortDoc

 ! Copyright (C) 2005, 2006 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 ! 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
 IN: windows.gdi32
 
 ! Stock Logical Objects


@@ -36,6 +35,7 @@ CONSTANT: DIB_PAL_COLORS 1
 
 LIBRARY: gdi32
 
 
 LIBRARY: gdi32
 

+! FUNCTION: AbortDoc

 ! FUNCTION: AbortPath
 ! FUNCTION: AddFontMemResourceEx
 ! FUNCTION: AddFontResourceA
 ! 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 ) ;
 ! FUNCTION: DdEntry9
 ! FUNCTION: DeleteColorSpace
 FUNCTION: BOOL DeleteDC ( HDC hdc ) ;

+DESTRUCTOR: DeleteDC

 ! FUNCTION: DeleteEnhMetaFile
 ! FUNCTION: DeleteMetaFile
 FUNCTION: BOOL DeleteObject ( HGDIOBJ hObject ) ;
 ! FUNCTION: DeleteEnhMetaFile
 ! FUNCTION: DeleteMetaFile
 FUNCTION: BOOL DeleteObject ( HGDIOBJ hObject ) ;

+DESTRUCTOR: DeleteObject

 ! FUNCTION: DescribePixelFormat
 ! FUNCTION: DeviceCapabilitiesExA
 ! FUNCTION: DeviceCapabilitiesExW
 ! FUNCTION: DescribePixelFormat
 ! FUNCTION: DeviceCapabilitiesExA
 ! FUNCTION: DeviceCapabilitiesExW

diff --git a/basis/windows/offscreen/authors.txt b/basis/windows/offscreen/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
+++ b/basis/windows/offscreen/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file

diff --git a/basis/windows/offscreen/offscreen.factor b/basis/windows/offscreen/offscreen.factor
new file mode 100644 (file)
index 0000000..4eee68c
--- /dev/null
+++ b/basis/windows/offscreen/offscreen.factor
@@ -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
\ No newline at end of file

diff --git a/extra/ui/offscreen/offscreen.factor b/extra/ui/offscreen/offscreen.factor
index cf9370ed7fa6b050fe9e373bf33124743f165445..f0b81ccacd99f27540de841cb637441ad057c48b 100755 (executable)
--- a/extra/ui/offscreen/offscreen.factor
+++ b/extra/ui/offscreen/offscreen.factor
@@ -1,7 +1,7 @@
 ! (c) 2008 Joe Groff, see license for details
 USING: accessors continuations images.bitmap kernel math
 ! (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 ;
 IN: ui.offscreen
 
 TUPLE: offscreen-world < world ;

diff --git a/extra/ui/offscreen/tags.txt b/extra/ui/offscreen/tags.txt
index b796ebde9124cd1beac6a69bd42032703dbafcb2..46f6dcd8de25f6a27fec35e7dee247082d16f364 100644 (file)
--- a/extra/ui/offscreen/tags.txt
+++ b/extra/ui/offscreen/tags.txt
@@ -1,3 +1,2 @@
-unportable

 ui
 graphics
 ui
 graphics