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

frp: auto-updating of action-models

db4
Sam Anklesaria 2009-05-22 16:43:21 -05:00
parent d439c61ed5
commit 4f9a9d6efe
1 changed files with 7 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
extra/ui/frp/frp.factor
View File

@ -1,8 +1,8 @@
USING: accessors arrays colors fonts fry generalizations kernel USING: accessors arrays colors fonts fry generalizations kernel
lexer macros math math.parser models models.product monads lexer macros math math.parser models models.product monads
sequences ui.gadgets ui.gadgets.buttons ui.gadgets.buttons.private sequences ui.gadgets ui.gadgets.buttons ui.gadgets.buttons.private
ui.gadgets.editors ui.gadgets.line-support ui.gadgets.scrollers ui.gadgets.editors ui.gadgets.scrollers ui.gadgets.tables
ui.gadgets.tables ui.gadgets.tracks ui.render ; ui.gadgets.tracks ;
QUALIFIED: make QUALIFIED: make
IN: ui.frp IN: ui.frp
@ -11,6 +11,8 @@ TUPLE: multi-model < model ;
GENERIC: (model-changed) ( model observer -- ) GENERIC: (model-changed) ( model observer -- )
: <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ; : <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ;
M: multi-model model-changed over value>> [ (model-changed) ] [ 2drop ] if ; M: multi-model model-changed over value>> [ (model-changed) ] [ 2drop ] if ;
M: multi-model model-activated dup dependencies>> dup length 1 =
[ first swap model-changed ] [ 2drop ] if ;
TUPLE: basic-model < multi-model ; TUPLE: basic-model < multi-model ;
M: basic-model (model-changed) [ value>> ] dip set-model ; M: basic-model (model-changed) [ value>> ] dip set-model ;
@ -50,7 +52,6 @@ TUPLE: mapped-model < multi-model model quot ;
M: mapped-model (model-changed) M: mapped-model (model-changed)
[ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi [ [ value>> ] [ quot>> ] bi* call( old -- new ) ] [ nip ] 2bi
set-model ; set-model ;
M: mapped-model model-activated [ model>> ] keep model-changed ;
TUPLE: side-effect-model < mapped-model ; TUPLE: side-effect-model < mapped-model ;
M: side-effect-model (model-changed) [ [ value>> ] [ quot>> ] bi* call( old -- ) ] keep t swap set-model ; M: side-effect-model (model-changed) [ [ value>> ] [ quot>> ] bi* call( old -- ) ] keep t swap set-model ;
@ -73,11 +74,12 @@ M: frp-product model-activated dup model-changed ;
TUPLE: action-value < basic-model parent ; TUPLE: action-value < basic-model parent ;
: <action-value> ( parent value -- model ) action-value new-model swap >>parent ; : <action-value> ( parent value -- model ) action-value new-model swap >>parent ;
M: action-value model-activated parent>> activate-model ; ! a fake dependency of sorts M: action-value model-activated dup parent>> dup activate-model model-changed ; ! a fake dependency of sorts
! Update at start
TUPLE: action < multi-model quot ; TUPLE: action < multi-model quot ;
M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>> M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>>
swap add-connection ; [ swap add-connection ] 2keep model-changed ;
: <action> ( model quot -- action ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ; : <action> ( model quot -- action ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
! Gadgets ! Gadgets