extra/ui/gadgets/alerts/alerts.factor

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