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

flatland: minor changes

db4
Eduardo Cavazos 2008-12-01 13:15:47 -06:00
parent b5a04f6a5d
commit f75a52474b
1 changed files with 42 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
extra/flatland/flatland.factor
View File

@ -176,3 +176,45 @@ METHOD: height ( <extent> -- height ) \\ top>> bottom>> bi - ;
! METHOD: to-extent ( <rectangle> -- <extent> )
! { [ left>> ] [ right>> ] [ bottom>> ] [ top>> ] } cleave <extent> boa ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
METHOD: to-the-left-of? ( sequence <rectangle> -- ? ) \\ x left bi* < ;
METHOD: to-the-right-of? ( sequence <rectangle> -- ? ) \\ x right bi* > ;
METHOD: below? ( sequence <rectangle> -- ? ) \\ y bottom bi* < ;
METHOD: above? ( sequence <rectangle> -- ? ) \\ y top bi* > ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Some support for the' 'rect' class from math.geometry.rect'
! METHOD: width ( rect -- width ) dim>> first ;
! METHOD: height ( rect -- height ) dim>> second ;
! METHOD: left ( rect -- left ) loc>> x
! METHOD: right ( rect -- right ) [ loc>> x ] [ width ] bi + ;
! METHOD: to-the-left-of? ( sequence rect -- ? ) [ x ] [ loc>> x ] bi* < ;
! METHOD: to-the-right-of? ( sequence rect -- ? ) [ x ] [ loc>> x ] bi* > ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
USING: locals combinators ;
:: wrap ( POINT RECT -- POINT )
{
{ [ POINT RECT to-the-left-of? ] [ RECT right ] }
{ [ POINT RECT to-the-right-of? ] [ RECT left ] }
{ [ t ] [ POINT x ] }
}
cond
{
{ [ POINT RECT below? ] [ RECT top ] }
{ [ POINT RECT above? ] [ RECT bottom ] }
{ [ t ] [ POINT y ] }
}
cond
2array ;