1 ! Copyright (C) 2008, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel arrays sequences math math.vectors accessors ;
6 TUPLE: rect { loc initial: { 0 0 } } { dim initial: { 0 0 } } ;
8 : <rect> ( loc dim -- rect ) rect boa ; inline
10 : <zero-rect> ( -- rect ) rect new ; inline
12 : point>rect ( loc -- rect ) { 0 0 } <rect> ; inline
14 : rect-bounds ( rect -- loc dim ) [ loc>> ] [ dim>> ] bi ;
16 : rect-extent ( rect -- loc ext ) rect-bounds over v+ ;
18 : with-rect-extents ( rect1 rect2 loc-quot: ( loc1 loc2 -- ) ext-quot: ( ext1 ext2 -- ) -- )
19 [ [ rect-extent ] bi@ ] 2dip bi-curry* bi* ; inline
21 : <extent-rect> ( loc ext -- rect ) over [v-] <rect> ;
23 : offset-rect ( rect loc -- newrect )
24 over loc>> v+ swap dim>> <rect> ;
26 : (rect-intersect) ( rect rect -- array array )
27 [ vmax ] [ vmin ] with-rect-extents ;
29 : rect-intersect ( rect1 rect2 -- newrect )
30 (rect-intersect) <extent-rect> ;
32 GENERIC: contains-rect? ( rect1 rect2 -- ? )
34 M: rect contains-rect?
35 (rect-intersect) [v-] { 0 0 } = ;
37 GENERIC: contains-point? ( point rect -- ? )
39 M: rect contains-point?
40 [ point>rect ] dip contains-rect? ;
42 : (rect-union) ( rect rect -- array array )
43 [ vmin ] [ vmax ] with-rect-extents ;
45 : rect-union ( rect1 rect2 -- newrect )
46 (rect-union) <extent-rect> ;
48 : rect-containing ( points -- rect )
49 [ vsupremum ] [ vinfimum ] bi
50 [ nip ] [ v- ] 2bi <rect> ;
52 : rect-min ( rect dim -- rect' )
53 [ rect-bounds ] dip vmin <rect> ;
55 : set-rect-bounds ( rect1 rect -- )
56 [ [ loc>> ] dip (>>loc) ]
57 [ [ dim>> ] dip (>>dim) ]