ui.frp connection reordering supported
parent
c03ec9f053
commit
b265e3afea
|
@ -942,4 +942,6 @@ PRIVATE>
|
|||
inline recursive
|
||||
|
||||
:: combos ( list1 list2 -- result ) list2 [ [ 2array ] curry list1 swap map ] map concat ;
|
||||
: (head-slice) ( seq n -- seq' ) over length over < [ drop ] [ head-slice ] if ;
|
||||
: (head-slice) ( seq n -- seq' ) over length over < [ drop ] [ head-slice ] if ;
|
||||
: find-all ( seq quot -- elts ) [ [ length iota ] keep ] dip
|
||||
[ dupd call( a -- ? ) [ 2array ] [ 2drop f ] if ] curry 2map [ ] filter ; inline
|
|
@ -1,4 +1,4 @@
|
|||
USING: help.markup help.syntax ui.frp.signals ;
|
||||
USING: help.markup help.syntax ui.frp.signals ui.frp.signals.private ;
|
||||
IN: ui.frp.functors
|
||||
|
||||
ARTICLE: { "ui.frp.functors" "signal-collection" } "Signal Collection"
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
USING: fry functors generalizations kernel macros peg peg-lexer
|
||||
sequences ;
|
||||
FROM: ui.frp.signals => #1 ;
|
||||
IN: ui.frp.functors
|
||||
|
||||
FUNCTOR: fmaps ( W P -- )
|
||||
|
@ -9,11 +10,19 @@ w-n DEFINES ${W}-n-${P}
|
|||
w-2 DEFINES 2${W}-${P}
|
||||
w-3 DEFINES 3${W}-${P}
|
||||
w-4 DEFINES 4${W}-${P}
|
||||
w-n* DEFINES ${W}-n-${P}*
|
||||
w-2* DEFINES 2${W}-${P}*
|
||||
w-3* DEFINES 3${W}-${P}*
|
||||
w-4* DEFINES 4${W}-${P}*
|
||||
WHERE
|
||||
MACRO: w-n ( int -- quot ) dup '[ [ _ narray <p> ] dip [ _ firstn ] prepend W ] ;
|
||||
: w-2 ( a b quot -- mapped ) 2 w-n ; inline
|
||||
: w-3 ( a b c quot -- mapped ) 3 w-n ; inline
|
||||
: w-4 ( a b c d quot -- mapped ) 4 w-n ; inline
|
||||
MACRO: w-n* ( int -- quot ) dup '[ [ _ narray <p> #1 ] dip [ _ firstn ] prepend W ] ;
|
||||
: w-2* ( a b quot -- mapped ) 2 w-n* ; inline
|
||||
: w-3* ( a b c quot -- mapped ) 3 w-n* ; inline
|
||||
: w-4* ( a b c d quot -- mapped ) 4 w-n* ; inline
|
||||
;FUNCTOR
|
||||
|
||||
ON-BNF: FMAPS:
|
||||
|
|
|
@ -1,17 +1,17 @@
|
|||
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.labels
|
||||
ui.gadgets.scrollers ui.gadgets.borders classes ;
|
||||
ui.gadgets.scrollers ui.gadgets.borders ;
|
||||
IN: ui.frp.gadgets
|
||||
|
||||
TUPLE: frp-button < button hook ;
|
||||
TUPLE: frp-button < button hook value ;
|
||||
: <frp-button> ( gadget -- button ) [
|
||||
[ dup hook>> [ call( button -- ) ] [ drop ] if* ] keep
|
||||
[ dup set-control-value ] [ f swap set-control-value ] bi
|
||||
[ [ [ value>> ] [ ] bi or ] keep set-control-value ]
|
||||
[ dup hook>> [ call( button -- ) ] [ drop ] if* ] bi
|
||||
] frp-button new-button f <basic> >>model ;
|
||||
: <frp-border-button> ( text -- button ) <frp-button> border-button-theme ;
|
||||
|
||||
TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment ;
|
||||
TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment actions ;
|
||||
M: frp-table column-titles column-titles>> ;
|
||||
M: frp-table column-alignment column-alignment>> ;
|
||||
M: frp-table row-columns quot>> [ call( a -- b ) ] [ drop f ] if* ;
|
||||
|
@ -19,14 +19,16 @@ M: frp-table row-value val-quot>> [ call( a -- b ) ] [ drop f ] if* ;
|
|||
M: frp-table row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ;
|
||||
|
||||
: <frp-table> ( model -- table ) f frp-table new-table dup >>renderer
|
||||
V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices* ;
|
||||
V{ } clone <basic> >>selected-values V{ } clone <basic> >>selected-indices*
|
||||
f <basic> >>actions dup [ actions>> set-model ] curry >>action ;
|
||||
: <frp-table*> ( -- table ) V{ } clone <model> <frp-table> ;
|
||||
: <frp-list> ( column-model -- table ) <frp-table> [ 1array ] >>quot ;
|
||||
: <frp-list*> ( -- table ) V{ } clone <model> <frp-list> ;
|
||||
: indexed ( table -- table ) f >>val-quot ;
|
||||
|
||||
TUPLE: frp-field < field frp-model ;
|
||||
: <frp-field> ( model -- gadget ) frp-field new-field swap >>frp-model ;
|
||||
: init-field ( field -- field' ) [ [ ] [ "" ] if* ] change-value ;
|
||||
: <frp-field> ( model -- gadget ) frp-field new-field swap init-field >>frp-model ;
|
||||
M: frp-field graft*
|
||||
[ [ frp-model>> value>> ] [ editor>> ] bi set-editor-string ]
|
||||
[ dup editor>> model>> add-connection ]
|
||||
|
@ -38,13 +40,13 @@ M: frp-field model-changed 2dup frp-model>> =
|
|||
[ [ value>> ] [ editor>> ] bi* set-editor-string ]
|
||||
[ nip [ editor>> editor-string ] [ frp-model>> ] bi set-model ] if ;
|
||||
|
||||
: <frp-field*> ( -- field ) f <model> <frp-field> ;
|
||||
: <frp-field*> ( -- field ) "" <model> <frp-field> ;
|
||||
: <empty-field> ( model -- field ) "" <model> <switch> <frp-field> ;
|
||||
: <empty-field*> ( -- field ) "" <model> <frp-field> ;
|
||||
: <frp-editor> ( model -- gadget )
|
||||
frp-field [ <multiline-editor> ] dip new-border dup gadget-child >>editor
|
||||
field-theme swap >>frp-model { 1 0 } >>align ;
|
||||
: <frp-editor*> ( -- editor ) f <model> <frp-editor> ;
|
||||
field-theme swap init-field >>frp-model { 1 0 } >>align ;
|
||||
: <frp-editor*> ( -- editor ) "" <model> <frp-editor> ;
|
||||
: <empty-editor*> ( -- field ) "" <model> <frp-editor> ;
|
||||
: <empty-editor> ( model -- field ) "" <model> <switch> <frp-editor> ;
|
||||
|
||||
|
@ -60,11 +62,18 @@ IN: accessors
|
|||
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 ;
|
||||
M: gadget null-val drop f ;
|
||||
M: table null-val multiple-selection?>> [ V{ } clone ] [ f ] if ;
|
||||
M: frp-field null-val drop "" ;
|
||||
|
||||
SINGLETON: gadget-monad
|
||||
INSTANCE: gadget-monad monad
|
||||
INSTANCE: gadget monad
|
||||
M: gadget monad-of drop gadget-monad ;
|
||||
M: gadget-monad return drop <gadget> swap >>model ;
|
||||
M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
|
|
@ -1 +0,0 @@
|
|||
Sam Anklesaria
|
|
@ -1,9 +0,0 @@
|
|||
USING: help.markup help.syntax monads ui.frp.signals ;
|
||||
IN: ui.frp.instances
|
||||
IN: ui.frp.instances
|
||||
ARTICLE: { "ui.frp.instances" "explanation" } "FRP Instances"
|
||||
"Signals are all functors, as " { $link fmap } " corresponds directly to " { $link <mapped> } $nl
|
||||
"Moduls also impliment monad functionalities. " { $link bind } "ing switches between two models. " $nl
|
||||
"Also, a gadget is a monad. Binding recieves a model and adds the resulting gadget onto the parent. " $nl
|
||||
"Examples of these instances can be seen in the " { $vocab-link "darcs-ui" } " vocabulary." ;
|
||||
ABOUT: { "ui.frp.instances" "explanation" }
|
|
@ -1,12 +0,0 @@
|
|||
USING: accessors kernel models monads ui.frp.signals ui.frp.layout ui.gadgets ;
|
||||
IN: ui.frp.instances
|
||||
|
||||
M: model >>= [ swap <action> ] curry ;
|
||||
M: model fmap <mapped> ;
|
||||
|
||||
SINGLETON: gadget-monad
|
||||
INSTANCE: gadget-monad monad
|
||||
INSTANCE: gadget monad
|
||||
M: gadget monad-of drop gadget-monad ;
|
||||
M: gadget-monad return drop <gadget> swap >>model ;
|
||||
M: gadget >>= output-model [ swap call( x -- y ) ] curry ;
|
|
@ -1,7 +1,7 @@
|
|||
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
|
||||
combinators ;
|
||||
combinators ui.frp.signals ;
|
||||
QUALIFIED: make
|
||||
IN: ui.frp.layout
|
||||
|
||||
|
@ -26,7 +26,7 @@ M: gadget -> dup , output-model ;
|
|||
M: model -> dup , ;
|
||||
|
||||
: ,? ( uiitem -- ) inserting get parent>> children>> over
|
||||
[ [ unique ] bi@ = ] curry find drop [ drop ] [ , ] if ;
|
||||
[ unique= ] curry find drop [ drop ] [ , ] if ;
|
||||
|
||||
: ->? ( uiitem -- model ) dup ,? output-model ;
|
||||
|
||||
|
|
|
@ -1,14 +1,32 @@
|
|||
USING: accessors arrays kernel monads models models.product sequences ui.frp.functors ;
|
||||
USING: accessors arrays kernel monads models models.product sequences ui.frp.functors
|
||||
classes ui.tools.inspector tools.continuations ;
|
||||
FROM: models.product => product ;
|
||||
IN: ui.frp.signals
|
||||
|
||||
TUPLE: multi-model < model ;
|
||||
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 ;
|
||||
|
||||
TUPLE: multi-model < model important? ;
|
||||
GENERIC: (model-changed) ( model observer -- )
|
||||
: <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ;
|
||||
M: multi-model model-changed over value>> [ (model-changed) ] [ 2drop ] if ;
|
||||
M: multi-model model-activated dup dependencies>> [ value>> ] find nip
|
||||
[ swap model-changed ] [ drop ] if* ;
|
||||
|
||||
: #1 ( model -- model' ) t >>important? ;
|
||||
|
||||
IN: models
|
||||
: notify-connections ( model -- )
|
||||
dup connections>> dup [ dup multi-model? [ important?>> ] [ drop f ] if ] find-all
|
||||
[ second tuck [ remove ] dip prefix ] each
|
||||
[ model-changed ] with each ;
|
||||
IN: ui.frp.signals
|
||||
|
||||
TUPLE: basic-model < multi-model ;
|
||||
M: basic-model (model-changed) [ value>> ] dip set-model ;
|
||||
: <merge> ( models -- signal ) basic-model <multi-model> ;
|
||||
|
@ -32,9 +50,10 @@ M: updater-model (model-changed) tuck updates>> =
|
|||
: <updates> ( values updates -- signal ) [ 2array updater-model <multi-model> ] 2keep
|
||||
[ >>values ] [ >>updates ] bi* ;
|
||||
|
||||
SYMBOL: switch
|
||||
TUPLE: switch-model < multi-model original switcher on ;
|
||||
M: switch-model model-changed 2dup switcher>> =
|
||||
[ [ value>> ] dip over [ t >>on set-model ] [ nip [ original>> ] keep f >>on model-changed ] if ]
|
||||
M: switch-model (model-changed) 2dup switcher>> =
|
||||
[ [ value>> ] dip over switch = [ nip [ original>> ] keep f >>on model-changed ] [ t >>on set-model ] if ]
|
||||
[ dup on>> [ 2drop ] [ [ value>> ] dip over [ set-model ] [ 2drop ] if ] if ] if ;
|
||||
: <switch> ( signal1 signal2 -- signal' ) swap [ 2array switch-model <multi-model> ] 2keep
|
||||
[ [ value>> >>value ] [ >>original ] bi ] [ >>switcher ] bi* ;
|
||||
|
@ -80,9 +99,11 @@ M: | update-model
|
|||
dup value>> swap [ set-model ] set-product-value ;
|
||||
M: | model-activated dup model-changed ;
|
||||
|
||||
! Only when everything's true does he make it false
|
||||
TUPLE: & < | ;
|
||||
: <&> ( models -- product ) & <multi-model> ;
|
||||
M: & models-changed dependencies>> [ f swap (>>value) ] each ;
|
||||
M: & models-changed dependencies>> [ [ null-val ] keep (>>value) ] each ;
|
||||
PRIVATE>
|
||||
|
||||
M: model >>= [ swap <action> ] curry ;
|
||||
M: model fmap <mapped> ;
|
||||
FMAPS: $> <$ fmap FOR & | product ;
|
Loading…
Reference in New Issue