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

View File

@ -5,7 +5,7 @@ TUPLE: illusion < arrow ;
: <illusion> ( model quot -- illusion ) : <illusion> ( model quot -- illusion )
illusion new V{ } clone >>connections V{ } clone >>dependencies 0 >>ref 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 -- ) : backtalk ( value object -- )
[ quot>> [undo] call( a -- b ) ] [ model>> ] bi set-model ; [ 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 IN: ui.frp.gadgets
TUPLE: frp-button < button hook ; TUPLE: frp-button < button hook ;
: <frp-button> ( text -- button ) [ : <frp-button> ( gadget -- button ) [
[ dup hook>> [ call( button -- ) ] [ drop ] if* ] keep [ dup hook>> [ call( button -- ) ] [ drop ] if* ] keep
t swap set-control-value 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 ; TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment ;
M: frp-table column-titles column-titles>> ; 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 : <switch> ( signal1 signal2 -- signal' ) [ 2array switch-model <multi-model> ] 2keep
[ >>original ] [ >>switcher ] bi* ; [ >>original ] [ >>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> swap <switch> ;
TUPLE: mapped-model < multi-model model quot ; TUPLE: mapped-model < multi-model model quot ;
: new-mapped-model ( model quot class -- const-model ) [ over 1array ] dip : 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' ) :: ask-user* ( model string -- model' )
[ [let | lbl [ string <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , ] [ [let | lbl [ string <label> T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
fldm [ <frp-field> ->% 1 ] fldm [ <frp-field> ->% 1 ]
btn [ "okay" <frp-button> model >>model ] | btn [ "okay" <frp-bevel-button> model >>model ] |
btn -> [ fldm swap <updates> ] btn -> [ fldm swap <updates> ]
[ [ drop lbl close-window ] $> , ] bi [ [ drop lbl close-window ] $> , ] bi
] ] <vbox> { 161 86 } >>pref-dim "" open-window ; ] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
@ -20,7 +20,7 @@ IN: ui.gadgets.alerts
MACRO: ask-buttons ( buttons -- quot ) dup length [ MACRO: ask-buttons ( buttons -- quot ) dup length [
[ swap [ swap
[ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font , [ 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 { 200 110 } >>pref-dim "" open-window
] dip firstn ] dip firstn
] 2curry ; ] 2curry ;

View File

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