From b8633e5e1216a2f19447b953ef0a84548874fd9c Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 21 Jun 2009 21:08:24 -0500
Subject: [PATCH] fixed point signals
---
extra/ui/frp/signals/signals.factor | 9 ++++++++-
1 file changed, 8 insertions(+), 1 deletion(-)
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 4db526dbb3..24bf2b4148 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -77,7 +77,8 @@ M: mapped-model (model-changed)
set-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>> ] dip [ quot>> call( old -- ) ] 2keep set-model ;
+
: $> ( model quot -- signal ) side-effect-model new-mapped-model ;
TUPLE: quot-model < mapped-model ;
@@ -115,5 +116,11 @@ M: model fmap <mapped> ;
USE: ui.frp.functors
FMAPS: $> <$ fmap FOR & | product ;
+! for side effects
+TUPLE: (frp-when) < multi-model quot cond ;
+: frp-when ( model quot cond -- model ) rot 1array (frp-when) <multi-model> swap >>cond swap >>quot ;
+M: (frp-when) (model-changed) [ quot>> ] 2keep
+ [ value>> ] [ cond>> ] bi* call( a -- ? ) [ call( model -- ) ] [ 2drop ] if ;
+
! only used in construction
: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
\ No newline at end of file