REBOL [ Title: "Rectangle Module" File: %rect-lib.r Author: "Gregg Irwin" EMail: %greggirwin--acm--org Version: 0.0.1 Date: 11-Oct-2003 Purpose: { Code from a REBOLForces article (http://www.rebolforces.com/articles/pairs/2/) that provides support for rectangle-related operations. It was also used to explore the concept of function spec templates. You could refactor that concept out though if you want. } library: [ level: 'advanced platform: 'all type: [function module] domain: [UI math] tested-under: [view/pro 1.2.8.3.1 on W2K] support: none license: 'public-domain see-also: none ] ] rect: make object! [ ; make a rectangle object _rect: make object! [offset: size: 0x0] _make-rect: func [offset [pair!] size [pair!]] [ make _rect compose [offset: (offset) size: (size)] ] ; These are function interface templates. _fn-spec-1: compose [(copy "") r [block! object!] "The rectangle"] _fn-spec-2: append copy _fn-spec-1 [r2 [block! object!] "The other rectangle"] _fn-spec-3: append copy _fn-spec-1 [value [pair!]] mod-fn-spec: func [spec [block!] desc [string!]] [ head change copy spec desc ] top?: func _fn-spec-1 [r/offset/y] left?: func _fn-spec-1 [r/offset/x] height?: func _fn-spec-1 [r/size/y] width?: func _fn-spec-1 [r/size/x] right?: func _fn-spec-1 [add left? r width? r] bottom?: func _fn-spec-1 [add top? r height? r] ; upper-left and lower-right shortcuts ul?: func _fn-spec-1 [r/offset] lr?: func _fn-spec-1 [add r/offset r/size] empty?: func mod-fn-spec _fn-spec-1 "An empty rectangle is one with no area" [ any [(0 >= height? r) (0 >= width? r)] ] equal?: func mod-fn-spec _fn-spec-2 "Equal rectangles have the same coordinates" [ all [(r/offset = r2/offset) (r/size = r2/size)] ] inflate: func mod-fn-spec _fn-spec-3 {Inflates a rectangle by the specified amounts. The change occurs in all directions. I.e. the offset will change as well as the size. Negative values deflate the rectangle.} [ r/offset: subtract r/offset value r/size: add r/size (value * 2) r ] deflate: func mod-fn-spec _fn-spec-3 {Deflates a rectangle by the specified amounts. The change occurs in all directions. I.e. the offset will change as well as the size. Negative values inflate the rectangle.} [ inflate r negate value ] grow: func mod-fn-spec _fn-spec-3 {Grows a rectangle by the specified amounts. Negative values shrink it.} [ r/size: add r/size value r ] shrink: func mod-fn-spec _fn-spec-3 {Shrinks a rectangle by the specified amounts. Negative values grow it.} [ grow r negate value ] move: func mod-fn-spec _fn-spec-3 {Moves a rectangle by the specified amounts. Negative values are allowed.} [ r/offset: add r/offset value r ] contains?: func mod-fn-spec _fn-spec-3 {Returns true if the specified point lies within the rectangle.} [ within? value r/offset r/size ] intersects?: func mod-fn-spec _fn-spec-2 "Returns true if the rectangles intersect." [ to-logic any [ (contains? r2 ul? r) (contains? r2 lr? r) (contains? r ul? r2) (contains? r lr? r2) all [ (left? r) < (right? r2) (left? r2) < (right? r) (top? r) < (bottom? r2) (top? r2) < (bottom? r) ] ] ] intersection: func mod-fn-spec _fn-spec-2 {Returns the intersection of the two rectangles as an object containing offset and size values.} [ either intersects? r r2 [ _make-rect maximum ul? r2 ul? r ; Have to subtract the intersection offset to get the size subtract minimum lr? r2 lr? r (maximum ul? r2 ul? r) ][ _make-rect 0x0 0x0 ] ] union: func mod-fn-spec _fn-spec-2 {Returns the union of the two rectangles as an object containing offset and size values.} [ _make-rect minimum ul? r2 ul? r ; Have to subtract the union offset to get the size subtract maximum lr? r2 lr? r (minimum ul? r2 ul? r) ] ] ; r0: [offset 0x0 size 0x0] ; r1: [offset 20x20 size 80x80] ; r2: [offset 40x10 size 40x100] ; ; print rect/top? r1 ; print rect/left? r1 ; print rect/right? r1 ; print rect/bottom? r1 ; print rect/height? r1 ; print rect/width? r1 ; print mold rect/inflate r1 2x2 ; print mold rect/deflate r1 2x2 ; print mold rect/grow r1 2x2 ; print mold rect/shrink r1 2x2 ; print mold rect/move r1 2x2 ; ; print [rect/contains? r1 0x0 tab "should be false"] ; print [rect/contains? r1 40x40 tab "should be true"] ; print [rect/contains? r1 79x79 tab "should be true"] ; print [rect/contains? r1 183x183 tab "should be false"] ; ; print rect/intersects? r1 r2 ; print rect/intersects? r2 r1 ; print rect/intersects? r0 r1 ; print rect/intersects? r0 r2 ; ; print mold rect/intersection r0 r1 ; print mold rect/intersection r1 r2 ; print mold rect/intersection r2 r1 ; print mold rect/intersection r0 r2 ; ; print mold rect/union r0 r1 ; print mold rect/union r1 r2 ; print mold rect/union r2 r1 ; print mold rect/union r0 r2 ; ; halt ; get-coordinates: func [r [block! object!]] [ ; compose [(r/offset) (r/size)] ; ] ; ; coordinates-to-paren: func [r [block! object!]] [ ; to-paren compose [(r/offset) (r/size)] ; ] ; ; coordinates-to-paren: func [r [block! object!]] [ ; to-paren compose [(r/offset) (r/offset + r/size)] ; ] ; ; rect-lib-test: func [face-1 face-2 draw-face /local r] [ ; draw-face/effect: compose/deep [ ; draw [ ; ; Show where the faces are now ; pen blue ; box (rect/ul? face-1) (rect/lr? face-1) ; pen orange ; box (rect/ul? face-2) (rect/lr? face-2) ; ; Resize the faces. This is a bit odd, being inside ; ; the draw commands we're building, but it works. ; (rect/inflate face-1 5x5) ; (rect/deflate face-2 5x5) ; ; Back to draw commands ; pen black ; box (rect/ul? r: rect/intersection face-1 face-2) (rect/lr? r) ; pen red ; box (rect/ul? r: rect/union face-1 face-2) (rect/lr? r) ; ] ; ] ; show [face-1 face-2 draw-face] ; ] ; ; lay: layout [ ; b1: box yellow 100x100 ; at 50x50 ; b2: box green 100x100 ; at 175x20 ; button "Test" [rect-lib-test b1 b2 b3] ; button "Quit" [quit] ; ; This is our drawing surface ; at 0x0 ; b3: box 175x175 effect [draw copy []] ; ] ; ; view lay