From a16f96447f3af9f47b6bf9b3185855bee6ab4fc0 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sun, 17 May 2009 17:35:07 -0500
Subject: [PATCH] alerts: "ask-user" added (uses functors)

---
 extra/models/mapped/mapped.factor     |  4 ++--
 extra/ui/frp/frp.factor               | 10 ++++++++++
 extra/ui/gadgets/alerts/alerts.factor | 17 ++++++++++++++---
 3 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/extra/models/mapped/mapped.factor b/extra/models/mapped/mapped.factor
index 9b8dd9ccf9..698da935e5 100644
--- a/extra/models/mapped/mapped.factor
+++ b/extra/models/mapped/mapped.factor
@@ -1,11 +1,11 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: macros ui.frp models.product fry
+USING: macros ui.frp fry
 generalizations kernel sequences ;
 IN: models.mapped
 
 MACRO: <n-mapped> ( int -- quot ) dup
-   '[ [ _ narray <product> ] dip [ _ firstn ] prepend <mapped> ] ;
+   '[ [ _ narray <frp-product> ] dip [ _ firstn ] prepend <mapped> ] ;
 
 : <2mapped> ( a b quot -- arrow ) 2 <n-mapped> ; inline
 : <3mapped> ( a b c quot -- arrow ) 3 <n-mapped> ; inline
\ No newline at end of file
diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor
index 7689e07445..4f9f2da139 100644
--- a/extra/ui/frp/frp.factor
+++ b/extra/ui/frp/frp.factor
@@ -56,6 +56,16 @@ M: mapped-model (model-changed)
     set-model ;
 M: mapped-model model-activated [ model>> ] keep model-changed ;
 
+TUPLE: frp-product < multi-model ;
+: <frp-product> ( models -- product ) frp-product <multi-model> ;
+M: frp-product model-changed
+    nip
+    dup dependencies>> [ value>> ] all?
+    [ dup [ value>> ] product-value >>value notify-connections
+    ] [ drop ] if ;
+M: frp-product update-model
+    dup value>> swap [ set-model ] set-product-value ;
+M: frp-product model-activated dup model-changed ;
 
 ! Gadgets
 : <frp-button> ( text -- button ) [ t swap set-control-value ] <border-button> f <basic> >>model ;
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index 03d60957fa..ec8335e0d3 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -1,4 +1,15 @@
-USING: accessors ui ui.gadgets ui.gadgets.labels ui.gadgets.buttons ui.gadgets.packs locals sequences fonts io.styles ;
+USING: accessors kernel ui ui.frp ui.gadgets ui.gadgets.labels
+ui.gadgets.buttons ui.gadgets.packs locals sequences fonts io.styles ;
+
 IN: ui.gadgets.alerts
-:: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align string <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget 
-   "okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;
\ No newline at end of file
+:: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align
+   string <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget 
+   "okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;
+
+: ask-user ( string -- model )
+   [ [let | lbl  [ <label>  T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
+            fldm [ <frp-field> ->% 1 ]
+            btn  [ "okay" <frp-button> ] |
+         btn -> [ fldm swap <updates> ]
+                [ [ drop lbl close-window f ] <mapped> , ] bi
+   ] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
\ No newline at end of file