extra/ui/gadgets/comboboxes/comboboxes.factor

   1 USING: accessors arrays fonts kernel math.rectangles
   2 models.arrow models.combinators namespaces sequences ui.gadgets
   3 ui.gadgets.controls ui.gadgets.glass ui.gadgets.labels
   4 ui.gestures ui.pens.solid ui.tools.common ui.gadgets.borders ;
   5 QUALIFIED-WITH: ui.gadgets.tables tbl
   6 IN: ui.gadgets.comboboxes
   7
   8 TUPLE: combo-table < table spawner ;
   9
  10 : disp-string ( str -- str' ) " ▾ " append " " swap append ;
  11
  12 M: combo-table handle-gesture
  13     [ call-next-method drop ] 2keep swap T{ button-down } = [
  14         [ spawner>> ]
  15         [ tbl:selected-row [ disp-string swap set-control-value ] [ 2drop ] if ]
  16         [ hide-glass ] tri
  17     ] [ drop ] if t ;
  18
  19 TUPLE: combobox < label-control table ;
  20
  21 combobox H{
  22    { T{ button-up } [ dup table>> over >>spawner <zero-rect> show-glass ] }
  23 } set-gestures
  24
  25 : <combobox> ( options -- combobox )
  26     [ first [ combobox new-label ] [ disp-string <basic> ] bi >>model ] keep
  27     <basic> combo-table new-table white-interior [ 1array ] >>quot >>table
  28     default-font-foreground-color get <solid> >>boundary ;