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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
libs/math/rectangles/rectangles-tests.factor
View File

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

11
libs/math/rectangles/rectangles.factor
View File

@ -1,14 +1,19 @@
! 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: accessors arrays combinators.short-circuit kernel lexer
parser lexer ; math math.vectors parser sequences ;
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 ";" 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 : <zero-rect> ( -- rect ) rect new ; inline