Merge branch 'fix_stack_alignment' of git://github.com/phildawes/factor

diff --git a/basis/alien/complex/complex-tests.factor b/basis/alien/complex/complex-tests.factor
index 7bf826d87e10f191bb1dfa5ab6d52cfddce4027d..87f0c98b474336e1bb43b236ded6f29435703467 100644 (file)
--- a/basis/alien/complex/complex-tests.factor
+++ b/basis/alien/complex/complex-tests.factor
@@ -16,6 +16,6 @@ STRUCT: complex-holder
 
 [ C{ 1.0 2.0 } ] [ "h" get z>> ] unit-test
 
-[ number ] [ "complex-float" c-type-boxed-class ] unit-test
+[ complex ] [ "complex-float" c-type-boxed-class ] unit-test
 
-[ number ] [ "complex-double" c-type-boxed-class ] unit-test
+[ complex ] [ "complex-double" c-type-boxed-class ] unit-test

diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index 63f2ad282eb4b1c30dca09a00d5401f474c0bf53..beddf07dd5ea565fc143ca74a15282517b9fead1 100755 (executable)
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -27,9 +27,10 @@ PREDICATE: struct-class < tuple-class
 
 M: struct-class valid-superclass? drop f ;
 
-GENERIC: struct-slots ( struct-class -- slots )
+SLOT: fields
 
-M: struct-class struct-slots "struct-slots" word-prop ;
+: struct-slots ( struct-class -- slots )
+    "c-type" word-prop fields>> ;
 
 ! struct allocation
 
@@ -175,16 +176,15 @@ M: struct-c-type c-struct? drop t ;
     [ \ clone-underlying swap literalize \ memory>struct [ ] 3sequence ] bi
     define-inline-method ;
 
-: c-type-for-class ( class -- c-type )
-    struct-c-type new swap {
-        [ drop byte-array >>class ]
-        [ >>boxed-class ]
-        [ struct-slots >>fields ]
-        [ "struct-size" word-prop >>size ]
-        [ "struct-align" word-prop >>align ]
-        [ (unboxer-quot) >>unboxer-quot ]
-        [ (boxer-quot) >>boxer-quot ]
-    } cleave ;
+:: c-type-for-class ( class slots size align -- c-type )
+    struct-c-type new
+        byte-array >>class
+        class >>boxed-class
+        slots >>fields
+        size >>size
+        align >>align
+        class (unboxer-quot) >>unboxer-quot
+        class (boxer-quot)   >>boxer-quot ;
     
 : align-offset ( offset class -- offset' )
     c-type-align align ;
@@ -221,7 +221,7 @@ M: struct binary-zero?
 
 : make-struct-prototype ( class -- prototype )
     dup struct-needs-prototype? [
-        [ "struct-size" word-prop <byte-array> ]
+        [ "c-type" word-prop size>> <byte-array> ]
         [ memory>struct ]
         [ struct-slots ] tri
         [
@@ -236,35 +236,26 @@ M: struct binary-zero?
     [ (define-clone-method) ]
     bi ;
 
-: (struct-word-props) ( class slots size align -- )
-    [
-        [ "struct-slots" set-word-prop ]
-        [ define-accessors ] 2bi
-    ]
-    [ "struct-size" set-word-prop ]
-    [ "struct-align" set-word-prop ] tri-curry*
-    [ tri ] 3curry
-    [ dup make-struct-prototype "prototype" set-word-prop ]
-    [ (struct-methods) ] tri ;
-
 : check-struct-slots ( slots -- )
     [ type>> c-type drop ] each ;
 
 : redefine-struct-tuple-class ( class -- )
     [ dup class? [ forget-class ] [ drop ] if ] [ struct f define-tuple-class ] bi ;
 
-: (define-struct-class) ( class slots offsets-quot -- )
-    [ 
-        empty?
-        [ struct-must-have-slots ]
-        [ redefine-struct-tuple-class ] if
-    ]
-    swap '[
-        make-slots dup
-        [ check-struct-slots ] _ [ struct-align [ align ] keep ] tri
-        (struct-word-props)
-    ]
-    [ drop [ c-type-for-class ] keep typedef ] 2tri ; inline
+:: (define-struct-class) ( class slots offsets-quot -- )
+    slots empty? [ struct-must-have-slots ] when
+    class redefine-struct-tuple-class
+    slots make-slots dup check-struct-slots :> slot-specs
+    slot-specs struct-align :> alignment
+    slot-specs offsets-quot call alignment align :> size
+
+    class  slot-specs  size  alignment  c-type-for-class :> c-type
+
+    c-type class typedef
+    class slot-specs define-accessors
+    class size "struct-size" set-word-prop
+    class dup make-struct-prototype "prototype" set-word-prop
+    class (struct-methods) ; inline
 PRIVATE>
 
 : define-struct-class ( class slots -- )

diff --git a/basis/cocoa/views/views.factor b/basis/cocoa/views/views.factor
index badcac5cdb4965d877e80577b5017050e53feefd..585f23dde37f99525de52b662fa54b99928b63eb 100644 (file)
--- a/basis/cocoa/views/views.factor
+++ b/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 ]

diff --git a/basis/cocoa/windows/windows.factor b/basis/cocoa/windows/windows.factor
index ed2c2d51bd6fbcc948422d35e3119276dbd26538..a4b1b7f210f5c5bb81188ad8015640029e2b60d1 100644 (file)
--- a/basis/cocoa/windows/windows.factor
+++ b/basis/cocoa/windows/windows.factor
@@ -5,11 +5,12 @@ sequences math.bitwise ;
 IN: cocoa.windows
 
 ! Window styles
-CONSTANT: NSBorderlessWindowMask     0
-CONSTANT: NSTitledWindowMask         1
-CONSTANT: NSClosableWindowMask       2
-CONSTANT: NSMiniaturizableWindowMask 4
-CONSTANT: NSResizableWindowMask      8
+CONSTANT: NSBorderlessWindowMask           0
+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

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index f67c73e2e950978bda7f7eb13dcb14d0f9faad94..7e1060cbb9a9a5984e9943e759bfeef5444e87bd 100644 (file)
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -338,6 +338,8 @@ M: ppc %abs-vector-reps { } ;
 M: ppc %and-vector-reps { } ;
 M: ppc %or-vector-reps { } ;
 M: ppc %xor-vector-reps { } ;
+M: ppc %shl-vector-reps { } ;
+M: ppc %shr-vector-reps { } ;
 
 M: ppc %unbox-alien ( dst src -- )
     alien-offset LWZ ;

diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 2b4c38beaf8d9f7ac15f4154b68377e520f02fc2..825b6f9c54cf31b71c3a4b9eacc70fb8340d9318 100755 (executable)
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -198,7 +198,7 @@ IN: tools.deploy.shaker
         ] when
         
         deploy-c-types? get [
-            { "c-type" "struct-slots" "struct-size" "struct-align" } %
+            { "c-type" "struct-slots" "struct-align" } %
         ] unless
     ] { } make ;
 

diff --git a/basis/ui/backend/backend.factor b/basis/ui/backend/backend.factor
index 62636fdcdfd2350cef521f26540dc1a02b9a910a..d877ad9b81e1f2ce79aeedaa74688c0284ae3da0 100755 (executable)
--- a/basis/ui/backend/backend.factor
+++ b/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 -- )

diff --git a/basis/ui/backend/cocoa/cocoa.factor b/basis/ui/backend/cocoa/cocoa.factor
index 111e20aea20c7187168064794615a9aae5d56fda..f6745e4bc2b607cf0ae4c996ff4274a105f263ec 100755 (executable)
--- a/basis/ui/backend/cocoa/cocoa.factor
+++ b/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
@@ -117,14 +120,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

diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor
index a49d22735d08741d2ed45df95ee19160a43b5647..4c581a86e38311a0f297ede2dd5fa79d7b3e3645 100644 (file)
--- a/basis/ui/backend/cocoa/views/views.factor
+++ b/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

diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 1e01f889dc3cbc76fb0bc81a93e032dfdb3e97d5..3d8f5b153074f04f43d79624ecfdc854b990ae9d 100755 (executable)
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -5,14 +5,14 @@ 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 threads libc combinators fry
-combinators.short-circuit continuations command-line shuffle
+vectors words windows.dwmapi system-info.windows windows.kernel32
+windows.gdi32 windows.user32 windows.opengl32 windows.messages
+windows.types windows.offscreen windows.nt threads libc combinators
+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
@@ -230,6 +235,7 @@ SYMBOLS: msg-obj class-name-ptr mouse-captured ;
 CONSTANT: window-control>style
     H{
         { close-button 0 }
+        { textured-background 0 }
         { minimize-button $ WS_MINIMIZEBOX }
         { maximize-button $ WS_MAXIMIZEBOX }
         { resize-handles $ WS_THICKFRAME }
@@ -240,6 +246,7 @@ CONSTANT: window-control>style
 CONSTANT: window-control>ex-style
     H{
         { close-button 0 }
+        { textured-background 0 }
         { minimize-button 0 }
         { maximize-button 0 }
         { resize-handles $ WS_EX_WINDOWEDGE }
@@ -531,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
@@ -560,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
@@ -688,8 +704,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 ;

diff --git a/basis/ui/backend/x11/x11.factor b/basis/ui/backend/x11/x11.factor
index aab7fd4c340cf54c276989f3937402eb41b39103..049c7886fd206f1f6ae0770d8669aa68b19c81a5 100755 (executable)
--- a/basis/ui/backend/x11/x11.factor
+++ b/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 }

diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor
index 91666c4e7a786164412a48d0d14a8e71a1084902..535715b8eddc90bb5ede6747d26a60aaf8428535 100755 (executable)
--- a/basis/ui/gadgets/worlds/worlds.factor
+++ b/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* ]

diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor
index c4e6f5688639d1b21a125a237e6895070495f45f..39be7936af440b78cb874ac7681a185f3fdc43cd 100755 (executable)
--- a/basis/ui/render/render.factor
+++ b/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
@@ -34,11 +34,20 @@ SYMBOL: viewport-translation
     GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
     GL_VERTEX_ARRAY glEnableClientState
     init-matrices
-    init-clip
-    ! 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 ;
+    init-clip ;
+
+: clear-gl ( transparent? -- )
+    [
+        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
+        ! Linux/PPC Radeon 9200
+        COLOR: white gl-color
+        { 0 0 } clip get dim>> gl-fill-rect
+    ] if ;
 
 GENERIC: draw-gadget* ( gadget -- )
 

diff --git a/basis/ui/ui-docs.factor b/basis/ui/ui-docs.factor
index 43dd22cde7e0a4116e0ba4ff57286aa53962c689..6072cbc65f4af92864105ad72c2de0056970ec18 100644 (file)
--- a/basis/ui/ui-docs.factor
+++ b/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 } "." ;

diff --git a/basis/windows/dwmapi/dwmapi.factor b/basis/windows/dwmapi/dwmapi.factor
index e7e0b4b8efc9e89f882a21cfd14cea313f07a028..998846ebc2bbe272ab9a9abb8cc029ad1b87ee88 100755 (executable)
--- a/basis/windows/dwmapi/dwmapi.factor
+++ b/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 ;

diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index 6275f2d3c95a9007e43b1b358e099a25b71a0a15..f3455fbb0f830802c1ada71885a8c9a0a7f84f8a 100755 (executable)
--- a/basis/windows/types/types.factor
+++ b/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 }

diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor
index 4c39385ce5b239c7c513929d312705efd694971c..43b59d613b03843733f1ffe5fe6404fe0701b897 100755 (executable)
--- a/basis/windows/user32/user32.factor
+++ b/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

diff --git a/extra/window-controls-demo/window-controls-demo.factor b/extra/window-controls-demo/window-controls-demo.factor
index 89e4c7001f9389daea04c9b8b39f075f7e4ec3f7..72811a2c7b18e275702ee1276b47ebb2358f84f2 100755 (executable)
--- a/extra/window-controls-demo/window-controls-demo.factor
+++ b/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