Merge branch 'master' of git://factorcode.org/git/factor

diff --combined basis/ui/windows/windows.factor
index 626deb12a47303d1dc1583a3e2c97408c3adaff1,35ee9f9a600ca2ef67021c3887404487c112af05..7ccabc7275a2ce19a3421ce8b897330e4a6230a5
--- 1/basis/ui/windows/windows.factor
--- 2/basis/ui/windows/windows.factor
+++ b/basis/ui/windows/windows.factor
@@@ -6,7 -6,7 +6,7 @@@ ui.gadgets ui.backend ui.clipboards ui.
  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 +70,11 @@@ M: pasteboard set-clipboard-contents dr
      <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 ;
  
@@@ -170,10 -172,10 +172,10 @@@
          { 27 "ESC" }
      } ;
  
 -: exclude-key-wm-keydown? ( n -- bool )
 +: exclude-key-wm-keydown? ( n -- ? )
      exclude-keys-wm-keydown key? ;
  
 -: exclude-key-wm-char? ( n -- bool )
 +: exclude-key-wm-char? ( n -- ? )
      exclude-keys-wm-char key? ;
  
  : keystroke>gesture ( n -- mods sym )
@@@ -479,8 -481,8 +481,8 @@@ M: windows-ui-backend do-event
      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 +492,73 @@@
      [ 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