extra/ui/gadgets/alerts/alerts.factor

   1 USING: accessors models macros generalizations kernel
   2 ui ui.frp.gadgets ui.frp.signals ui.frp.layout ui.gadgets
   3 ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
   4 ui.gadgets.packs locals sequences fonts io.styles
   5 wrap.strings ;
   6
   7 IN: ui.gadgets.alerts
   8 :: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align
   9    string 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget
  10    "okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;
  11
  12 : alert* ( str -- ) [ ] swap alert ;
  13
  14 :: ask-user ( string -- model' )
  15    [ [let | lbl  [ string <label>  T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
  16             fldm [ <frp-field*> ->% 1 ]
  17             btn  [ "okay" <frp-border-button> ] |
  18          btn -> [ fldm swap <updates> ]
  19                 [ [ drop lbl close-window ] $> , ] bi
  20    ] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
  21
  22 MACRO: ask-buttons ( buttons -- quot ) dup length [
  23       [ swap
  24          [ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font ,
  25          [ [ <frp-border-button> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
  26          "" open-window
  27       ] dip firstn
  28    ] 2curry ;