ui.gadgets.incremental: fix so that the scrolled of gadgets are ungrafted

db4
Björn Lindqvist 2015-10-18 17:35:26 +02:00
parent 0f803aa84b
commit 8bb96cbfd1
2 changed files with 10 additions and 5 deletions

View File

@ -8,7 +8,7 @@ $nl
$nl
"Children are managed with the " { $link add-incremental } " and " { $link clear-incremental } " words."
$nl
"An example of an incremental is the " { $slot "output" } " of a 'pane' gadget."
"An example of an incremental is the 'output' of a 'pane' gadget."
$nl
"Not every " { $link pack } " can use incremental layout, since incremental layout does not support non-default values for the " { $slot "align" } ", " { $slot "fill" } ", and " { $slot "gap" } " slots." } ;

View File

@ -1,7 +1,8 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators kernel math math.vectors namespaces
sequences ui.gadgets ui.gadgets.packs ui.gadgets.private ;
USING: accessors combinators grouping kernel math math.vectors
namespaces sequences threads ui.gadgets ui.gadgets.packs
ui.gadgets.private ;
IN: ui.gadgets.incremental
TUPLE: incremental < pack cursor ;
@ -37,8 +38,12 @@ M: incremental dim-changed drop ;
: scroll-children ( incremental -- )
dup children>> length 200,000 > [
! We let the length oscillate between 100k-200k, so we don't
! have to tail* the sequence on every gadget add.
[ 100,000 short tail* ] change-children drop
! have to relayout the container every time a gadget is added.
[ 100,000 short cut* ] change-children relayout yield
! Then we ungraft the scrolled of gadgets. Yield every 10k
! gadget so to not overflow the ungraft queue.
10 <groups> [ [ ungraft ] each yield ] each
] [ drop ] if ;
: add-incremental ( gadget incremental -- )