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

manual models for alert buttons

db4
Sam Anklesaria 2009-05-19 16:40:39 -05:00
parent db3840bc40
commit 40fc26556d
2 changed files with 13 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
extra/ui/frp/frp.factor
View File

@ -77,9 +77,10 @@ M: frp-product model-activated dup model-changed ;
! Gadgets ! Gadgets
TUPLE: frp-button < button hook ; TUPLE: frp-button < button hook ;
: <frp-button> ( text -- button ) [ [ t swap set-control-value ] keep : <frp-button> ( text -- button ) [
dup hook>> [ call( button -- ) ] [ drop ] if* ] [ t swap set-control-value ] keep
frp-button new-button border-button-theme f <basic> >>model ; dup hook>> [ call( button -- ) ] [ drop ] if*
] frp-button new-button border-button-theme f <basic> >>model ;
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>> ;

13
extra/ui/gadgets/alerts/alerts.factor
View File

@ -1,15 +1,18 @@
USING: accessors kernel ui ui.frp ui.gadgets ui.gadgets.labels USING: accessors models kernel ui ui.frp ui.gadgets ui.gadgets.labels
ui.gadgets.buttons ui.gadgets.packs locals sequences fonts io.styles ; ui.gadgets.editors ui.gadgets.buttons ui.gadgets.packs
locals sequences fonts io.styles ;
IN: ui.gadgets.alerts IN: ui.gadgets.alerts
:: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align :: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align
string <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget string <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget
"okay" [ close-window ] quot append <border-button> add-gadget "" open-window ; "okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;
: ask-user ( string -- model ) :: ask-user* ( model string -- model' )
[ [let | lbl [ <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> ] | btn [ "okay" <frp-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 ;
: ask-user ( string -- model ) f <model> swap ask-user* ;