fix problem in fiber?; UI cleanups

diff --git a/library/collections/lists.factor b/library/collections/lists.factor
index 807c9081736efe8c13d9fc10b88bb2c09fac646c..610e9cfaa0d061eb0782945cea4d2cd73140d3ed 100644 (file)
--- a/library/collections/lists.factor
+++ b/library/collections/lists.factor
@@ -71,10 +71,10 @@ M: general-list find* ( start list quot -- i elt )
     #! list.
     2dup member? [ nip ] [ cons ] ifte ;
 
-M: general-list reversed ( list -- list )
+M: general-list reverse-slice ( list -- list )
     [ ] [ swons ] reduce ;
 
-M: general-list reverse reversed ;
+M: general-list reverse reverse-slice ;
 
 IN: sequences
 DEFER: <range>

diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor
index 4b616ee90c816bd321f3fada96f6d225c455dc71..77b1bc30e5b06ed3d3a42350e4d74e6faba739f7 100644 (file)
--- a/library/collections/sequences-epilogue.factor
+++ b/library/collections/sequences-epilogue.factor
@@ -104,7 +104,7 @@ M: object find ( seq quot -- i elt )
 : fiber? ( seq quot -- ? | quot: elt elt -- ? )
     #! Tests if all elements are equivalent under the relation.
     over empty?
-    [ >r [ first ] keep r> all-with? ] [ 2drop t ] ifte ; inline
+    [ 2drop t ] [ >r [ first ] keep r> all-with? ] ifte ; inline
 
 ! Operations
 M: object thaw clone ;
@@ -189,7 +189,7 @@ M: object peek ( sequence -- element )
 
 : >pop> ( stack -- stack ) dup pop drop ;
 
-M: object reversed ( seq -- seq ) <reversed> ;
+M: object reverse-slice ( seq -- seq ) <reversed> ;
 
 M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
 

diff --git a/library/collections/sequences.factor b/library/collections/sequences.factor
index fa3b1173d532ab5bc31acb98627651144b746975..ea7321ae63b9fc5c90b601d40e1b31b48eda39ea 100644 (file)
--- a/library/collections/sequences.factor
+++ b/library/collections/sequences.factor
@@ -19,7 +19,7 @@ GENERIC: set-nth ( value n sequence -- obj )
 GENERIC: thaw ( seq -- mutable-seq )
 GENERIC: like ( seq seq -- seq )
 GENERIC: reverse ( seq -- seq )
-GENERIC: reversed ( seq -- seq )
+GENERIC: reverse-slice ( seq -- seq )
 GENERIC: peek ( seq -- elt )
 GENERIC: head ( n seq -- seq )
 GENERIC: tail ( n seq -- seq )

diff --git a/library/test/lists/combinators.factor b/library/test/lists/combinators.factor
index d340fca0dd9f06dde87f8ea00de7e08706f9085b..d144b93afd10b8a8282268c7572f7475ad82bbcf 100644 (file)
--- a/library/test/lists/combinators.factor
+++ b/library/test/lists/combinators.factor
@@ -10,7 +10,7 @@ USE: sequences
 [ [ [ 3 2 1 ] [ 5 4 3 ] [ 6 ] ] ]
 [ [ 1 2 3 ] [ 3 4 5 ] [ 6 ] 3list [ reverse ] map ] unit-test
 
-[ [ 43 "a" [ ] ] ] [ [ "a" 43 43 43 [ ] 43 "a" [ ] ] prune ] unit-test
+[ [ "a" 43 [ ] ] ] [ [ "a" 43 43 43 [ ] 43 "a" [ ] ] prune ] unit-test
 
 [ "fdsfs" [ > ] sort ] unit-test-fails
 [ [ ] ] [ [ ] [ > ] sort ] unit-test

diff --git a/library/test/lists/namespaces.factor b/library/test/lists/namespaces.factor
index 7da0851049db781bcb8d61f202b02c181f53b880..20a4ca3d71696d818c73bbf22057a0ccd46d32fe 100644 (file)
--- a/library/test/lists/namespaces.factor
+++ b/library/test/lists/namespaces.factor
@@ -2,6 +2,7 @@ IN: temporary
 USE: lists
 USE: namespaces
 USE: test
+USE: sequences
 
 : cons@ [ cons ] change ;
 : unique@ [ unique ] change ;

diff --git a/library/test/test.factor b/library/test/test.factor
index bfdbd1fec3f9f3ff88fcaa195a0dc63a186900cc..81a4a9c02b2d28496fb4094199afaef46fe67f51 100644 (file)
--- a/library/test/test.factor
+++ b/library/test/test.factor
@@ -91,8 +91,8 @@ SYMBOL: failures
         "crashes" "sbuf" "threads" "parsing-word"
         "inference" "interpreter"
         "alien"
-        "line-editor" "gadgets/rectangles" "memory" "redefine"
-        "annotate" "sequences" "binary" "inspector"
+        "gadgets/line-editor" "gadgets/rectangles" "memory"
+        "redefine" "annotate" "sequences" "binary" "inspector"
     ] run-tests ;
 
 : benchmarks

diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index ce38472348fff9c08602158616ef8e88dada5edf..c8de99b29f290568ee915616ca80624a6c520e03 100644 (file)
--- a/library/ui/gadgets.factor
+++ b/library/ui/gadgets.factor
@@ -7,12 +7,15 @@ sequences vectors ;
 ! A gadget is a shape, a paint, a mapping of gestures to
 ! actions, and a reference to the gadget's parent. A gadget
 ! delegates to its shape.
-TUPLE: gadget paint gestures relayout? root? parent children ;
+TUPLE: gadget
+    paint gestures visible? relayout? root?
+    parent children ;
 
 : gadget-child gadget-children first ;
 
 C: gadget ( -- gadget )
-    { 0 0 0 } dup <rectangle> over set-delegate ;
+    { 0 0 0 } dup <rectangle> over set-delegate
+    t over set-gadget-visible? ;
 
 TUPLE: plain-gadget ;
 

diff --git a/library/ui/hand.factor b/library/ui/hand.factor
index 1ef3d5d083ec536341ff732a8e6711171556f035..6cad50343ffea4757a0e810c93772392563edb9d 100644 (file)
--- a/library/ui/hand.factor
+++ b/library/ui/hand.factor
@@ -5,14 +5,14 @@ USING: alien generic io kernel lists math matrices namespaces
 prettyprint sdl sequences vectors ;
 
 : (pick-up) ( point gadget -- gadget )
-    gadget-children reversed [ inside? ] find-with nip ;
+    gadget-children reverse-slice [ inside? ] find-with nip ;
 
 : pick-up ( point gadget -- gadget )
     #! The logic is thus. If the point is definately outside the
     #! box, return f. Otherwise, see if the point is contained
     #! in any subgadget. If not, see if it is contained in the
     #! box delegate.
-    2dup inside? [
+    dup gadget-visible? >r 2dup inside? r> drop [
         [ translate ] keep 2dup
         (pick-up) [ pick-up ] [ nip ] ?ifte
     ] [

diff --git a/library/ui/hierarchy.factor b/library/ui/hierarchy.factor
index 36c013ba02033bf74cb4d1ac17a14464ed21d52a..d13985e765b1f7d95ce7175aba71e354d0fd3f26 100644 (file)
--- a/library/ui/hierarchy.factor
+++ b/library/ui/hierarchy.factor
@@ -15,9 +15,13 @@ sequences vectors ;
         [ remove-gadget ] [ 2drop ] ifte
     ] when* ;
 
+: (clear-gadget) ( gadget -- )
+    gadget-children [
+        dup [ f swap set-gadget-parent ] each 0 swap set-length
+    ] when* ;
+
 : clear-gadget ( gadget -- )
-    dup gadget-children [ f swap set-gadget-parent ] each
-    0 over gadget-children set-length relayout ;
+    dup (clear-gadget) relayout ;
 
 : ?push ( elt seq/f -- seq )
     [ [ push ] keep ] [ 1vector ] ifte* ;

diff --git a/library/ui/incremental.factor b/library/ui/incremental.factor
index 330c9f1c9680bc6b0ce6917c0555ec1a103e7757..ddc6c09f5ab2982415fd205797d41fe342dd34bb 100644 (file)
--- a/library/ui/incremental.factor
+++ b/library/ui/incremental.factor
@@ -46,4 +46,4 @@ M: incremental layout* drop ;
     prefer-incremental ;
 
 : clear-incremental ( incremental -- )
-    dup clear-gadget { 0 0 0 } swap set-incremental-cursor ;
+    dup (clear-gadget) { 0 0 0 } swap set-incremental-cursor ;

diff --git a/library/ui/paint.factor b/library/ui/paint.factor
index c2404435b0bdb3c2772e49d4cfe1f2b7060b7520..6807df988a3c3aff12429ef0710397421fdba507 100644 (file)
--- a/library/ui/paint.factor
+++ b/library/ui/paint.factor
@@ -19,23 +19,22 @@ SYMBOL: clip
 
 : with-clip ( shape quot -- )
     #! All drawing done inside the quotation is clipped to the
-    #! shape's bounds. The quotation is called with a boolean
-    #! that is set to false if the gadget is entirely clipped.
+    #! shape's bounds.
     [
         >r screen-bounds clip [ intersect dup ] change set-clip
-        r> call
+        [ r> call ] [ r> 2drop ] ifte
     ] with-scope ; inline
 
 GENERIC: draw-gadget* ( gadget -- )
 
 : draw-gadget ( gadget -- )
-    dup [
-        [
+    dup gadget-visible? [
+        dup [
             dup draw-gadget* dup [
                 gadget-children [ draw-gadget ] each
             ] with-trans
-        ] [ drop ] ifte
-    ] with-clip ;
+        ] with-clip
+    ] [ drop ] ifte ;
 
 M: gadget draw-gadget* ( gadget -- ) drop ;
 

diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor
index 1ae0c998688e82796d285019dd1d9d0dae7e6f6f..59714734dba066148056f47d76c321f7963a2bcd 100644 (file)
--- a/library/ui/scrolling.factor
+++ b/library/ui/scrolling.factor
@@ -6,9 +6,9 @@ threads vectors styles ;
 
 ! A viewport can be scrolled.
 
-TUPLE: viewport origin ;
+TUPLE: viewport origin bottom? ;
 
-: viewport-dim ( viewport -- h ) gadget-child pref-dim ;
+: viewport-dim gadget-child pref-dim ;
 
 : fix-scroll ( origin viewport -- origin )
     dup shape-dim swap viewport-dim v- vmax { 0 0 0 } vmin ;
@@ -24,9 +24,18 @@ C: viewport ( content -- viewport )
 
 M: viewport pref-dim gadget-child pref-dim ;
 
+: viewport-origin* ( viewport -- point )
+    dup viewport-bottom? [
+        f over set-viewport-bottom?
+        dup viewport-dim { 0 -1 0 } v* over fix-scroll
+        [ swap set-viewport-origin ] keep
+    ] [
+        viewport-origin
+    ] ifte ;
+
 M: viewport layout* ( viewport -- )
-    dup viewport-origin
-    swap gadget-child dup prefer set-shape-loc ;
+    dup gadget-child dup prefer
+    >r viewport-origin* r> set-shape-loc ;
 
 M: viewport focusable-child* ( viewport -- gadget )
     gadget-child ;
@@ -49,7 +58,7 @@ TUPLE: slider viewport thumb vector ;
     slider-viewport visible-portion v/ ;
 
 : slider-current ( slider -- pos )
-    dup slider-viewport viewport-origin
+    dup slider-viewport viewport-origin*
     dup rot slider-vector v* v- ;
 
 : slider-pos ( slider pos -- pos )
@@ -91,7 +100,7 @@ C: slider ( viewport vector -- slider )
 : <y-slider> ( viewport -- slider ) { 0 1 0 } <slider> ;
 
 : thumb-loc ( slider -- loc )
-    dup slider-viewport viewport-origin vneg swap >thumb ;
+    dup slider-viewport viewport-origin* vneg swap >thumb ;
 
 : slider-dim { 16 16 16 } ;
 
@@ -114,12 +123,8 @@ TUPLE: scroller viewport x y ;
 
 : add-y-slider 2dup set-scroller-y add-right ;
 
-: viewport>bottom ( -- viewport )
-    dup viewport-origin over viewport-dim vneg
-    { 0 1 0 } set-axis swap scroll ;
-
 : (scroll>bottom) ( scroller -- )
-    dup scroller-viewport viewport>bottom
+    t over scroller-viewport set-viewport-bottom?
     dup scroller-x relayout scroller-y relayout ;
 
 : scroll>bottom ( gadget -- )