scrolling bug fix and moving a few layout words

diff --git a/library/ui/borders.factor b/library/ui/borders.factor
index 4b0c7e74cfa83b7c885092d08f5a658508b9dbfe..28b3f9edf1d193f47f694da13ce8ebe44b081f81 100644 (file)
--- a/library/ui/borders.factor
+++ b/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
-namespaces sdl vectors ;
+USING: errors gadgets gadgets-layouts generic hashtables kernel
+math namespaces vectors ;
 
 TUPLE: border size ;
 

diff --git a/library/ui/buttons.factor b/library/ui/buttons.factor
index 76520d29992a2d5b8a6ec817ff46997352698d10..a2897f8376b4242ebc1ef76617484bc217e9d0d0 100644 (file)
--- a/library/ui/buttons.factor
+++ b/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
-namespaces sdl sequences sequences styles threads ;
+USING: gadgets gadgets-borders gadgets-layouts generic io kernel
+lists math namespaces sdl sequences sequences styles threads ;
 
 : button-down? ( n -- ? ) hand hand-buttons member? ;
 

diff --git a/library/ui/editors.factor b/library/ui/editors.factor
index 8878f0c3b08ee5d26c50bb3767df59242c19e429..a5ce33cd7323308e368f0b4ad7891cffb7b736e0 100644 (file)
--- a/library/ui/editors.factor
+++ b/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
-math namespaces sdl sequences strings styles threads vectors ;
+USING: gadgets gadgets-labels gadgets-layouts gadgets-scrolling
+generic kernel math namespaces sdl sequences strings styles
+threads vectors ;
 
 ! A blinking caret
 TUPLE: caret ;

diff --git a/library/ui/events.factor b/library/ui/events.factor
index 92e9a3f9231dba89c33f1164e2f3a79d9d9f99c1..7cca9682361c7c933ff6af2d88eb70d88f548f43 100644 (file)
--- a/library/ui/events.factor
+++ b/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
-sdl sequences vectors ;
+USING: alien gadgets-layouts generic kernel lists math
+namespaces sdl sequences vectors ;
 
 GENERIC: handle-event ( event -- )
 

diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index a67175f1053542d56dd0b68afb5c2663e68d60a6..61460ce911829cb43d65ba8a4e321ddd4c719a02 100644 (file)
--- a/library/ui/gadgets.factor
+++ b/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 -- )
-    #! 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 -- )
-    #! Relayout a gadget and its children.
-    dup add-invalid invalidate ;
-
-: set-gadget-dim ( dim gadget -- )
-    2dup rect-dim =
-    [ 2drop ] [ [ set-rect-dim ] keep relayout-down ] ifte ;
+DEFER: add-invalid
 
-GENERIC: user-input* ( ch gadget -- ? )
+GENERIC: children-on ( rect/point gadget -- list )
 
-M: gadget user-input* 2drop t ;
+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 ;

diff --git a/library/ui/hierarchy.factor b/library/ui/hierarchy.factor
index 71d42be963adb9d1b9af18fda9b6e4d5cc279d66..8b83b1ec956373cdc21987d6a77a71a452e9d7e1 100644 (file)
--- a/library/ui/hierarchy.factor
+++ b/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
-sequences vectors ;
+USING: gadgets-layouts generic hashtables kernel lists math
+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 ;

diff --git a/library/ui/labels.factor b/library/ui/labels.factor
index 999cf9aaef6966b4f658fab767c4fd1a290913bd..03eae35aabe18b669f2818b9555d2c0de260d1ba 100644 (file)
--- a/library/ui/labels.factor
+++ b/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.

diff --git a/library/ui/layouts.factor b/library/ui/layouts.factor
index f1ac6bb797cbda94e5cb032e0638bc0eb6613531..1ebef13621c3471e5bc29fc5f55d85df30d4c022 100644 (file)
--- a/library/ui/layouts.factor
+++ b/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 ;

diff --git a/library/ui/load.factor b/library/ui/load.factor
index 3eae74475cbf813443db4461328669f3aa71050c..28cab2bcfe51f5d255aac5f157297c83fc21a86b 100644 (file)
--- a/library/ui/load.factor
+++ b/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"

diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor
index d7316cc79a4295783c03376392a9ad27c9eeb9f6..2ef1abe698b3b4db4bfa08a8b49c0d9fb5443f57 100644 (file)
--- a/library/ui/scrolling.factor
+++ b/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
-namespaces sequences threads vectors styles ;
+USING: gadgets gadgets-books gadgets-layouts generic kernel
+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
-    swap gadget-child dup prefer set-rect-loc ;
+    over viewport-bottom? [
+        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
-    [ t over set-scroller-bottom? relayout ] when* ;
+    find-viewport
+    [ 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* ;

diff --git a/library/ui/ui.factor b/library/ui/ui.factor
index 360ac9c82df3ef907c48956cb78005a7a8687774..07371e0fb8a39f3a57ec711c3d495f60853f823f 100644 (file)
--- a/library/ui/ui.factor
+++ b/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
-math namespaces prettyprint sdl sequences shells styles threads
-words ;
+USING: gadgets-layouts gadgets-listener generic help io kernel
+listener lists math namespaces prettyprint sdl sequences shells
+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