support textured windows on os x and windows 6.x

basis/cocoa/views/views.factor

@@ -40,7 +40,9 @@ CONSTANT: NSOpenGLPFAScreenMask 84
 CONSTANT: NSOpenGLPFAPixelBuffer 90
 CONSTANT: NSOpenGLPFAAllowOfflineRenderers 96
 CONSTANT: NSOpenGLPFAVirtualScreenCount 128
+
 CONSTANT: NSOpenGLCPSwapInterval 222
+CONSTANT: NSOpenGLCPSurfaceOpacity 236
 
 : <GLView> ( class dim pixel-format -- view )
     [ -> alloc ]

basis/cocoa/windows/windows.factor

@@ -10,6 +10,7 @@ CONSTANT: NSTitledWindowMask         1
 CONSTANT: NSClosableWindowMask             2
 CONSTANT: NSMiniaturizableWindowMask       4
 CONSTANT: NSResizableWindowMask            8
+CONSTANT: NSTexturedBackgroundWindowMask 256
 
 ! Additional panel-only styles 
 CONSTANT: NSUtilityWindowMask       16
@@ -26,7 +27,7 @@ CONSTANT: NSBackingStoreBuffered    2
     -> initWithContentRect:styleMask:backing:defer: ;
 
 : class-for-style ( style -- NSWindow/NSPanel )
-    HEX: 1ff0 bitand zero? NSWindow NSPanel ? ;
+    HEX: 1ef0 bitand zero? NSWindow NSPanel ? ;
 
 : <ViewWindow> ( view rect style -- window )
     dup class-for-style <NSWindow> [ swap -> setContentView: ] keep

basis/ui/backend/cocoa/cocoa.factor

@@ -117,14 +117,20 @@ CONSTANT: window-control>styleMask
         { resize-handles $ NSResizableWindowMask }
         { small-title-bar $[ NSTitledWindowMask NSUtilityWindowMask bitor ] }
         { normal-title-bar $ NSTitledWindowMask }
+        { textured-background $ NSTexturedBackgroundWindowMask }
     }
 
 : world>styleMask ( world -- n )
     window-controls>> window-control>styleMask symbols>flags ;
 
+: make-context-transparent ( view -- )
+    -> openGLContext
+    0 <int> NSOpenGLCPSurfaceOpacity -> setValues:forParameter: ;
+
 M:: cocoa-ui-backend (open-window) ( world -- )
     world [ [ dim>> ] dip <FactorView> ]
     with-world-pixel-format :> view
+    world transparent?>> [ 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

@@ -399,6 +399,12 @@ CLASS: {
     ]
 }
 
+{ "isOpaque" "char" { "id" "SEL" }
+    [
+        drop window transparent?>> not >c-bool
+    ]
+}
+
 { "dealloc" "void" { "id" "SEL" }
     [
         drop

basis/ui/backend/windows/windows.factor

@@ -5,10 +5,10 @@ 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
+vectors words windows.dwmapi system-info.windows windows.kernel32
-windows.opengl32 windows.messages windows.types
+windows.gdi32 windows.user32 windows.opengl32 windows.messages
-windows.offscreen windows.nt threads libc combinators fry
+windows.types windows.offscreen windows.nt threads libc combinators
-combinators.short-circuit continuations command-line shuffle
+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
@@ -680,6 +680,11 @@ 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 >= ] } 0&&
+    [ 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 ;
@@ -688,8 +693,9 @@ M: windows-ui-backend (open-window) ( world -- )
     [
         dup
         [ ] [ world>style ] [ world>ex-style ] tri create-window
+        [ ?make-glass ]
         [ ?disable-close-button ]
-        [ [ f f ] dip f f <win> >>handle setup-gl ] 2bi
+        [ [ f f ] dip f f <win> >>handle setup-gl ] 2tri
     ]
     [ dup handle>> hWnd>> register-window ]
     [ handle>> hWnd>> show-window ] tri ;

basis/ui/gadgets/worlds/worlds.factor

@@ -13,7 +13,8 @@ SYMBOLS:
     maximize-button
     resize-handles
     small-title-bar
-    normal-title-bar ;
+    normal-title-bar
+    textured-background ;
 
 CONSTANT: default-world-pixel-format-attributes
     { windowed double-buffered T{ depth-bits { value 16 } } }
@@ -34,6 +35,7 @@ TUPLE: world < track
     text-handle handle images
     window-loc
     pixel-format-attributes
+    transparent?
     window-controls
     window-resources ;
 
@@ -119,6 +121,7 @@ M: world request-focus-on ( child gadget -- )
         [ status>> >>status ]
         [ pixel-format-attributes>> >>pixel-format-attributes ]
         [ window-controls>> >>window-controls ]
+        [ window-controls>> textured-background swap memq? >>transparent? ]
         [ grab-input?>> >>grab-input? ]
         [ gadgets>> [ 1 track-add ] each ]
     } cleave ;
@@ -174,6 +177,7 @@ 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

@@ -34,11 +34,18 @@ SYMBOL: viewport-translation
     GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
     GL_VERTEX_ARRAY glEnableClientState
     init-matrices
-    init-clip
+    init-clip ;
+
+: clear-gl ( transparent? -- )
+    [
+        0.0 0.0 0.0 0.0 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 ;
+        { 0 0 } clip get dim>> gl-fill-rect
+    ] if ;
 
 GENERIC: draw-gadget* ( gadget -- )
 

basis/ui/ui-docs.factor

@@ -290,6 +290,9 @@ HELP: small-title-bar
 HELP: normal-title-bar
 { $description "Asks for a window to have a title bar. Without a title bar, the " { $link close-button } ", " { $link minimize-button } ", and " { $link maximize-button } " controls will not be available." } ;
 
+HELP: textured-background
+{ $description "Asks for a window to have a background that blends seamlessly with the window frame. Factor will leave the window background transparent and pass mouse button gestures not handled directly by a gadget through to the window system so that the window can be dragged from anywhere on its background." } ;
+
 ARTICLE: "ui.gadgets.worlds-window-controls" "Window controls"
 "The following window controls can be placed in a " { $link world } " window:"
 { $subsection close-button }
@@ -298,4 +301,5 @@ ARTICLE: "ui.gadgets.worlds-window-controls" "Window controls"
 { $subsection resize-handles }
 { $subsection small-title-bar }
 { $subsection normal-title-bar }
+{ $subsection textured-background }
 "Provide a sequence of these values in the " { $snippet "window-controls" } " slot of the " { $link world-attributes } " tuple you pass to " { $link open-window } "." ;

extra/window-controls-demo/window-controls-demo.factor

@@ -13,6 +13,7 @@ CONSTANT: window-control-sets-to-test
         { "Minimize button" { normal-title-bar minimize-button } }
         { "Close, minimize, and maximize buttons" { normal-title-bar close-button minimize-button maximize-button } }
         { "Resizable" { normal-title-bar close-button minimize-button maximize-button resize-handles } }
+        { "Textured background" { normal-title-bar close-button minimize-button maximize-button resize-handles textured-background } }
     }
 
 TUPLE: window-controls-demo-world < world