steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ui.traverse: some cleanup, use locals to understand logic better.

factor-shell
John Benediktsson 2017-10-25 18:06:47 -07:00
parent c22e55ce48
commit e06b1d7ded
1 changed files with 33 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
basis/ui/traverse/traverse.factor
View File

@ -1,73 +1,59 @@
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors namespaces make sequences kernel math arrays io
ui.gadgets generic combinators fry sets ;
USING: accessors arrays combinators fry generic io kernel locals
make math namespaces sequences sets ui.gadgets ;
IN: ui.traverse
TUPLE: node value children ;
: traverse-step ( path gadget -- path' gadget' )
[ unclip ] dip children>> ?nth ;
[ unclip-slice ] dip children>> ?nth ;
: make-node ( quot -- ) { } make node boa , ; inline
: make-node ( value quot -- node ) { } make node boa ; inline
: traverse-to-path ( topath gadget -- )
dup not [
2drop
] [
over empty? [
nip ,
] [
:: traverse-to-path ( topath gadget -- )
gadget [
topath empty? [
[
[ children>> swap first head-slice % ]
[ nip ]
[ traverse-step traverse-to-path ]
2tri
gadget children>> topath first head-slice %
topath gadget traverse-step traverse-to-path
] make-node
] if
] if ;
] unless ,
] when* ;
: traverse-from-path ( frompath gadget -- )
dup not [
2drop
] [
over empty? [
nip ,
] [
:: traverse-from-path ( frompath gadget -- )
gadget [
frompath empty? [
[
[ traverse-step traverse-from-path ]
[ nip ]
[ children>> swap first 1 + tail-slice % ]
2tri
frompath gadget traverse-step traverse-from-path
gadget children>> frompath first 1 + tail-slice %
] make-node
] if
] if ;
] unless ,
] when* ;
: traverse-pre ( frompath gadget -- )
traverse-step traverse-from-path ;
: (traverse-middle) ( frompath topath gadget -- )
[ first 1 + ] [ first ] [ children>> ] tri* <slice> % ;
: traverse-post ( topath gadget -- )
traverse-step traverse-to-path ;
: traverse-middle ( frompath topath gadget -- )
[
3dup nip traverse-pre
3dup (traverse-middle)
2dup traverse-post
2nip
] make-node ;
:: traverse-middle ( frompath topath gadget -- )
gadget [
frompath gadget traverse-pre
frompath first 1 + topath first gadget children>> <slice> %
topath gadget traverse-post
] make-node , ;
DEFER: (gadget-subtree)
DEFER: gadget-subtree%
: traverse-child ( frompath topath gadget -- )
[ 2nip ] 3keep
[ [ rest-slice ] 2dip traverse-step (gadget-subtree) ]
make-node ;
:: traverse-child ( frompath topath gadget -- )
gadget [
frompath rest-slice
topath gadget traverse-step
gadget-subtree%
] make-node , ;
: (gadget-subtree) ( frompath topath gadget -- )
: gadget-subtree% ( frompath topath gadget -- )
{
{ [ dup not ] [ 3drop ] }
{ [ pick empty? pick empty? and ] [ 2nip , ] }
@ -78,7 +64,7 @@ DEFER: (gadget-subtree)
} cond ;
: gadget-subtree ( frompath topath gadget -- seq )
[ (gadget-subtree) ] { } make ;
[ gadget-subtree% ] { } make ;
M: node gadget-text*
[ children>> ] [ value>> ] bi gadget-seq-text ;