diff --git a/extra/ui/frp/gadgets/gadgets.factor b/extra/ui/frp/gadgets/gadgets.factor index 59dfd987a8..c3bdb757dc 100644 --- a/extra/ui/frp/gadgets/gadgets.factor +++ b/extra/ui/frp/gadgets/gadgets.factor @@ -1,7 +1,8 @@ USING: accessors assocs arrays kernel models monads sequences ui.frp.signals ui.gadgets ui.gadgets.borders ui.gadgets.buttons ui.gadgets.buttons.private ui.gadgets.editors words images.loader -ui.gadgets.scrollers ui.gadgets.tables ui.images vocabs.parser lexer ; +ui.gadgets.scrollers ui.gadgets.tables ui.images vocabs.parser lexer +models.range ui.gadgets.sliders ; IN: ui.frp.gadgets TUPLE: frp-button < button hook value ; @@ -53,6 +54,8 @@ M: frp-field model-changed 2dup frp-model>> = : ( -- field ) f dup [ set-control-value ] curry >>quot f >>model ; +: ( init page min max step -- slider ) horizontal ; + : image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround dup cached-image drop ; SYNTAX: IMG-FRP-BTN: image-prep [ ] curry over push-all ; @@ -65,6 +68,7 @@ M: table output-model dup multiple-selection?>> [ dup val-quot>> [ selected-value>> ] [ selected-index*>> ] if ] if ; M: frp-field output-model frp-model>> ; M: scroller output-model viewport>> children>> first output-model ; +M: slider output-model model>> range-model ; IN: accessors M: frp-button text>> children>> first text>> ; diff --git a/extra/ui/frp/layout/layout.factor b/extra/ui/frp/layout/layout.factor index c3c32cd76f..47916e5393 100644 --- a/extra/ui/frp/layout/layout.factor +++ b/extra/ui/frp/layout/layout.factor @@ -1,10 +1,11 @@ -USING: accessors arrays fry kernel lexer make math.parser +USING: accessors assocs arrays fry kernel lexer make math.parser models monads namespaces parser sequences sequences.extras ui.frp.gadgets ui.frp.signals ui.gadgets ui.gadgets.books ui.gadgets.tracks words ; QUALIFIED: make IN: ui.frp.layout +SYMBOL: templates TUPLE: layout gadget size ; C: layout TUPLE: placeholder < gadget members ; : ( -- placeholder ) placeholder new V{ } clone >>members ; @@ -22,7 +23,7 @@ TUPLE: placeholder < gadget members ; ! If there is no previously mentioned placeholder, we're probably making a box, and will create the placeholder ourselves DEFER: with-interface : insertion-quot ( quot -- quot' ) make:building get [ [ placeholder? ] find-last nip [ dup , ] unless* - swap '[ [ _ , @ ] with-interface ] ] when* ; + templates get spin '[ [ _ templates set _ , @ ] with-interface ] ] when* ; SYNTAX: ,% scan string>number [ , ] curry over push-all ; SYNTAX: ->% scan string>number '[ [ _ , ] [ output-model ] bi ] over push-all ; @@ -50,9 +51,10 @@ M: model -> dup , ; : ( quot: ( -- model ) -- book ) f make-layout rot 0 >>value make-book ; inline : ( quot -- book ) f make-layout f make-book ; inline -SYNTAX: $ CREATE-WORD - [ [ , ] curry (( -- )) define-declared "$" expect ] - [ [ , ] curry ] bi over push-all ; +ERROR: not-in-template word ; +SYNTAX: $ CREATE-WORD dup + [ [ dup templates get at [ nip , ] [ not-in-template ] if* ] curry (( -- )) define-declared "$" expect ] + [ [ [ swap templates get set-at ] keep , ] curry ] bi over push-all ; : insert-gadget ( number parent gadget -- ) -rot [ but-last insert-nth ] change-children drop ; : insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ; @@ -69,7 +71,7 @@ M: model (insert-item) parent>> dup book? [ "No models in books" throw ] : insert-items ( makelist -- ) t swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ; -: with-interface ( quot -- ) make* [ insert-items ] with-scope ; inline +: with-interface ( quot -- ) [ make* ] curry H{ } clone templates rot with-variable [ insert-items ] with-scope ; inline M: model >>= [ swap insertion-quot ] curry ; M: model fmap insertion-quot ;