clean up textured window code

basis/ui/backend/backend.factor

@@ -21,8 +21,6 @@ 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,9 +58,6 @@ 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
@@ -133,7 +130,8 @@ CONSTANT: window-control>styleMask
 M:: cocoa-ui-backend (open-window) ( world -- )
     world [ [ dim>> ] dip <FactorView> ]
     with-world-pixel-format :> view
-    world transparent?>> [ view make-context-transparent ] when
+    world window-controls>> textured-background swap memq?
+    [ view make-context-transparent ] when
     view world [ world>NSRect ] [ world>styleMask ] bi <ViewWindow> :> window
     view -> release
     world view register-window

basis/ui/backend/cocoa/views/views.factor

@@ -401,7 +401,7 @@ CLASS: {
 
 { "isOpaque" "char" { "id" "SEL" }
     [
-        drop window transparent?>> not >c-bool
+        2drop 0
     ]
 }
 

basis/ui/backend/windows/windows.factor

@@ -165,11 +165,6 @@ 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
@@ -538,10 +533,18 @@ SYMBOL: nc-buttons
     #! message sent if mouse leaves main application 
     4drop forget-rollover ;
 
+: system-background-color ( -- color )
+    COLOR_BTNFACE GetSysColor RGB>color ;
+
 : ?make-glass ( world hwnd -- )
-    swap { [ transparent?>> ] [ drop windows-major 6 >= ] } 1&&
-    [ full-window-margins DwmExtendFrameIntoClientArea drop ]
-    [ drop ] if ;
+    over {
+        [ composition-enabled? ]
+        [ window-controls>> textured-background swap memq? ]
+    } 1&&
+    [
+        full-window-margins DwmExtendFrameIntoClientArea drop
+        T{ rgba f 0.0 0.0 0.0 0.0 }
+    ] [ system-background-color ] if >>background-color ;
 
 : handle-wm-dwmcompositionchanged ( hWnd uMsg wParam lParam -- )
     3drop [ window ] keep ?make-glass ;

basis/ui/backend/x11/x11.factor

@@ -63,9 +63,6 @@ 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 1.0 1.0 1.0 0.0 } ; inline
-
 CONSTANT: modifiers
     {
         { S+ HEX: 1 }

basis/ui/gadgets/worlds/worlds.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs continuations kernel math models
-namespaces opengl opengl.textures sequences io combinators
+namespaces opengl opengl.textures sequences io colors combinators
 combinators.short-circuit fry math.vectors math.rectangles cache
 ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
 ui.pixel-formats destructors literals strings ;
@@ -17,7 +17,11 @@ SYMBOLS:
     textured-background ;
 
 CONSTANT: default-world-pixel-format-attributes
-    { windowed double-buffered T{ depth-bits { value 16 } } }
+    {
+        windowed
+        double-buffered
+        T{ depth-bits { value 16 } }
+    }
 
 CONSTANT: default-world-window-controls
     {
@@ -35,7 +39,7 @@ TUPLE: world < track
     text-handle handle images
     window-loc
     pixel-format-attributes
-    transparent?
+    background-color
     window-controls
     window-resources ;
 
@@ -115,13 +119,18 @@ M: world request-focus-on ( child gadget -- )
         f >>grab-input?
         V{ } clone >>window-resources ;
 
+: initial-background-color ( attributes -- color )
+    window-controls>> textured-background swap memq?
+    [ T{ rgba f 0.0 0.0 0.0 0.0 } ]
+    [ T{ rgba f 1.0 1.0 1.0 1.0 } ] if ;
+
 : apply-world-attributes ( world attributes -- world )
     {
         [ title>> >>title ]
         [ status>> >>status ]
         [ pixel-format-attributes>> >>pixel-format-attributes ]
         [ window-controls>> >>window-controls ]
-        [ window-controls>> textured-background swap memq? >>transparent? ]
+        [ initial-background-color >>background-color ]
         [ grab-input?>> >>grab-input? ]
         [ gadgets>> [ 1 track-add ] each ]
     } cleave ;
@@ -177,7 +186,6 @@ M: world draw-world*
     check-extensions
     {
         [ init-gl ]
-        [ transparent?>> clear-gl ]
         [ draw-gadget ]
         [ text-handle>> [ purge-cache ] when* ]
         [ images>> [ purge-cache ] when* ]

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.backend ui.gadgets ui.pens ;
+colors.constants ui.gadgets ui.pens ;
 IN: ui.render
 
 SYMBOL: clip
@@ -27,27 +27,20 @@ SYMBOL: viewport-translation
     [ clip set ] bi
     do-clip ;
 
-: init-gl ( clip-rect -- )
+SLOT: background-color
+
+: init-gl ( world -- )
     GL_SMOOTH glShadeModel
     GL_SCISSOR_TEST glEnable
     GL_BLEND glEnable
     GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
     GL_VERTEX_ARRAY glEnableClientState
     init-matrices
-    init-clip ;
-
-: clear-gl ( transparent? -- )
+    [ init-clip ]
     [
-        system-background-color
-        [ red>> ] [ green>> ] [ blue>> ] tri 0.0
-        glClearColor
+        background-color>> >rgba-components glClearColor
         GL_COLOR_BUFFER_BIT glClear
-    ] [
-        ! white gl-clear is broken w.r.t window resizing
-        ! Linux/PPC Radeon 9200
-        COLOR: white gl-color
-        { 0 0 } clip get dim>> gl-fill-rect
-    ] if ;
+    ] bi ;
 
 GENERIC: draw-gadget* ( gadget -- )