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

ui.frp templates separate model, view

db4
Sam Anklesaria 2009-06-04 21:22:30 -05:00
parent 6819fcda4c
commit b74b8478f3
1 changed files with 31 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,26 +1,43 @@
USING: accessors fry kernel lexer math.parser models
sequences ui.gadgets.tracks ui.gadgets models.product
ui.frp.gadgets ui.gadgets.books ;
QUALIFIED: make
USING: accessors assocs arrays fry kernel lexer make math math.parser
models models.product namespaces parser sequences
ui.frp.gadgets ui.gadgets ui.gadgets.books ui.gadgets.tracks
words tools.continuations ;
IN: ui.frp.layout
TUPLE: layout gadget width ; C: <layout> layout
GENERIC: , ( uiitem -- )
M: gadget , f <layout> make:, ;
M: model , make:, ;
: <layout> ( gadget width -- gadget ) over set ;
SYNTAX: ,% scan string>number [ <layout> make:, ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> make:, ] [ output-model ] bi ] over push-all ;
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
GENERIC: -> ( uiitem -- model )
M: gadget -> dup , output-model ;
M: model -> dup , ;
: <spacer> ( -- ) <gadget> 1 <layout> make:, ;
: <spacer> ( -- ) <gadget> 1 <layout> , ;
SYMBOL: wordnames
: <box> ( gadgets type -- track )
[ { } make:make dup [ layout? ] filter ] dip <track> swap [ [ gadget>> ] [ width>> ] bi track-add ] each
swap [ model? ] filter [ <product> >>model ] unless-empty ; inline
[ { } make [ [ model? ] filter ] [ [ word? ] filter ] [ [ gadget? ] filter ] tri ] dip <track>
swap [ dup get track-add ] each
tuck [ [ swap 2array ] curry wordnames get swap change-at ] curry each
swap [ <product> >>model ] unless-empty ; inline
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
: <vbox> ( gadgets -- track ) vertical <box> ; inline
: <frp-book> ( gadgets -- book ) { } make:make [ gadget>> ] map f <book> ; inline
: <frp-book> ( gadgets -- book ) { } make [ gadget>> ] map f <book> ; inline
SYNTAX: $ CREATE-WORD dup [ , ] curry (( -- )) define-declared "$" expect
word [ [ building get length swap wordnames get set-at ] [ , ] bi ] curry over push-all ;
GENERIC# insert-item 1 ( item location -- )
M: gadget insert-item first2 spin [ dup get track-add ] keep
-rot [ but-last insert-nth ] change-children drop ;
M: model insert-item first model>> swap add-connection ;
: insert-items ( makelist -- ) f swap [ dup word?
[ wordnames get at nip ] [ over insert-item ] if
] each drop ;
: with-interface ( quot: ( -- gadget ) -- gadget ) H{ } clone wordnames
[ { } make insert-items ] with-variable ; inline