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

improvements to x11/rectangle.factor

darcs
wayo.cavazos 2006-02-17 01:45:44 +00:00
parent 4e727be9d0
commit 34496556d1
1 changed files with 19 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
contrib/x11/rectangle.factor
View File

@ -1,6 +1,4 @@
USING: kernel math sequences arrays ; IN: rectangle
IN: rectangle
USING: kernel math ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@ -9,6 +7,9 @@ TUPLE: rect corner size ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
GENERIC: top-left GENERIC: top-left
GENERIC: top-right
GENERIC: bottom-left
GENERIC: bottom-right
GENERIC: move-top-left GENERIC: move-top-left
GENERIC: move-top-right GENERIC: move-top-right
@ -19,8 +20,23 @@ GENERIC: move-middle-center
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: rect-width ( rect -- width ) rect-size 0 swap nth ;
: rect-height ( rect -- height ) rect-size 1 swap nth ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
M: rect top-left ( rect -- point ) rect-corner ; M: rect top-left ( rect -- point ) rect-corner ;
M: rect top-right ( rect -- point )
dup rect-corner swap rect-width 1 - 0 2array v+ ;
M: rect bottom-left ( rect -- point )
dup rect-corner swap rect-height 1 - 0 swap 2array v+ ;
M: rect bottom-right ( rect -- point )
dup rect-corner swap rect-size { -1 -1 } v+ v+ ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: move-top-left:new-corner ( point rect -- corner ) : move-top-left:new-corner ( point rect -- corner )