frp ,? word added

diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor
index 31a836469650113b461d4a0d1df908f45fdb9af7..d88c3dcb6108526d68099190448b8b5b273916f3 100644 (file)
--- a/extra/ui/frp/gadgets/gadgets.factor
+++ b/extra/ui/frp/gadgets/gadgets.factor
@@ -1,7 +1,7 @@
 USING: accessors arrays kernel models monads ui.frp.signals ui.gadgets
 ui.gadgets.buttons ui.gadgets.buttons.private ui.gadgets.editors
-ui.gadgets.tables sequences splitting
-ui.gadgets.scrollers ui.gadgets.borders ;
+ui.gadgets.tables sequences splitting ui.gadgets.labels
+ui.gadgets.scrollers ui.gadgets.borders classes ;
 IN: ui.frp.gadgets
 
 TUPLE: frp-button < button hook ;
@@ -57,4 +57,14 @@ M: frp-field output-model frp-model>> ;
 M: scroller output-model viewport>> children>> first output-model ;
 
 IN: accessors
-M: frp-button text>> children>> first text>> ;
\ No newline at end of file
+M: frp-button text>> children>> first text>> ;
+
+IN: ui.frp.gadgets
+GENERIC: (unique) ( gadget -- a )
+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: model (unique) [ dependencies>> ] [ value>> ] bi@ 2array ;
+: unique ( a -- b ) [ class ] [ (unique) ] bi 2array ;
\ No newline at end of file

diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor
index 6da8be3a8dc273db7c7caa490960abd0abe166e0..30296cd11bcecdf1c0b00fc24cdd3d1a79a66249 100644 (file)
--- a/extra/ui/frp/layout/layout.factor
+++ b/extra/ui/frp/layout/layout.factor
@@ -1,18 +1,22 @@
-USING: accessors fry kernel lexer make math.parser models
+USING: accessors arrays fry kernel lexer make math.parser models
 models.product namespaces parser sequences ui.frp.gadgets
-ui.gadgets ui.gadgets.books ui.gadgets.tracks vectors words ;
+ui.gadgets ui.gadgets.books ui.gadgets.tracks vectors words
+combinators ;
 QUALIFIED: make
 IN: ui.frp.layout
 
+PREDICATE: true < word t = ;
+SYMBOL: inserting
 TUPLE: layout gadget size ; C: <layout> layout
 TUPLE: placeholder < gadget ;
 ERROR: no-models-in-books models ;
 
 DEFER: insert-item
-HOOK: , building ( uiitem -- )
-M: vector , make:, ;
-M: f , dup placeholder? [ building set ] [ "No location to add UI item" throw ] if ;
-M: placeholder , [ building get insert-item ] keep relayout ;
+HOOK: , inserting ( uiitem -- )
+M: f , make:, ;
+M: placeholder , [ inserting get insert-item ] keep relayout ;
+M: true , dup placeholder? [ inserting set ] [ "No location to add UI item" throw ] if ;
+SYNTAX: UI[ parse-quotation '[ [ t inserting _  with-variable ] ] over push-all ;
 
 SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
 SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
@@ -21,11 +25,17 @@ GENERIC: -> ( uiitem -- model )
 M: gadget -> dup , output-model ;
 M: model -> dup , ;
 
+: ,? ( uiitem -- ) inserting get parent>> children>> over
+    [ [ unique ] bi@ = ] 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
 : layouts ( sized? gadgets -- layouts ) [ [ gadget? ] [ layout? ] bi or ] filter swap
-   [ [ dup layout? [ f <layout> ] unless ] map ] when ;
+   [ [ 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
 : <box> ( gadgets type -- track )
@@ -51,8 +61,8 @@ 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 dup first book? [ no-models-in-books ]
-   [ first model>> swap add-connection ] if ;
+M: model insert-item parent>> dup book? [ no-models-in-books ]
+   [ dup model>> dup product? [ nip swap add-connection ] [ drop [ 1array <product> ] dip (>>model) ] if ] if ;
 
 : insert-items ( makelist -- ) f swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;