ui.gadgets.alerts: "ask-buttons" added

db4
Sam Anklesaria 2009-05-23 08:30:41 -05:00
parent 499e2e3816
commit f5b539bb00
2 changed files with 15 additions and 7 deletions

View File

@ -85,8 +85,8 @@ M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep val
! Gadgets
TUPLE: frp-button < button hook ;
: <frp-button> ( text -- button ) [
[ t swap set-control-value ] keep
dup hook>> [ call( button -- ) ] [ drop ] if*
[ dup hook>> [ call( button -- ) ] [ drop ] if* ] keep
t swap set-control-value
] 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 ;

View File

@ -1,10 +1,10 @@
USING: accessors models kernel ui ui.frp ui.gadgets ui.gadgets.labels
ui.gadgets.editors ui.gadgets.buttons ui.gadgets.packs
locals sequences fonts io.styles ;
USING: accessors models macros generalizations kernel ui ui.frp
ui.gadgets ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
ui.gadgets.packs locals sequences fonts io.styles wrap.strings ;
IN: ui.gadgets.alerts
:: 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 22 wrap-lines <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 ;
:: ask-user* ( model string -- model' )
@ -15,4 +15,12 @@ IN: ui.gadgets.alerts
[ [ drop lbl close-window ] $> , ] bi
] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
: ask-user ( string -- model ) f <model> swap ask-user* ;
: ask-user ( string -- model ) f <model> swap ask-user* ;
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>
{ 200 110 } >>pref-dim "" open-window
] dip firstn
] 2curry ;