steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fixed binding bugs in frp

db4
Sam Anklesaria 2009-06-27 13:22:48 -05:00
parent a6f65a483b
commit 07c8c00a12
2 changed files with 14 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
extra/ui/frp/layout/layout.factor
View File

@ -1,7 +1,7 @@
USING: accessors arrays fry kernel lexer make math.parser USING: accessors arrays fry kernel lexer make math.parser
models models.product monads namespaces parser sequences models monads namespaces parser sequences
sequences.extras ui.frp.gadgets ui.frp.signals ui.gadgets sequences.extras ui.frp.gadgets ui.frp.signals ui.gadgets
ui.gadgets.books ui.gadgets.tracks words ; ui.gadgets.books ui.gadgets.tracks words ui.tools.inspector ;
QUALIFIED: make QUALIFIED: make
IN: ui.frp.layout IN: ui.frp.layout
@ -18,8 +18,11 @@ TUPLE: placeholder < gadget members ;
: , ( item -- ) make:, ; : , ( item -- ) make:, ;
: make* ( quot -- list ) { } make ; inline : make* ( quot -- list ) { } make ; inline
! Just take the previous mentioned placeholder and use it
! If there is no previously mentioned placeholder, we're probably making a box, and will create the placeholder ourselves
DEFER: with-interface DEFER: with-interface
: insertion-quot ( quot -- quot' ) <placeholder> dup , swap '[ [ _ , @ ] with-interface ] ; : insertion-quot ( quot -- quot' ) make:building get [ placeholder? ] find-last nip [ <placeholder> dup , ] unless*
swap '[ [ _ , @ ] with-interface ] ;
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ; SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ; SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
@ -39,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 [ <product> >>model ] unless-empty ; inline swap [ <|> >>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
@ -59,14 +62,14 @@ GENERIC# (insert-item) 1 ( item location -- )
M: gadget (insert-item) dup parent>> track? [ [ f <layout> ] dip (insert-item) ] 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) dup inspector parent>> dup book? [ "No models in books" throw ]
[ dup model>> dup product? [ nip swap add-connection ] [ drop [ 1array <product> ] dip (>>model) ] if ] if ; [ dup model>> dup |? [ nip swap add-connection ] [ drop [ 1array <|> ] dip (>>model) ] if ] if ;
: insert-item ( item location -- ) [ add-member ] 2keep (insert-item) ; : insert-item ( item location -- ) [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri
[ add-member ] 2keep (insert-item) ;
: insert-items ( makelist -- ) t swap [ dup placeholder? : insert-items ( makelist -- ) t swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;
[ nip [ dup get [ drop ] [ remove-members ] if ] [ on ] [ ] tri ]
[ over insert-item ] if ] each drop ;
: 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

2
extra/ui/frp/signals/signals.factor
View File

@ -88,7 +88,6 @@ TUPLE: action < multi-model quot ;
M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>> M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep value>>
[ 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>> ;
<PRIVATE
TUPLE: | < multi-model ; TUPLE: | < multi-model ;
: <|> ( models -- product ) | <multi-model> ; : <|> ( models -- product ) | <multi-model> ;
@ -104,7 +103,6 @@ M: | model-activated dup model-changed ;
TUPLE: & < | ; TUPLE: & < | ;
: <&> ( models -- product ) & <multi-model> ; : <&> ( models -- product ) & <multi-model> ;
M: & models-changed dependencies>> [ [ null-val ] keep (>>value) ] each ; M: & models-changed dependencies>> [ [ null-val ] keep (>>value) ] each ;
PRIVATE>
! for side effects ! for side effects
TUPLE: (frp-when) < multi-model quot cond ; TUPLE: (frp-when) < multi-model quot cond ;