diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor index 31a8364696..d88c3dcb61 100644 --- 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 6da8be3a8d..30296cd11b 100644 --- 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 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 [ , ] curry over push-all ; SYNTAX: ->% scan string>number '[ [ _ , ] [ 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 ; + : ( -- ) 1 , ; : add-layout ( track layout -- track ) [ gadget>> ] [ size>> ] bi track-add ; inline : layouts ( sized? gadgets -- layouts ) [ [ gadget? ] [ layout? ] bi or ] filter swap - [ [ dup layout? [ f ] unless ] map ] when ; + [ [ dup layout? [ f ] unless ] map ] + [ [ dup gadget? [ gadget>> ] unless ] map ] if ; : make-layout ( building sized? -- models layouts ) [ swap layouts ] curry [ { } make [ [ model? ] filter ] ] dip bi ; inline : ( gadgets type -- track ) @@ -51,8 +61,8 @@ GENERIC# insert-item 1 ( item location -- ) M: gadget insert-item dup parent>> track? [ [ f ] 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 ] dip (>>model) ] if ] if ; : insert-items ( makelist -- ) f swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;