From c9268547903e432abb0909e839a5d8e382a50357 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 27 Aug 2009 21:16:28 -0500 Subject: [PATCH] update RECT for new structs --- basis/ui/backend/windows/windows.factor | 24 +++++++++++++----------- basis/windows/types/types-tests.factor | 10 ++++++++++ basis/windows/types/types.factor | 21 +++++++++------------ 3 files changed, 32 insertions(+), 23 deletions(-) create mode 100755 basis/windows/types/types-tests.factor diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 6ccb53e8b2..5ff33c65d6 100755 --- 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 @@ -610,12 +612,12 @@ M: windows-ui-backend do-events : make-RECT ( world -- RECT ) [ window-loc>> ] [ dim>> ] bi ; -: 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 index 0000000000..04b480d4d3 --- /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 } ] unit-test + +[ S{ RECT { left 100 } { top 100 } { right 200 } { bottom 200 } } ] +[ { 100 100 } { 100 100 } ] unit-test diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor index 37505210b5..081e03f292 100755 --- 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 @@ -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" } ; : ( loc dim -- RECT ) - over v+ - "RECT" - 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 ] 2dip + [ drop [ first >>left ] [ second >>top ] bi ] + [ v+ [ first >>right ] [ second >>bottom ] bi ] 2bi ; TYPEDEF: RECT* PRECT TYPEDEF: RECT* LPRECT -- 2.34.1