fix scroller

diff --git a/library/test/gadgets/rectangles.factor b/library/test/gadgets/rectangles.factor
index feef4a0f6578b50a3d3d9a798b26937bf6f21f1a..d5448a8e8cae18472d9f48b83d2b786c749abb3e 100644 (file)
--- 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 2c968364d774a0a1b68f8e514b6584932e1c4c28..fc287d4b0999dde6190cb506adf4aa52081ac140 100644 (file)
--- 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> <rect> ;
 
-: |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> ;
+: rect-intersect ( rect rect -- 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.

diff --git a/library/ui/paint.factor b/library/ui/paint.factor
index 80d25462851683d28510225b0c24d56cda3bc490..6d95526b54d37e90c74f7826c18ac45a3a101bc3 100644 (file)
--- 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 f46303ce0c17feb7adb4d6632a7f1df71ad2fa9f..ff6dce07166c139ec85b998af7ecf4fd2853438a 100644 (file)
--- 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 ;