math.rectangles: rect{ instead of RECT:

locals-and-roots
Doug Coleman 2016-06-07 09:53:41 -07:00
parent 391b01b661
commit 1952db54bc
2 changed files with 23 additions and 18 deletions

View File

@ -2,39 +2,39 @@ USING: tools.test math.rectangles prettyprint io.streams.string
kernel accessors ;
in: math.rectangles.tests
{ RECT: { 10 10 } { 20 20 } ; }
{ rect{ { 10 10 } { 20 20 } } }
[
RECT: { 10 10 } { 50 50 } ;
RECT: { -10 -10 } { 40 40 } ;
rect{ { 10 10 } { 50 50 } }
rect{ { -10 -10 } { 40 40 } }
rect-intersect
] unit-test
{ RECT: { 200 200 } { 0 0 } ; }
{ rect{ { 200 200 } { 0 0 } } }
[
RECT: { 100 100 } { 50 50 } ;
RECT: { 200 200 } { 40 40 } ;
rect{ { 100 100 } { 50 50 } }
rect{ { 200 200 } { 40 40 } }
rect-intersect
] unit-test
{ f } [
RECT: { 100 100 } { 50 50 } ;
RECT: { 200 200 } { 40 40 } ;
rect{ { 100 100 } { 50 50 } }
rect{ { 200 200 } { 40 40 } }
contains-rect?
] unit-test
{ t } [
RECT: { 100 100 } { 50 50 } ;
RECT: { 120 120 } { 40 40 } ;
rect{ { 100 100 } { 50 50 } }
rect{ { 120 120 } { 40 40 } }
contains-rect?
] unit-test
{ f } [
RECT: { 1000 100 } { 50 50 } ;
RECT: { 120 120 } { 40 40 } ;
rect{ { 1000 100 } { 50 50 } }
rect{ { 120 120 } { 40 40 } }
contains-rect?
] unit-test
{ RECT: { 10 20 } { 20 20 } ; } [
{ rect{ { 10 20 } { 20 20 } } } [
{
{ 20 20 }
{ 10 40 }
@ -42,5 +42,5 @@ in: math.rectangles.tests
} rect-containing
] unit-test
! Prettyprint for RECT: didn't do nesting check properly
{ } [ [ RECT: f f ; dup >>dim . ] with-string-writer drop ] unit-test
! Prettyprint for rect{ didn't do nesting check properly
{ } [ [ rect{ { 1 2 } { 3 4 } } dup >>dim . ] with-string-writer drop ] unit-test

View File

@ -1,14 +1,19 @@
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel arrays sequences math math.vectors accessors
parser lexer ;
USING: accessors arrays combinators.short-circuit kernel lexer
math math.vectors parser sequences ;
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 ";" expect <rect> suffix! ;
ERROR: bad-rectangle object ;
: ensure-rect-shape ( obj -- obj )
dup { [ sequence? ] [ length 2 = ] [ first2 [ length 2 = ] bi@ and ] } 1&& [ bad-rectangle ] unless ;
SYNTAX: \ rect{ \ } [ ensure-rect-shape first2 <rect> ] parse-literal ;
: <zero-rect> ( -- rect ) rect new ; inline