]> gitweb.factorcode.org Git - factor.git/commitdiff
update RECT for new structs
authorDoug Coleman <doug.coleman@gmail.com>
Fri, 28 Aug 2009 02:16:28 +0000 (21:16 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Fri, 28 Aug 2009 02:16:28 +0000 (21:16 -0500)
basis/ui/backend/windows/windows.factor
basis/windows/types/types-tests.factor [new file with mode: 0755]
basis/windows/types/types.factor

index 6ccb53e8b25b36b955cc76cea082191775ae8701..5ff33c65d6652d51eb5e8dac06bad8adfbec2c2e 100755 (executable)
@@ -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
@@ -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
@@ -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
index 37505210b57bb82fc90f0b0ac520167cc9a20de4..081e03f292765cf590c0481cfb41f00fb0551ae2 100755 (executable)
@@ -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
@@ -242,11 +242,11 @@ STRUCT: WNDCLASSEX
     { lpszClassName LPCTSTR }
     { hIconSm HICON } ;
 
-C-STRUCT: RECT
-    { "LONG" "left" }
-    { "LONG" "top" }
-    { "LONG" "right" }
-    { "LONG" "bottom" } ;
+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