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

basis/ui/backend/backend.factor

@@ -21,6 +21,8 @@ HOOK: (close-offscreen-buffer) ui-backend ( handle -- )
 
 HOOK: raise-window* ui-backend ( world -- )
 
+HOOK: system-background-color ui-backend ( -- color )
+
 GENERIC: select-gl-context ( handle -- )
 
 GENERIC: flush-gl-context ( handle -- )

basis/ui/backend/cocoa/cocoa.factor

@@ -58,6 +58,9 @@ M: cocoa-ui-backend (pixel-format-attribute)
     [ first 0 <int> [ swap 0 -> getValues:forAttribute:forVirtualScreen: ] keep *int ]
     if-empty ;
 
+M: cocoa-ui-backend system-background-color
+    T{ rgba f 0.0 0.0 0.0 0.0 } ; inline
+
 TUPLE: pasteboard handle ;
 
 C: <pasteboard> pasteboard

basis/ui/backend/windows/windows.factor

@@ -12,7 +12,7 @@ fry combinators.short-circuit continuations command-line shuffle
 opengl ui.render math.bitwise locals accessors math.rectangles
 math.order calendar ascii sets io.encodings.utf16n
 windows.errors literals ui.pixel-formats
-ui.pixel-formats.private memoize classes
+ui.pixel-formats.private memoize classes colors
 specialized-arrays classes.struct alien.data ;
 SPECIALIZED-ARRAY: POINT
 IN: ui.backend.windows
@@ -165,6 +165,11 @@ M: windows-ui-backend (pixel-format-attribute)
     over world>> has-wglChoosePixelFormatARB?
     [ arb-pixel-format-attribute ] [ pfd-pixel-format-attribute ] if ;
 
+M: windows-ui-backend system-background-color
+    composition-enabled?
+    [ T{ rgba f 0.0 0.0 0.0 0.0 } ]
+    [ COLOR_BTNFACE GetSysColor RGB>color ] if ;
+
 PRIVATE>
 
 : lo-word ( wparam -- lo ) <short> *short ; inline
@@ -533,6 +538,14 @@ SYMBOL: nc-buttons
     #! message sent if mouse leaves main application 
     4drop forget-rollover ;
 
+: ?make-glass ( world hwnd -- )
+    swap { [ transparent?>> ] [ drop windows-major 6 >= ] } 1&&
+    [ full-window-margins DwmExtendFrameIntoClientArea drop ]
+    [ drop ] if ;
+
+: handle-wm-dwmcompositionchanged ( hWnd uMsg wParam lParam -- )
+    3drop [ window ] keep ?make-glass ;
+
 SYMBOL: wm-handlers
 
 H{ } clone wm-handlers set-global
@@ -562,6 +575,7 @@ H{ } clone wm-handlers set-global
 [ handle-wm-buttonup 0   ] WM_LBUTTONUP   add-wm-handler
 [ handle-wm-buttonup 0   ] WM_MBUTTONUP   add-wm-handler
 [ handle-wm-buttonup 0   ] WM_RBUTTONUP   add-wm-handler
+[ handle-wm-dwmcompositionchanged 0   ] WM_DWMCOMPOSITIONCHANGED add-wm-handler
 
 [ 4dup handle-wm-ncbutton DefWindowProc ]
 { WM_NCLBUTTONDOWN WM_NCMBUTTONDOWN WM_NCRBUTTONDOWN
@@ -682,11 +696,6 @@ M: windows-ui-backend do-events
     0 GetSystemMenu
     SC_CLOSE MF_BYCOMMAND MF_GRAYED bitor EnableMenuItem drop ;
 
-: ?make-glass ( world hwnd -- )
-    swap { [ transparent?>> ] [ drop windows-major 6 >= ] } 1&&
-    [ full-window-margins DwmExtendFrameIntoClientArea drop ]
-    [ drop ] if ;
-
 : ?disable-close-button ( world hwnd -- )
     swap window-controls>> close-button swap member? not
     [ disable-close-button ] [ drop ] if ;

basis/ui/backend/x11/x11.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2009 Eduardo Cavazos and Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays ascii assocs
+USING: accessors alien.c-types arrays ascii assocs colors
 classes.struct combinators io.encodings.ascii
 io.encodings.string io.encodings.utf8 kernel literals math
 namespaces sequences strings ui ui.backend ui.clipboards
@@ -63,6 +63,9 @@ M: x11-ui-backend (pixel-format-attribute)
         0 <int> [ glXGetConfig drop ] keep *int
     ] if-empty ;
 
+M: x11-ui-backend system-background-color
+    T{ rgba f 0.0 0.0 0.0 0.0 } ; inline
+
 CONSTANT: modifiers
     {
         { S+ HEX: 1 }

basis/ui/render/render.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: math.rectangles math.vectors namespaces kernel accessors
 assocs combinators sequences opengl opengl.gl colors
-colors.constants ui.gadgets ui.pens ;
+colors.constants ui.backend ui.gadgets ui.pens ;
 IN: ui.render
 
 SYMBOL: clip
@@ -38,7 +38,9 @@ SYMBOL: viewport-translation
 
 : clear-gl ( transparent? -- )
     [
-        0.0 0.0 0.0 0.0 glClearColor
+        system-background-color
+        [ red>> ] [ green>> ] [ blue>> ] tri 0.0
+        glClearColor
         GL_COLOR_BUFFER_BIT glClear
     ] [
         ! white gl-clear is broken w.r.t window resizing

basis/windows/dwmapi/dwmapi.factor

@@ -1,5 +1,6 @@
 ! (c)2009 Joe Groff bsd license
-USING: alien.c-types alien.libraries alien.syntax classes.struct windows.types ;
+USING: alien.c-types alien.data alien.libraries alien.syntax
+classes.struct kernel math system-info.windows windows.types ;
 IN: windows.dwmapi
 
 STRUCT: MARGINS
@@ -26,3 +27,11 @@ LIBRARY: dwmapi
 
 FUNCTION: HRESULT DwmExtendFrameIntoClientArea ( HWND hWnd, MARGINS* pMarInset ) ;
 FUNCTION: HRESULT DwmEnableBlurBehindWindow ( HWND hWnd, DWM_BLURBEHIND* pBlurBehind ) ;
+FUNCTION: HRESULT DwmIsCompositionEnabled ( BOOL* pfEnabled ) ;
+
+CONSTANT: WM_DWMCOMPOSITIONCHANGED HEX: 31E
+
+: composition-enabled? ( -- ? )
+    windows-major 6 >=
+    [ 0 <int> [ DwmIsCompositionEnabled drop ] keep *int c-bool> ]
+    [ f ] if ;

basis/windows/types/types.factor

@@ -378,9 +378,15 @@ TYPEDEF: DWORD* LPCOLORREF
 
 : RGB ( r g b -- COLORREF )
     { 16 8 0 } bitfield ; inline
+: >RGB< ( COLORREF -- r g b )
+    [           HEX: ff bitand ]
+    [  -8 shift HEX: ff bitand ]
+    [ -16 shift HEX: ff bitand ] tri ;
 
 : color>RGB ( color -- COLORREF )
     >rgba-components drop [ 255 * >integer ] tri@ RGB ;
+: RGB>color ( COLORREF -- color )
+    >RGB< [ 1/255. * >float ] tri@ 1.0 <rgba> ;
 
 STRUCT: TEXTMETRICW
     { tmHeight LONG }

basis/windows/user32/user32.factor

@@ -998,7 +998,7 @@ FUNCTION: int GetPriorityClipboardFormat ( UINT* paFormatPriorityList, int cForm
 ! FUNCTION: GetScrollRange
 ! FUNCTION: GetShellWindow
 ! FUNCTION: GetSubMenu
-! FUNCTION: GetSysColor
+FUNCTION: COLORREF GetSysColor ( int nIndex ) ;
 FUNCTION: HBRUSH GetSysColorBrush ( int nIndex ) ;
 FUNCTION: HMENU GetSystemMenu ( HWND hWnd, BOOL bRevert ) ;
 ! FUNCTION: GetSystemMetrics