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

frp books automatically add models

db4
Sam Anklesaria 2009-06-07 17:43:07 -05:00
parent e8cbb5b228
commit 95d2147dd5
1 changed files with 4 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/ui/frp/layout/layout.factor
View File

@ -5,6 +5,7 @@ words tools.continuations ;
IN: ui.frp.layout IN: ui.frp.layout
TUPLE: layout gadget size ; C: <layout> layout TUPLE: layout gadget size ; C: <layout> layout
ERROR: no-models models ;
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ; SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ; SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
@ -31,7 +32,8 @@ SYMBOL: wordnames
: <hbox> ( gadgets -- track ) horizontal <box> ; inline : <hbox> ( gadgets -- track ) horizontal <box> ; inline
: <vbox> ( gadgets -- track ) vertical <box> ; inline : <vbox> ( gadgets -- track ) vertical <box> ; inline
: <frp-book> ( gadgets -- book ) f make-layout f <book> handle-words ; inline : <frp-book> ( quot: ( -- model ) -- book ) f make-layout roll dup activate-model <book> handle-words
swap [ no-models ] unless-empty ; inline
SYNTAX: $ CREATE-WORD dup [ , ] curry (( -- )) define-declared "$" expect SYNTAX: $ CREATE-WORD dup [ , ] curry (( -- )) define-declared "$" expect
word [ [ building get length swap wordnames get set-at ] [ , ] bi ] curry over push-all ; word [ [ building get length swap wordnames get set-at ] [ , ] bi ] curry over push-all ;
@ -42,7 +44,7 @@ GENERIC# insert-item 1 ( item location -- )
M: gadget insert-item dup first book? [ first2 spin [ add-gadget ] keep insert-gadget ] M: gadget insert-item dup first book? [ first2 spin [ add-gadget ] keep insert-gadget ]
[ [ f <layout> ] dip insert-item ] if ; [ [ f <layout> ] dip insert-item ] if ;
M: layout insert-item first2 spin [ insert-layout ] keep gadget>> insert-gadget ; M: layout insert-item first2 spin [ insert-layout ] keep gadget>> insert-gadget ;
M: model insert-item dup first book? [ "Books can't contain models" throw ] M: model insert-item dup first book? [ no-models ]
[ first model>> swap add-connection ] if ; [ first model>> swap add-connection ] if ;
: insert-items ( makelist -- ) f swap [ dup word? : insert-items ( makelist -- ) f swap [ dup word?