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

fold-model improvements

db4
Sam Anklesaria 2009-06-18 15:32:11 -05:00
parent 4d2d9f86b4
commit 5f903930a3
3 changed files with 19 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/darcs-ui

@ -1 +1 @@
Subproject commit e2554b2ebae120bbd315ccbca8aa833bc8cb830e
Subproject commit 8a2deafe64cba990453126befbbbf2eed0ffd8f8

4
extra/recipes/recipes.factor
View File

@ -27,7 +27,7 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
] <vbox> ,
] <frp-book*> { 350 245 } >>pref-dim ;
:: recipe-browser ( -- ) [
:: recipe-browser ( -- ) [ [
interface
<frp-table*> :> tbl
"okay" <frp-border-button> BUTTON -> :> ok
@ -56,6 +56,6 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
[ [ 1 ] <$ ]
[ quot ok <updates> #1 [ call( recipe -- ) 0 ] 2fmap-& ] bi
2array <merge> 0 <basic> <switch> >>model
] with-interface "recipes" open-window ;
] with-interface "recipes" open-window ] with-ui ;
MAIN: recipe-browser

21
extra/ui/frp/signals/signals.factor
View File

@ -30,6 +30,7 @@ IN: ui.frp.signals
TUPLE: basic-model < multi-model ;
M: basic-model (model-changed) [ value>> ] dip set-model ;
: <merge> ( models -- signal ) basic-model <multi-model> ;
: <2merge> ( model1 model2 -- signal ) 2array <merge> ;
: <basic> ( value -- signal ) basic-model new-model ;
TUPLE: filter-model < multi-model quot ;
@ -37,11 +38,18 @@ M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? )
[ set-model ] [ 2drop ] if ;
: <filter> ( model quot -- filter-signal ) [ 1array filter-model <multi-model> ] dip >>quot ;
TUPLE: fold-model < multi-model quot ;
M: fold-model (model-changed) [ [ value>> ] [ [ value>> ] [ quot>> ] bi ] bi*
call( val oldval -- newval ) ] keep set-model ;
: <fold> ( model oldval quot -- signal ) rot 1array fold-model <multi-model> swap >>quot
TUPLE: fold-model < multi-model quot base values ;
M: fold-model (model-changed) 2dup base>> =
[ [ [ value>> ] [ [ values>> ] [ quot>> ] bi ] bi* swapd reduce* ] keep set-model ]
[ [ [ value>> ] [ values>> ] bi* push ]
[ [ [ value>> ] [ [ value>> ] [ quot>> ] bi ] bi* call( val oldval -- newval ) ] keep set-model ] 2bi
] if ;
M: fold-model model-activated drop ;
: new-fold-model ( deps -- model ) fold-model <multi-model> V{ } clone >>values ;
: <fold> ( model oldval quot -- signal ) rot 1array new-fold-model swap >>quot
swap >>value ;
: <fold*> ( model oldmodel quot -- signal ) over [ [ 2array new-fold-model ] dip >>quot ]
dip [ >>base ] [ value>> >>value ] bi ;
TUPLE: updater-model < multi-model values updates ;
M: updater-model (model-changed) tuck updates>> =
@ -105,4 +113,7 @@ PRIVATE>
M: model >>= [ swap <action> ] curry ;
M: model fmap <mapped> ;
USE: ui.frp.functors
FMAPS: $> <$ fmap FOR & | product ;
FMAPS: $> <$ fmap FOR & | product ;
! only used in construction
: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline