illusion models activated automatically

db4
Sam Anklesaria 2009-05-24 15:35:03 -05:00
parent 22c071778a
commit 96d29b7dba
5 changed files with 11 additions and 8 deletions
basis/models/illusion
extra/ui
gadgets

View File

@ -5,7 +5,7 @@ TUPLE: illusion < arrow ;
: <illusion> ( model quot -- illusion )
illusion new V{ } clone >>connections V{ } clone >>dependencies 0 >>ref
swap >>quot over >>model [ add-dependency ] keep ;
swap >>quot over >>model [ add-dependency ] keep dup activate-model ;
: backtalk ( value object -- )
[ quot>> [undo] call( a -- b ) ] [ model>> ] bi set-model ;

View File

@ -4,10 +4,12 @@ ui.gadgets.editors ui.gadgets.tables ;
IN: ui.frp.gadgets
TUPLE: frp-button < button hook ;
: <frp-button> ( text -- button ) [
: <frp-button> ( gadget -- button ) [
[ dup hook>> [ call( button -- ) ] [ drop ] if* ] keep
t swap set-control-value
] frp-button new-button border-button-theme f <basic> >>model ;
] frp-button new-button f <basic> >>model ;
: <frp-bevel-button> ( text -- button ) <frp-button> border-button-theme ;
TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment ;
M: frp-table column-titles column-titles>> ;

View File

@ -38,6 +38,7 @@ M: switch-model (model-changed) 2dup switcher>> =
: <switch> ( signal1 signal2 -- signal' ) [ 2array switch-model <multi-model> ] 2keep
[ >>original ] [ >>switcher ] bi* ;
M: switch-model model-activated [ original>> ] keep model-changed ;
: >behavior ( event -- behavior ) t <model> swap <switch> ;
TUPLE: mapped-model < multi-model model quot ;
: new-mapped-model ( model quot class -- const-model ) [ over 1array ] dip

View File

@ -10,7 +10,7 @@ IN: ui.gadgets.alerts
:: ask-user* ( model string -- model' )
[ [let | lbl [ string <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
fldm [ <frp-field> ->% 1 ]
btn [ "okay" <frp-button> model >>model ] |
btn [ "okay" <frp-bevel-button> model >>model ] |
btn -> [ fldm swap <updates> ]
[ [ drop lbl close-window ] $> , ] bi
] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
@ -20,7 +20,7 @@ IN: ui.gadgets.alerts
MACRO: ask-buttons ( buttons -- quot ) dup length [
[ swap
[ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font ,
[ [ <frp-button> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
[ [ <frp-bevel-button> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
{ 200 110 } >>pref-dim "" open-window
] dip firstn
] 2curry ;

View File

@ -1,6 +1,6 @@
USING: accessors arrays kernel math.rectangles models sequences
ui.frp ui.gadgets ui.gadgets.glass ui.gadgets.labels
ui.gadgets.tables ui.gestures colors.constants fonts ;
ui.gadgets ui.gadgets.glass ui.gadgets.labels
ui.gadgets.tables ui.gestures ;
IN: ui.gadgets.comboboxes
TUPLE: combo-table < table spawner ;
@ -19,4 +19,4 @@ combobox H{
: <combobox> ( options -- combobox ) [ first [ combobox new-label ] keep <model> >>model ] keep
[ 1array ] map <model> trivial-renderer combo-table new-table
>>table dup font>> COLOR: gray >>background 12 >>size >>font ;
>>table ;