viewport/scrolling refactoring

TODO.FACTOR.txt

@@ -6,7 +6,6 @@
 [ 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10 11 11 11 113 
 ]
 - prettier printing of hashtable literals, alists, cond, ...
-- the editor should fill up the interior of the scroller completely
 - ui quick start doc
 - x11: scroll up/down wiggles caret
 - slider needs to be modelized
@@ -15,6 +14,7 @@
 
 + ui:
 
+- [ ] write in the UI breaks stuff
 - some way of intercepting all gestures
 - pane output in UI should use less memory
 - variable width word wrap
@@ -64,6 +64,8 @@
 
 + module system:
 
+- reloading source files manually should update their mod time in the
+  module system
 - convention for main entry point of a module
 - convention for main help article of a module
 - track a list of assets loaded from each module's file

library/ui/gadgets/scrolling.factor

@@ -52,7 +52,7 @@ C: scroller ( gadget -- scroller )
     r> set-slider ;
 
 : position-viewport ( scroller -- )
-    dup scroller-origin vneg
+    dup scroller-origin vneg viewport-gap v+
     swap scroller-viewport gadget-child
     set-rect-loc ;
 
@@ -62,7 +62,10 @@ C: scroller ( gadget -- scroller )
     position-viewport ;
 
 : (scroll>rect) ( rect scroller -- )
-    [ scroller-origin vneg offset-rect viewport-rect ] keep
+    [
+        scroller-origin vneg offset-rect
+        viewport-gap offset-rect
+    ] keep
     [
         scroller-viewport 2rect-extent
         >r >r v- { 0 0 } vmin r> r> v- { 0 0 } vmax v+
@@ -75,8 +78,7 @@ C: scroller ( gadget -- scroller )
         2drop
     ] if ;
 
-: scroll>bottom ( gadget -- )
+: scroll>bottom ( gadget -- ) t swap scroll>rect ;
-    t swap scroll>rect ;
 
 : (scroll>bottom) ( scroller -- )
     dup scroller-viewport viewport-dim { 0 1 } v* scroll ;

library/ui/gadgets/sliders.factor

@@ -87,10 +87,10 @@ C: thumb ( vector -- thumb )
     dup hand-click-rel >r find-slider r>
     over gadget-orientation v.
     over screen>slider over slider-value - sgn
-    swap slide-by-page ;
+    [ swap slide-by-page ] curry start-timer-gadget ;
 
 elevator H{
-    { T{ button-down } [ [ elevator-click ] start-timer-gadget ] }
+    { T{ button-down } [ elevator-click ] }
     { T{ button-up } [ stop-timer-gadget ] }
 } set-gestures
 

library/ui/gadgets/viewports.factor

@@ -4,22 +4,25 @@ IN: gadgets-viewports
 USING: arrays gadgets gadgets-borders generic kernel math
 namespaces sequences ;
 
+: viewport-gap { 3 3 } ;
+
 TUPLE: viewport ;
 
 : find-viewport [ viewport? ] find-parent ;
 
-: viewport-dim ( viewport -- dim ) gadget-child pref-dim ;
+: viewport-dim ( viewport -- dim )
+    gadget-child pref-dim viewport-gap 2 v*n v+ ;
 
 C: viewport ( content -- viewport )
     dup delegate>gadget
-    [ >r 3 <border> r> add-gadget ] keep
+    [ add-gadget ] keep
     t over set-gadget-clipped? ;
 
-M: viewport layout* gadget-child prefer ;
+M: viewport layout*
+    dup rect-dim over gadget-child pref-dim vmax
+    swap gadget-child set-layout-dim ;
 
 M: viewport focusable-child*
     gadget-child ;
 
 M: viewport pref-dim* viewport-dim ;
-
-: viewport-rect ( rect -- rect ) { 3 3 } offset-rect ;