extra/ui/gadgets/comboboxes/comboboxes.factor

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