diff --git a/library/test/gadgets/rectangles.factor b/library/test/gadgets/rectangles.factor index feef4a0f65..d5448a8e8c 100644 --- a/library/test/gadgets/rectangles.factor +++ b/library/test/gadgets/rectangles.factor @@ -1,16 +1,31 @@ USING: gadgets kernel namespaces test ; + [ << rect f @{ 10 10 0 }@ @{ 20 20 0 }@ >> ] [ << rect f @{ 10 10 0 }@ @{ 50 50 0 }@ >> << rect f @{ -10 -10 0 }@ @{ 40 40 0 }@ >> - intersect + intersect-rect ] unit-test [ << rect f @{ 200 200 0 }@ @{ 0 0 0 }@ >> ] [ << rect f @{ 100 100 0 }@ @{ 50 50 0 }@ >> << rect f @{ 200 200 0 }@ @{ 40 40 0 }@ >> - intersect + intersect-rect +] unit-test + +[ << rect f @{ -10 -10 0 }@ @{ 70 70 0 }@ >> ] +[ + << rect f @{ 10 10 0 }@ @{ 50 50 0 }@ >> + << rect f @{ -10 -10 0 }@ @{ 40 40 0 }@ >> + union-rect +] unit-test + +[ << rect f @{ 100 100 0 }@ @{ 140 140 0 }@ >> ] +[ + << rect f @{ 100 100 0 }@ @{ 50 50 0 }@ >> + << rect f @{ 200 200 0 }@ @{ 40 40 0 }@ >> + union-rect ] unit-test [ f ] [ diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor index 2c968364d7..fc287d4b09 100644 --- a/library/ui/gadgets.factor +++ b/library/ui/gadgets.factor @@ -16,21 +16,21 @@ M: array rect-dim drop @{ 0 0 0 }@ ; : rect-bounds ( rect -- loc dim ) dup rect-loc swap rect-dim ; -: rect-extent ( rect -- loc dim ) rect-bounds over v+ ; +: rect-extent ( rect -- loc ext ) rect-bounds over v+ ; + +: |v-| ( vec vec -- vec ) v- [ 0 max ] map ; : >absolute ( rect -- rect ) rect-bounds >r origin get v+ r> ; -: |v-| ( vec vec -- vec ) v- [ 0 max ] map ; - -: (intersect) ( rect rect -- array array ) +: (rect-intersect) ( rect rect -- array array ) [ rect-extent ] 2apply swapd vmin >r vmax r> ; -: intersect ( rect rect -- rect ) - (intersect) dupd swap |v-| ; +: rect-intersect ( rect rect -- rect ) + (rect-intersect) dupd swap |v-| ; : intersects? ( rect/point rect -- ? ) - (intersect) v- [ 0 <= ] all? ; + (rect-intersect) v- [ 0 <= ] all? ; ! A gadget is a rectangle, a paint, a mapping of gestures to ! actions, and a reference to the gadget's parent. diff --git a/library/ui/paint.factor b/library/ui/paint.factor index 80d2546285..6d95526b54 100644 --- a/library/ui/paint.factor +++ b/library/ui/paint.factor @@ -12,7 +12,7 @@ SYMBOL: clip GENERIC: draw-gadget* ( gadget -- ) : do-clip ( gadget -- ) - >absolute clip [ intersect dup ] change + >absolute clip [ rect-intersect dup ] change dup rect-loc swap rect-dim gl-set-clip ; : with-translation ( gadget quot -- | quot: gadget -- ) diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor index f46303ce0c..ff6dce0716 100644 --- a/library/ui/scrolling.factor +++ b/library/ui/scrolling.factor @@ -44,9 +44,12 @@ M: viewport pref-dim gadget-child pref-dim ; 2dup over scroller-x update-slider over scroller-y update-slider ; +: (scroll-to) ( scroller gadget -- point ) + >r scroller-viewport gadget-child r> relative ; + : update-scroller ( scroller -- ) dup dup scroller-follows dup [ - f rot set-scroller-follows screen-loc + f pick set-scroller-follows (scroll-to) ] [ drop scroller-origin ] if scroll ;