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

ui.gadgets.layout: add-gadget-at refactored

db4
Sam Anklesaria 2009-08-05 08:44:14 -05:00
parent f9cc05e14a
commit 42d478054f
2 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/recipes/recipes.factor
View File

@ -11,7 +11,7 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
"recipes.db" temp-file <sqlite-db> recipe define-db
: top-recipes ( offset search -- recipes ) <query> T{ recipe } rot >>title >>tuple
"votes" >>order 30 >>limit swap >>offset get-tuples ;
: top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 (head-slice) ;
: top-genres ( -- genres ) f f top-recipes [ genre>> ] map prune 4 short head-slice ;
: interface ( -- book ) [
[

14
extra/ui/gadgets/layout/layout.factor
View File

@ -35,7 +35,7 @@ M: model -> dup , ;
: <spacer> ( -- ) <gadget> 1 <layout> , ;
: add-layout ( track layout -- track ) [ gadget>> ] [ size>> ] bi track-add ; inline
: add-layout ( track layout -- track ) [ gadget>> ] [ size>> ] bi track-add ;
: layouts ( sized? gadgets -- layouts ) [ [ gadget? ] [ layout? ] bi or ] filter swap
[ [ dup layout? [ f <layout> ] unless ] map ]
[ [ dup gadget? [ gadget>> ] unless ] map ] if ;
@ -61,10 +61,16 @@ SYNTAX: $ CREATE-WORD dup
: insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ;
: insertion-point ( placeholder -- number parent ) dup parent>> [ children>> index ] keep ;
GENERIC: >layout ( gadget -- layout )
M: gadget >layout f <layout> ;
M: layout >layout ;
GENERIC# (add-gadget-at) 2 ( parent item n -- )
M: gadget (add-gadget-at) -rot [ add-gadget ] keep insert-gadget ;
M: track (add-gadget-at) -rot >layout [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
GENERIC# add-gadget-at 1 ( item location -- )
M: gadget add-gadget-at dup parent>> track? [ [ f <layout> ] dip add-gadget-at ]
[ insertion-point rot [ add-gadget ] keep insert-gadget ] if ;
M: layout add-gadget-at insertion-point rot [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
M: object add-gadget-at insertion-point -rot (add-gadget-at) ;
M: model add-gadget-at parent>> dup book:book? [ "No models in books" throw ]
[ dup model>> dup collection? [ nip swap add-connection ] [ drop [ 1array <collection> ] dip (>>model) ] if ] if ;
: track-add-at ( item location size -- ) swap [ <layout> ] dip add-gadget-at ;