literal syntax for rects
parent
4038d30e7e
commit
c3b63821b9
|
@ -1,42 +1,42 @@
|
||||||
USING: tools.test math.rectangles ;
|
USING: tools.test math.rectangles ;
|
||||||
IN: math.rectangles.tests
|
IN: math.rectangles.tests
|
||||||
|
|
||||||
[ T{ rect f { 10 10 } { 20 20 } } ]
|
[ RECT: { 10 10 } { 20 20 } ]
|
||||||
[
|
[
|
||||||
T{ rect f { 10 10 } { 50 50 } }
|
RECT: { 10 10 } { 50 50 }
|
||||||
T{ rect f { -10 -10 } { 40 40 } }
|
RECT: { -10 -10 } { 40 40 }
|
||||||
rect-intersect
|
rect-intersect
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ T{ rect f { 200 200 } { 0 0 } } ]
|
[ RECT: { 200 200 } { 0 0 } ]
|
||||||
[
|
[
|
||||||
T{ rect f { 100 100 } { 50 50 } }
|
RECT: { 100 100 } { 50 50 }
|
||||||
T{ rect f { 200 200 } { 40 40 } }
|
RECT: { 200 200 } { 40 40 }
|
||||||
rect-intersect
|
rect-intersect
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ f ] [
|
[ f ] [
|
||||||
T{ rect f { 100 100 } { 50 50 } }
|
RECT: { 100 100 } { 50 50 }
|
||||||
T{ rect f { 200 200 } { 40 40 } }
|
RECT: { 200 200 } { 40 40 }
|
||||||
contains-rect?
|
contains-rect?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ t ] [
|
[ t ] [
|
||||||
T{ rect f { 100 100 } { 50 50 } }
|
RECT: { 100 100 } { 50 50 }
|
||||||
T{ rect f { 120 120 } { 40 40 } }
|
RECT: { 120 120 } { 40 40 }
|
||||||
contains-rect?
|
contains-rect?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ f ] [
|
[ f ] [
|
||||||
T{ rect f { 1000 100 } { 50 50 } }
|
RECT: { 1000 100 } { 50 50 }
|
||||||
T{ rect f { 120 120 } { 40 40 } }
|
RECT: { 120 120 } { 40 40 }
|
||||||
contains-rect?
|
contains-rect?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ T{ rect f { 10 20 } { 20 20 } } ] [
|
[ RECT: { 10 20 } { 20 20 } ] [
|
||||||
{
|
{
|
||||||
{ 20 20 }
|
{ 20 20 }
|
||||||
{ 10 40 }
|
{ 10 40 }
|
||||||
{ 30 30 }
|
{ 30 30 }
|
||||||
} rect-containing
|
} rect-containing
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
@ -1,12 +1,18 @@
|
||||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! 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
|
IN: math.rectangles
|
||||||
|
|
||||||
TUPLE: rect { loc initial: { 0 0 } } { dim initial: { 0 0 } } ;
|
TUPLE: rect { loc initial: { 0 0 } } { dim initial: { 0 0 } } ;
|
||||||
|
|
||||||
: <rect> ( loc dim -- rect ) rect boa ; inline
|
: <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
|
: <zero-rect> ( -- rect ) rect new ; inline
|
||||||
|
|
||||||
: point>rect ( loc -- rect ) { 0 0 } <rect> ; inline
|
: point>rect ( loc -- rect ) { 0 0 } <rect> ; inline
|
||||||
|
@ -55,4 +61,4 @@ M: rect contains-point?
|
||||||
: set-rect-bounds ( rect1 rect -- )
|
: set-rect-bounds ( rect1 rect -- )
|
||||||
[ [ loc>> ] dip (>>loc) ]
|
[ [ loc>> ] dip (>>loc) ]
|
||||||
[ [ dim>> ] dip (>>dim) ]
|
[ [ dim>> ] dip (>>dim) ]
|
||||||
2bi ; inline
|
2bi ; inline
|
||||||
|
|
Loading…
Reference in New Issue