fix scroller

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 ] [

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> <rect> ;
 
-: |v-| ( vec vec -- vec ) v- [ 0 max ] map ;
+: (rect-intersect) ( rect rect -- array array )
-
-: (intersect) ( rect rect -- array array )
     [ rect-extent ] 2apply swapd vmin >r vmax r> ;
 
-: intersect ( rect rect -- rect )
+: rect-intersect ( rect rect -- rect )
-    (intersect) dupd swap |v-| <rect> ;
+    (rect-intersect) dupd swap |v-| <rect> ;
 
 : 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.

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 -- )

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 ;