steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

update RECT for new structs

db4
Doug Coleman 2009-08-27 21:16:28 -05:00
parent 7df875c7fe
commit c926854790
3 changed files with 32 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
basis/ui/backend/windows/windows.factor
View File

@ -260,12 +260,14 @@ CONSTANT: window-control>ex-style
window-controls>> window-control>ex-style symbols>flags ; window-controls>> window-control>ex-style symbols>flags ;
: get-RECT-top-left ( RECT -- x y ) : 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-dimensions ( RECT -- x y width height )
[ get-RECT-top-left ] keep [ get-RECT-top-left ] [ get-RECT-width/height ] bi ;
[ RECT-right ] keep [ RECT-left - ] keep
[ RECT-bottom ] keep RECT-top - ;
: handle-wm-paint ( hWnd uMsg wParam lParam -- ) : handle-wm-paint ( hWnd uMsg wParam lParam -- )
#! wParam and lParam are unused #! wParam and lParam are unused
@ -610,12 +612,12 @@ M: windows-ui-backend do-events
: make-RECT ( world -- RECT ) : make-RECT ( world -- RECT )
[ window-loc>> ] [ dim>> ] bi <RECT> ; [ window-loc>> ] [ dim>> ] bi <RECT> ;
: default-position-RECT ( RECT -- ) : default-position-RECT ( RECT -- RECT' )
dup get-RECT-dimensions [ 2drop ] 2dip dup get-RECT-width/height
CW_USEDEFAULT + pick set-RECT-bottom [ CW_USEDEFAULT + >>bottom ] dip
CW_USEDEFAULT + over set-RECT-right CW_USEDEFAULT + >>right
CW_USEDEFAULT over set-RECT-left CW_USEDEFAULT >>left
CW_USEDEFAULT swap set-RECT-top ; CW_USEDEFAULT >>top ;
: make-adjusted-RECT ( rect style ex-style -- RECT ) : 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 get-RECT-top-left [ zero? ] both? swap
dup dup
] 2dip adjust-RECT ] 2dip adjust-RECT
swap [ dup default-position-RECT ] when ; swap [ default-position-RECT ] when ;
: get-window-class ( -- class-name ) : get-window-class ( -- class-name )
class-name-ptr [ class-name-ptr [

10
basis/windows/types/types-tests.factor Executable file
View File

@ -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

21
basis/windows/types/types.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax namespaces kernel words USING: alien alien.c-types alien.syntax namespaces kernel words
sequences math math.bitwise math.vectors colors sequences math math.bitwise math.vectors colors
io.encodings.utf16n classes.struct ; io.encodings.utf16n classes.struct accessors ;
IN: windows.types IN: windows.types
TYPEDEF: char CHAR TYPEDEF: char CHAR
@ -242,11 +242,11 @@ STRUCT: WNDCLASSEX
{ lpszClassName LPCTSTR } { lpszClassName LPCTSTR }
{ hIconSm HICON } ; { hIconSm HICON } ;
C-STRUCT: RECT STRUCT: RECT
{ "LONG" "left" } { left LONG }
{ "LONG" "top" } { top LONG }
{ "LONG" "right" } { right LONG }
{ "LONG" "bottom" } ; { bottom LONG } ;
C-STRUCT: PAINTSTRUCT C-STRUCT: PAINTSTRUCT
{ "HDC" " hdc" } { "HDC" " hdc" }
@ -336,12 +336,9 @@ C-STRUCT: RECT
{ "LONG" "bottom" } ; { "LONG" "bottom" } ;
: <RECT> ( loc dim -- RECT ) : <RECT> ( loc dim -- RECT )
over v+ [ RECT <struct> ] 2dip
"RECT" <c-object> [ drop [ first >>left ] [ second >>top ] bi ]
over first over set-RECT-right [ v+ [ first >>right ] [ second >>bottom ] bi ] 2bi ;
swap second over set-RECT-bottom
over first over set-RECT-left
swap second over set-RECT-top ;
TYPEDEF: RECT* PRECT TYPEDEF: RECT* PRECT
TYPEDEF: RECT* LPRECT TYPEDEF: RECT* LPRECT