missing file; scrollbar work

library/generic/early-generic.factor

@@ -0,0 +1,14 @@
+! Copyright (C) 2004, 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: generic
+USING: kernel kernel-internals ;
+
+DEFER: standard-combination
+
+DEFER: math-combination
+
+: delegate ( object -- delegate )
+    dup tuple? [ 3 slot ] [ drop f ] ifte ; inline
+
+: set-delegate ( delegate tuple -- )
+    dup tuple? [ 3 set-slot ] [ drop drop ] ifte ; inline

library/ui/scrolling.factor

@@ -44,7 +44,7 @@ M: viewport focusable-child* ( viewport -- gadget )
     dup rect-dim pick slider-vector v. pick set-slider-page
     dup viewport-dim over rect-dim vmax pick slider-vector v. pick set-slider-max
     scroller-viewport dup viewport-origin over fix-scroll vneg pick slider-vector v. pick set-slider-value
-    2drop ;
+    drop slider-elevator relayout ;
 
 : update-sliders ( scroller -- )
     dup
@@ -52,6 +52,7 @@ M: viewport focusable-child* ( viewport -- gadget )
     dup scroller-y swap update-slider ;
 
 : scroll ( origin scroller -- )
+    dup update-sliders
     scroller-viewport
     [ [ fix-scroll ] keep set-viewport-origin ] keep relayout ;
 

library/ui/sliders.factor

@@ -14,6 +14,17 @@ TUPLE: slider vector elevator thumb value max page ;
 
 : find-slider [ slider? ] find-parent ;
 
+: slider-scale ( slider -- n )
+    #! A scaling factor such that if x is a slider co-ordinate,
+    #! x*n is the screen position of the thumb, and conversely
+    #! for x/n. The '1 max' calls avoid division by zero.
+    dup slider-elevator rect-dim over slider-vector v. 1 max
+    swap slider-max 1 max / ;
+
+: slider>screen slider-scale * ;
+
+: screen>slider slider-scale / ;
+
 : elevator-click ( elevator pos -- )
     2drop ;
 
@@ -39,13 +50,11 @@ C: elevator ( -- elevator )
     <plain-gadget> over set-delegate
     dup elevator-theme dup elevator-actions ;
 
-: >thumb ( n slider -- n )
+: thumb-loc ( slider -- loc )
-    [ slider-max 1 max / ] keep
+    dup slider-value swap slider>screen ;
-    dup slider-elevator rect-dim swap slider-vector v. * ;
 
-: thumb-loc ( slider -- loc ) dup slider-value swap >thumb ;
+: thumb-dim ( slider -- h )
-
+    dup slider-page swap slider>screen ;
-: thumb-dim ( slider -- h ) dup slider-page swap >thumb ;
 
 : thumb-min { 12 12 0 } ;