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 ;
: 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 [

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