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

frp ,? word added

db4
Sam Anklesaria 2009-06-11 09:13:52 -05:00
parent 5f3ca1072b
commit c03ec9f053
2 changed files with 32 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
extra/ui/frp/gadgets/gadgets.factor
View File

@ -1,7 +1,7 @@
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.scrollers ui.gadgets.borders ;
ui.gadgets.tables sequences splitting ui.gadgets.labels
ui.gadgets.scrollers ui.gadgets.borders classes ;
IN: ui.frp.gadgets
TUPLE: frp-button < button hook ;
@ -57,4 +57,14 @@ M: frp-field output-model frp-model>> ;
M: scroller output-model viewport>> children>> first output-model ;
IN: accessors
M: frp-button text>> children>> first text>> ;
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 ;

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

@ -1,18 +1,22 @@
USING: accessors fry kernel lexer make math.parser models
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 ;
ui.gadgets ui.gadgets.books ui.gadgets.tracks vectors words
combinators ;
QUALIFIED: make
IN: ui.frp.layout
PREDICATE: true < word t = ;
SYMBOL: inserting
TUPLE: layout gadget size ; C: <layout> layout
TUPLE: placeholder < gadget ;
ERROR: no-models-in-books models ;
DEFER: insert-item
HOOK: , building ( uiitem -- )
M: vector , make:, ;
M: f , dup placeholder? [ building set ] [ "No location to add UI item" throw ] if ;
M: placeholder , [ building get insert-item ] keep relayout ;
HOOK: , inserting ( uiitem -- )
M: f , make:, ;
M: placeholder , [ inserting get insert-item ] keep relayout ;
M: true , dup placeholder? [ inserting set ] [ "No location to add UI item" throw ] if ;
SYNTAX: UI[ parse-quotation '[ [ t inserting _ with-variable ] ] over push-all ;
SYNTAX: ,% scan string>number [ <layout> , ] curry over push-all ;
SYNTAX: ->% scan string>number '[ [ _ <layout> , ] [ output-model ] bi ] over push-all ;
@ -21,11 +25,17 @@ GENERIC: -> ( uiitem -- model )
M: gadget -> dup , output-model ;
M: model -> dup , ;
: ,? ( uiitem -- ) inserting get parent>> children>> over
[ [ unique ] bi@ = ] 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
: layouts ( sized? gadgets -- layouts ) [ [ gadget? ] [ layout? ] bi or ] filter swap
[ [ dup layout? [ f <layout> ] unless ] map ] when ;
[ [ 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
: <box> ( gadgets type -- track )
@ -51,8 +61,8 @@ 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 dup first book? [ no-models-in-books ]
[ first model>> swap add-connection ] if ;
M: model insert-item parent>> dup book? [ no-models-in-books ]
[ dup model>> dup product? [ nip swap add-connection ] [ drop [ 1array <product> ] dip (>>model) ] if ] if ;
: insert-items ( makelist -- ) f swap [ dup placeholder? [ nip ] [ over insert-item ] if ] each drop ;