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

diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index 7ce9afe5e64e716bdd04b42f97ae00c8a52798b4..5ff33c65d6652d51eb5e8dac06bad8adfbec2c2e 100755 (executable)
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -260,12 +260,14 @@ CONSTANT: window-control>ex-style
     window-controls>> window-control>ex-style symbols>flags ;
 
 : get-RECT-top-left ( RECT -- x y )
-    [ RECT-left ] keep RECT-top ;
+    [ left>> ] [ top>> ] bi ;
+
+: get-RECT-width/height ( RECT -- width height )
+    [ [ right>> ] [ left>> ] bi - ]
+    [ [ bottom>> ] [ top>> ] bi - ] bi ;
 
 : get-RECT-dimensions ( RECT -- x y width height )
-    [ get-RECT-top-left ] keep
-    [ RECT-right ] keep [ RECT-left - ] keep
-    [ RECT-bottom ] keep RECT-top - ;
+    [ get-RECT-top-left ] [ get-RECT-width/height ] bi ;
 
 : handle-wm-paint ( hWnd uMsg wParam lParam -- )
     #! wParam and lParam are unused
@@ -503,14 +505,15 @@ SYMBOL: nc-buttons
     ] if ;
 
 : make-TRACKMOUSEEVENT ( hWnd -- alien )
-    "TRACKMOUSEEVENT" <c-object> [ set-TRACKMOUSEEVENT-hwndTrack ] keep
-    "TRACKMOUSEEVENT" heap-size over set-TRACKMOUSEEVENT-cbSize ;
+    TRACKMOUSEEVENT <struct>
+        swap >>hwndTrack
+        TRACKMOUSEEVENT heap-size >>cbSize ;
 
 : handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
     2nip
     over make-TRACKMOUSEEVENT
-    TME_LEAVE over set-TRACKMOUSEEVENT-dwFlags
-    0 over set-TRACKMOUSEEVENT-dwHoverTime
+        TME_LEAVE >>dwFlags
+        0 >>dwHoverTime
     TrackMouseEvent drop
     >lo-hi swap window move-hand fire-motion ;
 
@@ -588,19 +591,18 @@ M: windows-ui-backend do-events
     ] if ;
 
 :: register-window-class ( class-name-ptr -- )
-    "WNDCLASSEX" <c-object> f GetModuleHandle
+    WNDCLASSEX <struct> f GetModuleHandle
     class-name-ptr pick GetClassInfoEx 0 = [
-        "WNDCLASSEX" heap-size over set-WNDCLASSEX-cbSize
-        { CS_HREDRAW CS_VREDRAW CS_OWNDC } flags over set-WNDCLASSEX-style
-        ui-wndproc over set-WNDCLASSEX-lpfnWndProc
-        0 over set-WNDCLASSEX-cbClsExtra
-        0 over set-WNDCLASSEX-cbWndExtra
-        f GetModuleHandle over set-WNDCLASSEX-hInstance
-        f GetModuleHandle "fraptor" utf16n string>alien LoadIcon
-        over set-WNDCLASSEX-hIcon
-        f IDC_ARROW LoadCursor over set-WNDCLASSEX-hCursor
-
-        class-name-ptr over set-WNDCLASSEX-lpszClassName
+        WNDCLASSEX heap-size >>cbSize
+        { CS_HREDRAW CS_VREDRAW CS_OWNDC } flags >>style
+        ui-wndproc >>lpfnWndProc
+        0 >>cbClsExtra
+        0 >>cbWndExtra
+        f GetModuleHandle >>hInstance
+        f GetModuleHandle "fraptor" utf16n string>alien LoadIcon >>hIcon
+        f IDC_ARROW LoadCursor >>hCursor
+
+        class-name-ptr >>lpszClassName
         RegisterClassEx win32-error=0/f
     ] [ drop ] if ;
 
@@ -610,12 +612,12 @@ M: windows-ui-backend do-events
 : make-RECT ( world -- RECT )
     [ window-loc>> ] [ dim>> ] bi <RECT> ;
 
-: default-position-RECT ( RECT -- )
-    dup get-RECT-dimensions [ 2drop ] 2dip
-    CW_USEDEFAULT + pick set-RECT-bottom
-    CW_USEDEFAULT + over set-RECT-right
-    CW_USEDEFAULT over set-RECT-left
-    CW_USEDEFAULT swap set-RECT-top ;
+: default-position-RECT ( RECT -- RECT' )
+    dup get-RECT-width/height
+        [ CW_USEDEFAULT + >>bottom ] dip
+        CW_USEDEFAULT + >>right
+        CW_USEDEFAULT >>left
+        CW_USEDEFAULT >>top ;
 
 : make-adjusted-RECT ( rect style ex-style -- RECT )
     [
@@ -623,7 +625,7 @@ M: windows-ui-backend do-events
         dup get-RECT-top-left [ zero? ] both? swap
         dup
     ] 2dip adjust-RECT
-    swap [ dup default-position-RECT ] when ;
+    swap [ default-position-RECT ] when ;
 
 : get-window-class ( -- class-name )
     class-name-ptr [

diff --git a/basis/windows/types/types-tests.factor b/basis/windows/types/types-tests.factor
new file mode 100755 (executable)
index 0000000..04b480d
--- /dev/null
+++ b/basis/windows/types/types-tests.factor
@@ -0,0 +1,10 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: classes.struct tools.test windows.types ;
+IN: windows.types.tests
+
+[ S{ RECT { right 100 } { bottom 100 } } ]
+[ { 0 0 } { 100 100 } <RECT> ] unit-test
+
+[ S{ RECT { left 100 } { top 100 } { right 200 } { bottom 200 } } ]
+[ { 100 100 } { 100 100 } <RECT> ] unit-test

diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor
index 36823db424386673cf1502f6e42c10af8c10ef6a..081e03f292765cf590c0481cfb41f00fb0551ae2 100755 (executable)
--- a/basis/windows/types/types.factor
+++ b/basis/windows/types/types.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.syntax namespaces kernel words
 sequences math math.bitwise math.vectors colors
-io.encodings.utf16n classes.struct ;
+io.encodings.utf16n classes.struct accessors ;
 IN: windows.types
 
 TYPEDEF: char                CHAR
@@ -228,25 +228,25 @@ C-STRUCT: WNDCLASS
     { "LPCTSTR" "lpszMenuName" }
     { "LPCTSTR" "lpszClassName" } ;
 
-C-STRUCT: WNDCLASSEX
-    { "UINT" "cbSize" }
-    { "UINT" "style" }
-    { "WNDPROC" "lpfnWndProc" }
-    { "int" "cbClsExtra" }
-    { "int" "cbWndExtra" }
-    { "HINSTANCE" "hInstance" }
-    { "HICON" "hIcon" }
-    { "HCURSOR" "hCursor" }
-    { "HBRUSH" "hbrBackground" }
-    { "LPCTSTR" "lpszMenuName" }
-    { "LPCTSTR" "lpszClassName" }
-    { "HICON" "hIconSm" } ;
-
-C-STRUCT: RECT
-    { "LONG" "left" }
-    { "LONG" "top" }
-    { "LONG" "right" }
-    { "LONG" "bottom" } ;
+STRUCT: WNDCLASSEX
+    { cbSize UINT }
+    { style UINT }
+    { lpfnWndProc WNDPROC }
+    { cbClsExtra int }
+    { cbWndExtra int }
+    { hInstance HINSTANCE }
+    { hIcon HICON }
+    { hCursor HCURSOR }
+    { hbrBackground HBRUSH }
+    { lpszMenuName LPCTSTR }
+    { lpszClassName LPCTSTR }
+    { hIconSm HICON } ;
+
+STRUCT: RECT
+    { left LONG }
+    { top LONG }
+    { right LONG }
+    { bottom LONG } ;
 
 C-STRUCT: PAINTSTRUCT
     { "HDC" " hdc" }
@@ -336,12 +336,9 @@ C-STRUCT: RECT
     { "LONG" "bottom" } ;
 
 : <RECT> ( loc dim -- RECT )
-    over v+
-    "RECT" <c-object>
-    over first over set-RECT-right
-    swap second over set-RECT-bottom
-    over first over set-RECT-left
-    swap second over set-RECT-top ;
+    [ RECT <struct> ] 2dip
+    [ drop [ first >>left ] [ second >>top ] bi ]
+    [ v+ [ first >>right ] [ second >>bottom ] bi ] 2bi ;
 
 TYPEDEF: RECT* PRECT
 TYPEDEF: RECT* LPRECT

diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor
index 58981920dad45994febffba90dd7719aedea114d..543ce6e2920b6b2dc5cd3d71cc90f7c2d117d0b1 100755 (executable)
--- a/basis/windows/user32/user32.factor
+++ b/basis/windows/user32/user32.factor
@@ -521,11 +521,11 @@ CONSTANT: TME_NONCLIENT 16
 CONSTANT: TME_QUERY HEX: 40000000
 CONSTANT: TME_CANCEL HEX: 80000000
 CONSTANT: HOVER_DEFAULT HEX: ffffffff
-C-STRUCT: TRACKMOUSEEVENT
-    { "DWORD" "cbSize" }
-    { "DWORD" "dwFlags" }
-    { "HWND" "hwndTrack" }
-    { "DWORD" "dwHoverTime" } ;
+STRUCT: TRACKMOUSEEVENT
+    { cbSize DWORD }
+    { dwFlags DWORD }
+    { hwndTrack HWND }
+    { dwHoverTime DWORD } ;
 TYPEDEF: TRACKMOUSEEVENT* LPTRACKMOUSEEVENT
 
 CONSTANT: DBT_DEVICEARRIVAL HEX: 8000