From ea052600bf8177d9dda0a6ac9fafe4531300a0dc Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 24 Jun 2009 20:06:12 -0500
Subject: [PATCH] simplification of frp

---
 extra/recipes/recipes.factor        | 12 +++----
 extra/ui/frp/gadgets/gadgets.factor |  5 ---
 extra/ui/frp/layout/layout.factor   | 55 +++++++++++++++--------------
 extra/ui/frp/signals/signals.factor | 14 +++-----
 4 files changed, 38 insertions(+), 48 deletions(-)

diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index 89c0eab393..4c793c31c8 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -2,7 +2,7 @@ USING: accessors arrays db.tuples db.sqlite persistency db.queries
 io.files.temp kernel monads sequences ui ui.frp.gadgets
 ui.frp.layout ui.frp.signals ui.gadgets.scrollers ui.gadgets.labels
 colors.constants ui.pens.solid combinators math locals strings
-ui.images db.types sequences.extras ;
+ui.images db.types sequences.extras ui.tools.inspector ;
 FROM: sets => prune ;
 IN: recipes
 STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } { genre { VARCHAR 100 } } ;
@@ -14,8 +14,8 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
 
 : interface ( -- book ) [ 
      [
-        [ $ TOOLBAR $ <spacer> $ SEARCH $ ] <hbox> COLOR: AliceBlue <solid> >>interior ,
-        [ "Genres:" <label> , <spacer> $ GENRES $ ] <hbox>
+        [ $ TOOLBAR $ ] <hbox> COLOR: AliceBlue <solid> >>interior ,
+        [ "Genres:" <label> , <spacer> $ ALL $ $ GENRES $ ] <hbox>
             { 5 0 } >>gap COLOR: gray <solid> >>interior ,
         $ RECIPES $
      ] <vbox> ,
@@ -35,13 +35,13 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
       "hate" <image-button> -1 >>value -> 2array <merge> :> votes
       "back" <image-button> -> [ -30 ] <$
       "more" <image-button> -> [ 30 ] <$ 2array <merge> :> viewed
-      <frp-field*> SEARCH ->% 1 :> search
+      <spacer> <frp-field*> ->% 1 :> search
       submit ok [ [ drop ] ] <$ 2array <merge> [ drop ] >>value :> quot
-      viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> GENRES ->
+      viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> ALL ->
       tbl selected-value>> votes [ [ + ] curry change-votes modify-tuple ] 2$>-|
         4array <merge>
         [ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap-| :> updates
-      updates [ top-genres UI[ <frp-button> GENRES ->? ] map <merge> ] bind*
+      updates [ top-genres [ <frp-button> GENRES -> ] map <merge> ] bind*
         [ text>> T{ recipe } swap >>genre get-tuples ] fmap
       tbl swap updates 2array <merge> >>model
         [ [ title>> ] [ genre>> ] bi 2array ] >>quot
diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index b865170193..3c9bbda1b3 100644
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -70,11 +70,6 @@ IN: accessors
 M: frp-button text>> children>> first text>> ;
 
 IN: ui.frp.gadgets
-M: label (unique) text>> ;
-M: button (unique) text>> ;
-M: editor (unique) editor-string ;
-M: gadget (unique) children>> ;
-M: frp-field (unique) frp-model>> (unique) ;
 M: gadget null-val drop f ;
 M: table null-val multiple-selection?>> [ V{ } clone ] [ f ] if ;
 M: frp-field null-val drop "" ;
diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index 038b739e52..cfdc1e2b86 100644
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,23 +1,24 @@
-USING: accessors assocs arrays fry kernel lexer make math.parser models
-models.product namespaces parser sequences ui.frp.gadgets
+USING: accessors assocs arrays fry kernel make math.parser models
+models.product namespaces sequences ui.frp.gadgets parser lexer
 ui.gadgets ui.gadgets.books ui.gadgets.tracks vectors words
-combinators ui.frp.signals ;
+combinators ui.frp.signals monads sequences.extras ;
 QUALIFIED: make
 IN: ui.frp.layout
 
-SYMBOL: inserting
 TUPLE: layout gadget size ; C: <layout> layout
-TUPLE: placeholder < gadget ;
-ERROR: no-models-in-books models ;
+TUPLE: placeholder < gadget members ;
+: <placeholder> ( -- placeholder ) placeholder new V{ } clone >>members ;
 
-DEFER: insert-item
-: , ( uiitem -- ) inserting namespace at {
-    { f [ make:, ] }
-    { t [ dup placeholder? [ inserting set ] [ "No location to add UI item" throw ] if ] }
-    [ placeholder? [ [ inserting get insert-item ] keep relayout ] [ drop ] if ]
-} case ;
+: (remove-members) ( placeholder members -- ) [ [ model? ] filter swap parent>> model>> [ remove-connection ] curry each ]
+    [ [ gadget? ] filter swap parent>> children>> [ delete ] curry each ] 2bi ;
+: remove-members ( placeholder -- ) dup members>> [ drop ] [ [ (remove-members) ] keep empty ] if-empty ;
+: add-member ( obj placeholder -- ) over layout? [ [ gadget>> ] dip ] when members>> push ;
 
-SYNTAX: UI[ parse-quotation '[ [ t inserting _  with-variable ] ] over push-all ;
+: , ( item -- ) make:, ;
+: make* ( quot -- list ) { } make ; inline
+
+DEFER: with-interface
+: insertion-quot ( quot -- quot' ) <placeholder> dup , swap '[ [ _ , @ ] with-interface ] ;
 
 SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
 SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
@@ -26,11 +27,6 @@ GENERIC: -> ( uiitem -- model )
 M: gadget -> dup , output-model ;
 M: model -> dup , ;
 
-: ,? ( uiitem -- ) inserting get parent>> children>> over
-    [ unique= ] curry find drop [ drop ] [ , ] if ;
-
-: ->? ( uiitem -- model ) dup ,? output-model ;
-
 : <spacer> ( -- ) <gadget> 1 <layout> , ;
 
 : add-layout ( track layout -- track ) [ gadget>> ] [ size>> ] bi track-add ; inline
@@ -38,7 +34,7 @@ M: model -> dup , ;
    [ [ dup layout? [ f <layout> ] unless ] map ]
    [ [ dup gadget? [ gadget>> ] unless ] map ] if ;
 : make-layout ( building sized? -- models layouts ) [ swap layouts ] curry
-   [ { } make [ [ model? ] filter ] ] dip bi ; inline
+   [ make* [ [ model? ] filter ] ] dip bi ; inline
 : <box> ( gadgets type -- track )
    [ t make-layout ] dip <track>
    swap [ add-layout ] each
@@ -46,11 +42,11 @@ M: model -> dup , ;
 : <hbox> ( gadgets -- track ) horizontal <box> ; inline
 : <vbox> ( gadgets -- track ) vertical <box> ; inline
 
-: make-book ( models gadgets model -- book ) <book> swap [ no-models-in-books ] unless-empty ;
+: make-book ( models gadgets model -- book ) <book> swap [ "No models in books" throw ] unless-empty ;
 : <frp-book> ( quot: ( -- model ) -- book ) f make-layout rot 0 >>value make-book ; inline
 : <frp-book*> ( quot -- book ) f make-layout f make-book ; inline
 
-SYNTAX: $ CREATE-WORD placeholder new
+SYNTAX: $ CREATE-WORD <placeholder>
     [ [ , ] curry (( -- )) define-declared "$" expect ]
     [ [ , ] curry ] bi over push-all ;
 
@@ -58,13 +54,18 @@ SYNTAX: $ CREATE-WORD placeholder new
 : insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ;
 : insertion-point ( gadget placeholder -- number parent gadget ) dup parent>> [ children>> index ] keep rot ;
 
-GENERIC# insert-item 1 ( item location -- )
-M: gadget insert-item dup parent>> track? [ [ f <layout> ] dip insert-item ]
+GENERIC# (insert-item) 1 ( item location -- )
+M: gadget (insert-item) dup parent>> track? [ [ f <layout> ] dip (insert-item) ]
     [ insertion-point [ add-gadget ] keep insert-gadget ] if ;
-M: layout insert-item insertion-point [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
-M: model insert-item parent>> dup book? [ no-models-in-books ]
+M: layout (insert-item) insertion-point [ add-layout ] keep [ gadget>> insert-gadget ] [ size>> insert-size ] 3bi ;
+M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
    [ dup model>> dup product? [ nip swap add-connection ] [ drop [ 1array <product> ] dip (>>model) ] if ] if ;
+: insert-item ( item location -- ) [ add-member ] 2keep (insert-item) ;
 
-: insert-items ( makelist -- ) f swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;
+: insert-items ( makelist -- ) f swap [ dup placeholder?
+    [ nip [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri ]
+    [ over insert-item ] if ] each drop ;
 
-: with-interface ( quot: ( -- gadget ) -- gadget ) { } make insert-items ; inline
\ No newline at end of file
+: with-interface ( quot -- ) make* [ insert-items ] with-scope ; inline
+
+M: model >>= [ swap insertion-quot <action> ] curry ;
\ No newline at end of file
diff --git a/extra/ui/frp/signals/signals.factor b/extra/ui/frp/signals/signals.factor
index 24bf2b4148..707c271159 100644
--- a/extra/ui/frp/signals/signals.factor
+++ b/extra/ui/frp/signals/signals.factor
@@ -3,11 +3,6 @@ sequences.extras ;
 FROM: models.product => product ;
 IN: ui.frp.signals
 
-GENERIC: (unique) ( gadget -- a )
-M: model (unique) ;
-: unique ( a -- b ) [ class ] [ (unique) ] bi 2array ;
-: unique= ( a b -- ? ) [ unique ] bi@ = ;
-
 GENERIC: null-val ( gadget -- model )
 M: model null-val drop f ;
 
@@ -111,16 +106,15 @@ TUPLE: & < | ;
 M: & models-changed dependencies>> [ [ null-val ] keep (>>value) ] each ;
 PRIVATE>
 
-M: model >>= [ swap <action> ] curry ;
-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 ;
 
+M: model fmap <mapped> ;
+USE: ui.frp.functors
+FMAPS: $> <$ fmap FOR & | product ;
+
 ! 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