product specifiers removed from frp signals
parent
e81b3f8028
commit
64bf116a01
|
|
@ -39,9 +39,9 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
|
||||||
<spacer> <frp-field*> ->% 1 :> search
|
<spacer> <frp-field*> ->% 1 :> search
|
||||||
submit ok [ [ drop ] ] <$ 2array <merge> [ drop ] >>value :> quot
|
submit ok [ [ drop ] ] <$ 2array <merge> [ drop ] >>value :> quot
|
||||||
viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> ALL ->
|
viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> ALL ->
|
||||||
tbl selected-value>> votes [ [ + ] curry change-votes modify-tuple ] 2$>-|
|
tbl selected-value>> votes [ [ + ] curry change-votes modify-tuple ] 2$>
|
||||||
4array <merge>
|
4array <merge>
|
||||||
[ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap-| :> updates
|
[ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap :> updates
|
||||||
updates [ top-genres [ <frp-button> GENRES -> ] map <merge> ] bind*
|
updates [ top-genres [ <frp-button> GENRES -> ] map <merge> ] bind*
|
||||||
[ text>> T{ recipe } swap >>genre get-tuples ] fmap
|
[ text>> T{ recipe } swap >>genre get-tuples ] fmap
|
||||||
tbl swap updates 2array <merge> >>model
|
tbl swap updates 2array <merge> >>model
|
||||||
|
|
@ -52,9 +52,9 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
|
||||||
[ [ genre>> ] fmap <frp-field> GENRE ->% .5 ]
|
[ [ genre>> ] fmap <frp-field> GENRE ->% .5 ]
|
||||||
[ [ txt>> ] fmap <frp-editor> BODY ->% 1 ]
|
[ [ txt>> ] fmap <frp-editor> BODY ->% 1 ]
|
||||||
} cleave
|
} cleave
|
||||||
[ <recipe> ] 3fmap-|
|
[ <recipe> ] 3fmap
|
||||||
[ [ 1 ] <$ ]
|
[ [ 1 ] <$ ]
|
||||||
[ quot ok <updates> #1 [ call( recipe -- ) 0 ] 2fmap-& ] bi
|
[ quot ok <updates> #1 [ call( recipe -- ) 0 ] 2fmap ] bi
|
||||||
2array <merge> 0 <basic> <switch> >>model
|
2array <merge> 0 <basic> <switch> >>model
|
||||||
] with-interface "recipes" open-window ] with-ui ;
|
] with-interface "recipes" open-window ] with-ui ;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -3,7 +3,7 @@ lists.lazy locals math math.functions math.parser math.ranges
|
||||||
models.product monads random sequences sets ui ui.frp.gadgets
|
models.product monads random sequences sets ui ui.frp.gadgets
|
||||||
ui.frp.layout ui.frp.signals ui.gadgets.alerts vectors fry
|
ui.frp.layout ui.frp.signals ui.gadgets.alerts vectors fry
|
||||||
ui.gadgets.labels memoize ;
|
ui.gadgets.labels memoize ;
|
||||||
IN: gui-sudoku
|
IN: sudokus
|
||||||
|
|
||||||
: row ( index -- row ) 1 + 9 / ceiling ;
|
: row ( index -- row ) 1 + 9 / ceiling ;
|
||||||
: col ( index -- col ) 9 mod 1 + ;
|
: col ( index -- col ) 9 mod 1 + ;
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
Sam Anklesaria
|
|
||||||
|
|
@ -1,10 +0,0 @@
|
||||||
USING: help.markup help.syntax ui.frp.signals ;
|
|
||||||
IN: ui.frp.functors
|
|
||||||
|
|
||||||
ARTICLE: { "ui.frp.functors" "signal-collection" } "Signal Collection"
|
|
||||||
"While " { $vocab-link "models.arrow.smart" } " use arrows and products to apply a quotation to the values of more than one signal, frp has more than one kind of arrow, as well as more than one kind of product" $nl
|
|
||||||
"A simple pattern is used to generate the requisite 'smart mapping' functions: "
|
|
||||||
"if 'word' maps a function on a model, then '2word; would map on two models. "
|
|
||||||
"The product is specified on the end: '2word-product'. " { $link | } " updates when any of the model it collects updates, while " { $link & } " updates when all dependencies have new values. "
|
|
||||||
"Examples of collection functions are 2fmap-| and 2$>-&" ;
|
|
||||||
ABOUT: { "ui.frp.functors" "signal-collection" }
|
|
||||||
|
|
@ -1,34 +0,0 @@
|
||||||
USING: fry functors generalizations kernel macros peg peg-lexer
|
|
||||||
sequences sequences.extras ;
|
|
||||||
FROM: ui.frp.signals => #1 ;
|
|
||||||
IN: ui.frp.functors
|
|
||||||
|
|
||||||
FUNCTOR: fmaps ( W P -- )
|
|
||||||
W IS ${W}
|
|
||||||
<p> IS <${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}
|
|
||||||
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:
|
|
||||||
tokenizer = <foreign factor>
|
|
||||||
token = !("FOR"|";").
|
|
||||||
middle = "FOR" => [[ drop ignore ]]
|
|
||||||
endexpr = ";" => [[ drop ignore ]]
|
|
||||||
expr = token* middle token* endexpr => [[ first2 combos [ first2 fmaps ] each ignore ]]
|
|
||||||
;ON-BNF
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
Used by ui.frp.signals to combine models
|
|
||||||
|
|
@ -67,9 +67,6 @@ IN: accessors
|
||||||
M: frp-button text>> children>> first text>> ;
|
M: frp-button text>> children>> first text>> ;
|
||||||
|
|
||||||
IN: ui.frp.gadgets
|
IN: ui.frp.gadgets
|
||||||
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
|
SINGLETON: gadget-monad
|
||||||
INSTANCE: gadget-monad monad
|
INSTANCE: gadget-monad monad
|
||||||
|
|
|
||||||
|
|
@ -42,7 +42,7 @@ M: model -> dup , ;
|
||||||
: <box> ( gadgets type -- track )
|
: <box> ( gadgets type -- track )
|
||||||
[ t make-layout ] dip <track>
|
[ t make-layout ] dip <track>
|
||||||
swap [ add-layout ] each
|
swap [ add-layout ] each
|
||||||
swap [ <|> >>model ] unless-empty ; inline
|
swap [ <collection> >>model ] unless-empty ; inline
|
||||||
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
|
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
|
||||||
: <vbox> ( gadgets -- track ) vertical <box> ; inline
|
: <vbox> ( gadgets -- track ) vertical <box> ; inline
|
||||||
|
|
||||||
|
|
@ -63,7 +63,7 @@ M: gadget (insert-item) dup parent>> track? [ [ f <layout> ] dip (insert-item) ]
|
||||||
[ insertion-point [ add-gadget ] keep insert-gadget ] if ;
|
[ 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: 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 ]
|
M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
|
||||||
[ dup model>> dup |? [ nip swap add-connection ] [ drop [ 1array <|> ] dip (>>model) ] if ] if ;
|
[ dup model>> dup collection? [ nip swap add-connection ] [ drop [ 1array <collection> ] dip (>>model) ] if ] if ;
|
||||||
: insert-item ( item location -- ) [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri
|
: insert-item ( item location -- ) [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri
|
||||||
[ add-member ] 2keep (insert-item) ;
|
[ add-member ] 2keep (insert-item) ;
|
||||||
|
|
||||||
|
|
@ -71,5 +71,4 @@ M: model (insert-item) parent>> dup book? [ "No models in books" throw ]
|
||||||
|
|
||||||
: with-interface ( quot -- ) make* [ insert-items ] with-scope ; inline
|
: with-interface ( quot -- ) make* [ insert-items ] with-scope ; inline
|
||||||
|
|
||||||
M: model >>= [ swap insertion-quot <action> ] curry ;
|
M: model >>= [ swap insertion-quot <action> ] curry ;
|
||||||
! Temporary places should be cleared at insertion, not on mention
|
|
||||||
|
|
@ -1,11 +1,8 @@
|
||||||
USING: accessors arrays kernel models models.product monads
|
USING: accessors arrays kernel models models.product monads
|
||||||
sequences sequences.extras ;
|
sequences sequences.extras ;
|
||||||
FROM: models.product => product ;
|
FROM: syntax => >> ;
|
||||||
IN: ui.frp.signals
|
IN: ui.frp.signals
|
||||||
|
|
||||||
GENERIC: null-val ( gadget -- model )
|
|
||||||
M: model null-val drop f ;
|
|
||||||
|
|
||||||
TUPLE: multi-model < model important? ;
|
TUPLE: multi-model < model important? ;
|
||||||
GENERIC: (model-changed) ( model observer -- )
|
GENERIC: (model-changed) ( model observer -- )
|
||||||
: <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ;
|
: <multi-model> ( models kind -- model ) f swap new-model [ [ add-dependency ] curry each ] keep ;
|
||||||
|
|
@ -47,9 +44,9 @@ M: fold-model model-activated drop ;
|
||||||
dip [ >>base ] [ value>> >>value ] bi ;
|
dip [ >>base ] [ value>> >>value ] bi ;
|
||||||
|
|
||||||
TUPLE: updater-model < multi-model values updates ;
|
TUPLE: updater-model < multi-model values updates ;
|
||||||
M: updater-model (model-changed) tuck updates>> =
|
M: updater-model (model-changed) [ tuck updates>> =
|
||||||
[ [ values>> value>> ] keep set-model ]
|
[ [ values>> value>> ] keep set-model ]
|
||||||
[ drop ] if ;
|
[ drop ] if ] keep f swap (>>value) ;
|
||||||
: <updates> ( values updates -- signal ) [ 2array updater-model <multi-model> ] 2keep
|
: <updates> ( values updates -- signal ) [ 2array updater-model <multi-model> ] 2keep
|
||||||
[ >>values ] [ >>updates ] bi* ;
|
[ >>values ] [ >>updates ] bi* ;
|
||||||
|
|
||||||
|
|
@ -61,7 +58,7 @@ M: switch-model (model-changed) 2dup switcher>> =
|
||||||
: <switch> ( signal1 signal2 -- signal' ) swap [ 2array switch-model <multi-model> ] 2keep
|
: <switch> ( signal1 signal2 -- signal' ) swap [ 2array switch-model <multi-model> ] 2keep
|
||||||
[ [ value>> >>value ] [ >>original ] bi ] [ >>switcher ] bi* ;
|
[ [ value>> >>value ] [ >>original ] bi ] [ >>switcher ] bi* ;
|
||||||
M: switch-model model-activated [ original>> ] keep model-changed ;
|
M: switch-model model-activated [ original>> ] keep model-changed ;
|
||||||
: >behavior ( event -- behavior ) t <model> <switch> ;
|
: >behavior ( event -- behavior ) t >>value ;
|
||||||
|
|
||||||
TUPLE: mapped-model < multi-model model quot ;
|
TUPLE: mapped-model < multi-model model quot ;
|
||||||
: new-mapped-model ( model quot class -- mapped-model ) [ over 1array ] dip
|
: new-mapped-model ( model quot class -- mapped-model ) [ over 1array ] dip
|
||||||
|
|
@ -89,20 +86,14 @@ M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep val
|
||||||
[ swap add-connection ] 2keep model-changed ;
|
[ swap add-connection ] 2keep model-changed ;
|
||||||
: <action> ( model quot -- action-signal ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
|
: <action> ( model quot -- action-signal ) [ 1array action <multi-model> ] dip >>quot dup f <action-value> >>value value>> ;
|
||||||
|
|
||||||
TUPLE: | < multi-model ;
|
TUPLE: collection < multi-model ;
|
||||||
: <|> ( models -- product ) | <multi-model> ;
|
: <collection> ( models -- product ) collection <multi-model> ;
|
||||||
GENERIC: models-changed ( product -- )
|
M: collection (model-changed)
|
||||||
M: | models-changed drop ;
|
|
||||||
M: | model-changed
|
|
||||||
nip
|
nip
|
||||||
dup dependencies>> [ value>> ] all?
|
dup dependencies>> [ value>> ] all?
|
||||||
[ [ dup [ value>> ] product-value swap set-model ] keep models-changed ]
|
[ dup [ value>> ] product-value swap set-model ]
|
||||||
[ drop ] if ;
|
[ drop ] if ;
|
||||||
M: | model-activated dup model-changed ;
|
M: collection model-activated dup (model-changed) ;
|
||||||
|
|
||||||
TUPLE: & < | ;
|
|
||||||
: <&> ( models -- product ) & <multi-model> ;
|
|
||||||
M: & models-changed dependencies>> [ [ null-val ] keep (>>value) ] each ;
|
|
||||||
|
|
||||||
! for side effects
|
! for side effects
|
||||||
TUPLE: (frp-when) < multi-model quot cond ;
|
TUPLE: (frp-when) < multi-model quot cond ;
|
||||||
|
|
@ -110,9 +101,9 @@ TUPLE: (frp-when) < multi-model quot cond ;
|
||||||
M: (frp-when) (model-changed) [ quot>> ] 2keep
|
M: (frp-when) (model-changed) [ quot>> ] 2keep
|
||||||
[ value>> ] [ cond>> ] bi* call( a -- ? ) [ call( model -- ) ] [ 2drop ] if ;
|
[ 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
|
! only used in construction
|
||||||
: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
|
: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
|
||||||
|
|
||||||
|
USE: ui.frp.signals.templates
|
||||||
|
M: model fmap <mapped> ;
|
||||||
|
<< { "$>" "<$" "fmap" } [ fmaps ] each >>
|
||||||
|
|
@ -0,0 +1,23 @@
|
||||||
|
USING: kernel sequences functors fry macros generalizations ;
|
||||||
|
IN: ui.frp.signals.templates
|
||||||
|
FROM: ui.frp.signals => <collection> #1 ;
|
||||||
|
FUNCTOR: fmaps ( W -- )
|
||||||
|
W IS ${W}
|
||||||
|
w-n DEFINES ${W}-n
|
||||||
|
w-2 DEFINES 2${W}
|
||||||
|
w-3 DEFINES 3${W}
|
||||||
|
w-4 DEFINES 4${W}
|
||||||
|
w-n* DEFINES ${W}-n*
|
||||||
|
w-2* DEFINES 2${W}*
|
||||||
|
w-3* DEFINES 3${W}*
|
||||||
|
w-4* DEFINES 4${W}*
|
||||||
|
WHERE
|
||||||
|
MACRO: w-n ( int -- quot ) dup '[ [ _ narray <collection> ] 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 <collection> #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
|
||||||
Loading…
Reference in New Issue