simplification of frp
Sam Anklesaria
parent
2a26670099
commit
ea052600bf
|
|
@ -2,7 +2,7 @@ USING: accessors arrays db.tuples db.sqlite persistency db.queries
|
|||
io.files.temp kernel monads sequences ui ui.frp.gadgets
|
||||
ui.frp.layout ui.frp.signals ui.gadgets.scrollers ui.gadgets.labels
|
||||
colors.constants ui.pens.solid combinators math locals strings
|
||||
ui.images db.types sequences.extras ;
|
||||
ui.images db.types sequences.extras ui.tools.inspector ;
|
||||
FROM: sets => prune ;
|
||||
IN: recipes
|
||||
STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } { genre { VARCHAR 100 } } ;
|
||||
|
|
@ -14,8 +14,8 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
|
|||
|
||||
: interface ( -- book ) [
|
||||
[
|
||||
[ $ TOOLBAR $ <spacer> $ SEARCH $ ] <hbox> COLOR: AliceBlue <solid> >>interior ,
|
||||
[ "Genres:" <label> , <spacer> $ GENRES $ ] <hbox>
|
||||
[ $ TOOLBAR $ ] <hbox> COLOR: AliceBlue <solid> >>interior ,
|
||||
[ "Genres:" <label> , <spacer> $ ALL $ $ GENRES $ ] <hbox>
|
||||
{ 5 0 } >>gap COLOR: gray <solid> >>interior ,
|
||||
$ RECIPES $
|
||||
] <vbox> ,
|
||||
|
|
@ -35,13 +35,13 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
|
|||
"hate" <image-button> -1 >>value -> 2array <merge> :> votes
|
||||
"back" <image-button> -> [ -30 ] <$
|
||||
"more" <image-button> -> [ 30 ] <$ 2array <merge> :> viewed
|
||||
<frp-field*> SEARCH ->% 1 :> search
|
||||
<spacer> <frp-field*> ->% 1 :> search
|
||||
submit ok [ [ drop ] ] <$ 2array <merge> [ drop ] >>value :> quot
|
||||
viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> GENRES ->
|
||||
viewed 0 [ + ] <fold> search ok t <basic> "all" <frp-button> ALL ->
|
||||
tbl selected-value>> votes [ [ + ] curry change-votes modify-tuple ] 2$>-|
|
||||
4array <merge>
|
||||
[ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap-| :> updates
|
||||
updates [ top-genres UI[ <frp-button> GENRES ->? ] map <merge> ] bind*
|
||||
updates [ top-genres [ <frp-button> GENRES -> ] map <merge> ] bind*
|
||||
[ text>> T{ recipe } swap >>genre get-tuples ] fmap
|
||||
tbl swap updates 2array <merge> >>model
|
||||
[ [ title>> ] [ genre>> ] bi 2array ] >>quot
|
||||
|
|
|
|||
|
|
@ -70,11 +70,6 @@ IN: accessors
|
|||
M: frp-button text>> children>> first text>> ;
|
||||
|
||||
IN: ui.frp.gadgets
|
||||
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: gadget null-val drop f ;
|
||||
M: table null-val multiple-selection?>> [ V{ } clone ] [ f ] if ;
|
||||
M: frp-field null-val drop "" ;
|
||||
|
|
|
|||
|
|
@ -1,23 +1,24 @@
|
|||
USING: accessors assocs arrays fry kernel lexer make math.parser models
|
||||
models.product namespaces parser sequences ui.frp.gadgets
|
||||
USING: accessors assocs arrays fry kernel make math.parser models
|
||||
models.product namespaces sequences ui.frp.gadgets parser lexer
|
||||
ui.gadgets ui.gadgets.books ui.gadgets.tracks vectors words
|
||||
combinators ui.frp.signals ;
|
||||
combinators ui.frp.signals monads sequences.extras ;
|
||||
QUALIFIED: make
|
||||
IN: ui.frp.layout
|
||||
|
||||
SYMBOL: inserting
|
||||
TUPLE: layout gadget size ; C: <layout> layout
|
||||
TUPLE: placeholder < gadget ;
|
||||
ERROR: no-models-in-books models ;
|
||||
TUPLE: placeholder < gadget members ;
|
||||
: <placeholder> ( -- placeholder ) placeholder new V{ } clone >>members ;
|
||||
|
||||
DEFER: insert-item
|
||||
: , ( uiitem -- ) inserting namespace at {
|
||||
{ f [ make:, ] }
|
||||
{ t [ dup placeholder? [ inserting set ] [ "No location to add UI item" throw ] if ] }
|
||||
[ placeholder? [ [ inserting get insert-item ] keep relayout ] [ drop ] if ]
|
||||
} case ;
|
||||
: (remove-members) ( placeholder members -- ) [ [ model? ] filter swap parent>> model>> [ remove-connection ] curry each ]
|
||||
[ [ gadget? ] filter swap parent>> children>> [ delete ] curry each ] 2bi ;
|
||||
: remove-members ( placeholder -- ) dup members>> [ drop ] [ [ (remove-members) ] keep empty ] if-empty ;
|
||||
: add-member ( obj placeholder -- ) over layout? [ [ gadget>> ] dip ] when members>> push ;
|
||||
|
||||
SYNTAX: UI[ parse-quotation '[ [ t inserting _ with-variable ] ] over push-all ;
|
||||
: , ( item -- ) make:, ;
|
||||
: make* ( quot -- list ) { } make ; inline
|
||||
|
||||
DEFER: with-interface
|
||||
: insertion-quot ( quot -- quot' ) <placeholder> dup , swap '[ [ _ , @ ] with-interface ] ;
|
||||
|
||||
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
|
||||
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
|
||||
|
|
@ -26,11 +27,6 @@ GENERIC: -> ( uiitem -- model )
|
|||
M: gadget -> dup , output-model ;
|
||||
M: model -> dup , ;
|
||||
|
||||
: ,? ( uiitem -- ) inserting get parent>> children>> over
|
||||
[ unique= ] 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
|
||||
|
|
@ -38,7 +34,7 @@ M: model -> dup , ;
|
|||
[ [ 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
|
||||
[ make* [ [ model? ] filter ] ] dip bi ; inline
|
||||
: <box> ( gadgets type -- track )
|
||||
[ t make-layout ] dip <track>
|
||||
swap [ add-layout ] each
|
||||
|
|
@ -46,11 +42,11 @@ M: model -> dup , ;
|
|||
: <hbox> ( gadgets -- track ) horizontal <box> ; inline
|
||||
: <vbox> ( gadgets -- track ) vertical <box> ; inline
|
||||
|
||||
: make-book ( models gadgets model -- book ) <book> swap [ no-models-in-books ] unless-empty ;
|
||||
: make-book ( models gadgets model -- book ) <book> swap [ "No models in books" throw ] unless-empty ;
|
||||
: <frp-book> ( quot: ( -- model ) -- book ) f make-layout rot 0 >>value make-book ; inline
|
||||
: <frp-book*> ( quot -- book ) f make-layout f make-book ; inline
|
||||
|
||||
SYNTAX: $ CREATE-WORD placeholder new
|
||||
SYNTAX: $ CREATE-WORD <placeholder>
|
||||
[ [ , ] curry (( -- )) define-declared "$" expect ]
|
||||
[ [ , ] curry ] bi over push-all ;
|
||||
|
||||
|
|
@ -58,13 +54,18 @@ SYNTAX: $ CREATE-WORD placeholder new
|
|||
: insert-size ( number parent size -- ) -rot [ but-last insert-nth ] change-sizes drop ;
|
||||
: insertion-point ( gadget placeholder -- number parent gadget ) dup parent>> [ children>> index ] keep rot ;
|
||||
|
||||
GENERIC# insert-item 1 ( item location -- )
|
||||
M: gadget insert-item dup parent>> track? [ [ f <layout> ] dip insert-item ]
|
||||
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 parent>> dup book? [ no-models-in-books ]
|
||||
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 ]
|
||||
[ dup model>> dup product? [ nip swap add-connection ] [ drop [ 1array <product> ] dip (>>model) ] if ] if ;
|
||||
: insert-item ( item location -- ) [ add-member ] 2keep (insert-item) ;
|
||||
|
||||
: insert-items ( makelist -- ) f swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;
|
||||
: insert-items ( makelist -- ) f swap [ dup placeholder?
|
||||
[ nip [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri ]
|
||||
[ over insert-item ] if ] each drop ;
|
||||
|
||||
: with-interface ( quot: ( -- gadget ) -- gadget ) { } make insert-items ; inline
|
||||
: with-interface ( quot -- ) make* [ insert-items ] with-scope ; inline
|
||||
|
||||
M: model >>= [ swap insertion-quot <action> ] curry ;
|
||||
|
|
@ -3,11 +3,6 @@ sequences.extras ;
|
|||
FROM: models.product => product ;
|
||||
IN: ui.frp.signals
|
||||
|
||||
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 ;
|
||||
|
||||
|
|
@ -111,16 +106,15 @@ TUPLE: & < | ;
|
|||
M: & models-changed dependencies>> [ [ null-val ] keep (>>value) ] each ;
|
||||
PRIVATE>
|
||||
|
||||
M: model >>= [ swap <action> ] curry ;
|
||||
M: model fmap <mapped> ;
|
||||
USE: ui.frp.functors
|
||||
FMAPS: $> <$ fmap FOR & | product ;
|
||||
|
||||
! for side effects
|
||||
TUPLE: (frp-when) < multi-model quot cond ;
|
||||
: frp-when ( model quot cond -- model ) rot 1array (frp-when) <multi-model> swap >>cond swap >>quot ;
|
||||
M: (frp-when) (model-changed) [ quot>> ] 2keep
|
||||
[ 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
|
||||
: with-self ( quot: ( model -- model ) -- model ) [ f <basic> dup ] dip call swap [ add-dependency ] keep ; inline
|
||||
Loading…
Reference in New Issue