scrolling bug fix and moving a few layout words

library/ui/borders.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-borders
-USING: errors gadgets generic hashtables kernel lists math
+USING: errors gadgets gadgets-layouts generic hashtables kernel
-namespaces sdl vectors ;
+math namespaces vectors ;
 
 TUPLE: border size ;
 

library/ui/buttons.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-buttons
-USING: gadgets gadgets-borders generic io kernel lists math
+USING: gadgets gadgets-borders gadgets-layouts generic io kernel
-namespaces sdl sequences sequences styles threads ;
+lists math namespaces sdl sequences sequences styles threads ;
 
 : button-down? ( n -- ? ) hand hand-buttons member? ;
 

library/ui/editors.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-editors
-USING: gadgets gadgets-labels gadgets-scrolling generic kernel
+USING: gadgets gadgets-labels gadgets-layouts gadgets-scrolling
-math namespaces sdl sequences strings styles threads vectors ;
+generic kernel math namespaces sdl sequences strings styles
+threads vectors ;
 
 ! A blinking caret
 TUPLE: caret ;

library/ui/events.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: alien generic kernel lists math namespaces prettyprint
+USING: alien gadgets-layouts generic kernel lists math
-sdl sequences vectors ;
+namespaces sdl sequences vectors ;
 
 GENERIC: handle-event ( event -- )
 

library/ui/gadgets.factor

@@ -43,31 +43,34 @@ C: gadget ( -- gadget )
     { 0 0 0 } dup <rect> over set-delegate
     t over set-gadget-visible? ;
 
-DEFER: add-invalid
+GENERIC: user-input* ( ch gadget -- ? )
+
+M: gadget user-input* 2drop t ;
 
 : invalidate ( gadget -- )
     t swap set-gadget-relayout? ;
 
-: relayout ( gadget -- )
+DEFER: add-invalid
-    #! Relayout and redraw a gadget and its parent before the
-    #! next iteration of the event loop.
-    dup gadget-relayout? [
-        drop
-    ] [
-        dup invalidate
-        dup gadget-root?
-        [ add-invalid ]
-        [ gadget-parent [ relayout ] when* ] ifte
-    ] ifte ;
 
-: relayout-down ( gadget -- )
+GENERIC: children-on ( rect/point gadget -- list )
-    #! Relayout a gadget and its children.
-    dup add-invalid invalidate ;
 
-: set-gadget-dim ( dim gadget -- )
+M: gadget children-on ( rect/point gadget -- list )
-    2dup rect-dim =
+    nip gadget-children ;
-    [ 2drop ] [ [ set-rect-dim ] keep relayout-down ] ifte ;
 
-GENERIC: user-input* ( ch gadget -- ? )
+: inside? ( bounds gadget -- ? )
+    dup gadget-visible?
+    [ >absolute intersects? ] [ 2drop f ] ifte ;
 
-M: gadget user-input* 2drop t ;
+: pick-up-list ( rect/point gadget -- gadget/f )
+    dupd children-on reverse-slice [ inside? ] find-with nip ;
+
+: translate ( rect/point -- )
+    rect-loc origin [ v+ ] change ;
+
+: pick-up ( rect/point gadget -- gadget )
+    2dup inside? [
+        [
+            dup translate 2dup pick-up-list dup
+            [ nip pick-up ] [ rot 2drop ] ifte
+        ] with-scope
+    ] [ 2drop f ] ifte ;

library/ui/hierarchy.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: generic hashtables kernel lists math matrices namespaces
+USING: gadgets-layouts generic hashtables kernel lists math
-sequences vectors ;
+namespaces sequences vectors ;
 
 : remove-gadget ( gadget parent -- )
     2dup gadget-children remove over set-gadget-children
@@ -77,26 +77,3 @@ M: gadget focusable-child* drop t ;
 : focusable-child ( gadget -- gadget )
     dup focusable-child*
     dup t = [ drop ] [ nip focusable-child ] ifte ;
-
-GENERIC: children-on ( rect/point gadget -- list )
-
-M: gadget children-on ( rect/point gadget -- list )
-    nip gadget-children ;
-
-: inside? ( bounds gadget -- ? )
-    dup gadget-visible?
-    [ >absolute intersects? ] [ 2drop f ] ifte ;
-
-: pick-up-list ( rect/point gadget -- gadget/f )
-    dupd children-on reverse-slice [ inside? ] find-with nip ;
-
-: translate ( rect/point -- )
-    rect-loc origin [ v+ ] change ;
-
-: pick-up ( rect/point gadget -- gadget )
-    2dup inside? [
-        [
-            dup translate 2dup pick-up-list dup
-            [ nip pick-up ] [ rot 2drop ] ifte
-        ] with-scope
-    ] [ 2drop f ] ifte ;

library/ui/labels.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-labels
-USING: gadgets generic hashtables io kernel lists math
+USING: gadgets gadgets-layouts generic hashtables io kernel math
 namespaces sdl sequences styles vectors ;
 
 ! A label gadget draws a string.

library/ui/layouts.factor

@@ -4,6 +4,25 @@ IN: gadgets-layouts
 USING: errors gadgets generic hashtables kernel lists math
 matrices namespaces sdl sequences ;
 
+: relayout ( gadget -- )
+    #! Relayout and redraw a gadget and its parent before the
+    #! next iteration of the event loop.
+    dup gadget-relayout? [
+        drop
+    ] [
+        dup invalidate
+        dup gadget-root?
+        [ add-invalid ]
+        [ gadget-parent [ relayout ] when* ] ifte
+    ] ifte ;
+
+: set-gadget-dim ( dim gadget -- )
+    2dup rect-dim = [
+        2drop
+    ] [
+        [ set-rect-dim ] keep dup add-invalid invalidate
+    ] ifte ;
+
 GENERIC: pref-dim ( gadget -- dim )
 
 M: gadget pref-dim rect-dim ;

library/ui/load.factor

@@ -1,12 +1,12 @@
 USING: kernel parser sequences io ;
 [
     "/library/ui/gadgets.factor"
+    "/library/ui/layouts.factor"
     "/library/ui/hierarchy.factor"
     "/library/ui/paint.factor"
     "/library/ui/fonts.factor"
     "/library/ui/text.factor"
     "/library/ui/gestures.factor"
-    "/library/ui/layouts.factor"
     "/library/ui/borders.factor"
     "/library/ui/frames.factor"
     "/library/ui/world.factor"

library/ui/scrolling.factor

@@ -1,14 +1,14 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-scrolling
-USING: gadgets gadgets-layouts generic kernel lists math
+USING: gadgets gadgets-books gadgets-layouts generic kernel
-namespaces sequences threads vectors styles ;
+lists math namespaces sequences styles threads vectors ;
 
 ! A viewport can be scrolled.
-TUPLE: viewport ;
+TUPLE: viewport bottom? ;
 
 ! A scroller combines a viewport with two x and y sliders.
-TUPLE: scroller viewport x y bottom? ;
+TUPLE: scroller viewport x y ;
 
 : scroller-origin ( scroller -- { x y 0 } )
     dup scroller-x slider-value
@@ -17,6 +17,8 @@ TUPLE: scroller viewport x y bottom? ;
 
 : find-scroller [ scroller? ] find-parent ;
 
+: find-viewport [ viewport? ] find-parent ;
+
 : viewport-dim gadget-child pref-dim ;
 
 C: viewport ( content -- viewport )
@@ -44,8 +46,12 @@ M: viewport pref-dim gadget-child pref-dim ;
 : update-scroller ( scroller -- ) dup scroller-origin scroll ;
 
 : update-viewport ( viewport scroller -- )
-    scroller-origin vneg
+    over viewport-bottom? [
-    swap gadget-child dup prefer set-rect-loc ;
+        f pick set-viewport-bottom?
+        over viewport-dim
+    ] [
+        dup scroller-origin
+    ] ifte vneg nip swap gadget-child dup prefer set-rect-loc ;
 
 M: viewport layout* ( viewport -- )
     dup find-scroller dup update-scroller update-viewport ;
@@ -60,8 +66,8 @@ M: viewport focusable-child* ( viewport -- gadget )
 : add-y-slider 2dup set-scroller-y add-right ;
 
 : scroll>bottom ( gadget -- )
-    find-scroller
+    find-viewport
-    [ t over set-scroller-bottom? relayout ] when* ;
+    [ t over set-viewport-bottom? relayout ] when* ;
 
 : scroll-up-line scroller-y -1 swap slide-by-line ;
 
@@ -82,10 +88,3 @@ C: scroller ( gadget -- scroller )
 
 M: scroller focusable-child* ( scroller -- viewport )
     scroller-viewport ;
-
-M: scroller layout* ( scroller -- )
-    dup scroller-bottom? [
-        f over set-scroller-bottom?
-        dup dup scroller-viewport viewport-dim
-        { 0 1 0 } v* scroll
-    ] when delegate layout* ;

library/ui/ui.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: gadgets-listener generic help io kernel listener lists
+USING: gadgets-layouts gadgets-listener generic help io kernel
-math namespaces prettyprint sdl sequences shells styles threads
+listener lists math namespaces prettyprint sdl sequences shells
-words ;
+styles threads words ;
 
 : world-theme
     {{
@@ -19,6 +19,7 @@ words ;
     }} ;
 
 : init-world
+    ttf-init
     global [
         <world> world set
         { 600 800 0 } world get set-gadget-dim