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

literal syntax for rects

db4
Joe Groff 2009-04-29 14:58:55 -05:00
parent 4038d30e7e
commit c3b63821b9
2 changed files with 22 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
basis/math/rectangles/rectangles-tests.factor
View File

@ -1,42 +1,42 @@
USING: tools.test math.rectangles ;
IN: math.rectangles.tests
[ T{ rect f { 10 10 } { 20 20 } } ]
[ RECT: { 10 10 } { 20 20 } ]
[
T{ rect f { 10 10 } { 50 50 } }
T{ rect f { -10 -10 } { 40 40 } }
RECT: { 10 10 } { 50 50 }
RECT: { -10 -10 } { 40 40 }
rect-intersect
] unit-test
[ T{ rect f { 200 200 } { 0 0 } } ]
[ RECT: { 200 200 } { 0 0 } ]
[
T{ rect f { 100 100 } { 50 50 } }
T{ rect f { 200 200 } { 40 40 } }
RECT: { 100 100 } { 50 50 }
RECT: { 200 200 } { 40 40 }
rect-intersect
] unit-test
[ f ] [
T{ rect f { 100 100 } { 50 50 } }
T{ rect f { 200 200 } { 40 40 } }
RECT: { 100 100 } { 50 50 }
RECT: { 200 200 } { 40 40 }
contains-rect?
] unit-test
[ t ] [
T{ rect f { 100 100 } { 50 50 } }
T{ rect f { 120 120 } { 40 40 } }
RECT: { 100 100 } { 50 50 }
RECT: { 120 120 } { 40 40 }
contains-rect?
] unit-test
[ f ] [
T{ rect f { 1000 100 } { 50 50 } }
T{ rect f { 120 120 } { 40 40 } }
RECT: { 1000 100 } { 50 50 }
RECT: { 120 120 } { 40 40 }
contains-rect?
] unit-test
[ T{ rect f { 10 20 } { 20 20 } } ] [
[ RECT: { 10 20 } { 20 20 } ] [
{
{ 20 20 }
{ 10 40 }
{ 30 30 }
} rect-containing
] unit-test
] unit-test

10
basis/math/rectangles/rectangles.factor
View File

@ -1,12 +1,18 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel arrays sequences math math.vectors accessors ;
USING: kernel arrays sequences math math.vectors accessors
parser prettyprint.custom prettyprint.backend ;
IN: math.rectangles
TUPLE: rect { loc initial: { 0 0 } } { dim initial: { 0 0 } } ;
: <rect> ( loc dim -- rect ) rect boa ; inline
SYNTAX: RECT: scan-object scan-object <rect> parsed ;
M: rect pprint*
\ RECT: [ [ loc>> ] [ dim>> ] bi [ pprint* ] bi@ ] pprint-prefix ;
: <zero-rect> ( -- rect ) rect new ; inline
: point>rect ( loc -- rect ) { 0 0 } <rect> ; inline
@ -55,4 +61,4 @@ M: rect contains-point?
: set-rect-bounds ( rect1 rect -- )
[ [ loc>> ] dip (>>loc) ]
[ [ dim>> ] dip (>>dim) ]
2bi ; inline
2bi ; inline