basis/ui/gadgets/toolbar/toolbar.factor

   1 ! Copyright (C) 2005, 2009 Slava Pestov, 2015 Nicolas Pénet.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs classes kernel ui.baseline-alignment
   4 ui.commands ui.gadgets ui.gadgets.borders ui.gadgets.buttons
   5 ui.gadgets.buttons.private ui.gadgets.tracks ui.pens
   6 ui.pens.solid ui.theme ;
   7 IN: ui.gadgets.toolbar
   8
   9 <PRIVATE
  10
  11 : <toolbar-button-pen> ( -- pen )
  12     toolbar-background <solid> dup
  13     toolbar-button-pressed-background <solid> dup dup
  14     <button-pen> ;
  15
  16 : toolbar-button-theme ( gadget -- gadget )
  17     dup gadget-child border-button-label-theme
  18     horizontal >>orientation
  19     <toolbar-button-pen> >>interior
  20     dup dup interior>> pen-pref-dim >>min-dim
  21     { 10 6 } >>size ; inline
  22
  23 PRIVATE>
  24
  25 :: <toolbar-button> ( target gesture command -- button )
  26     command command-name
  27     target command command-button-quot
  28     '[ drop @ ] <button> toolbar-button-theme
  29     gesture gesture>tooltip >>tooltip ; inline
  30
  31 : <toolbar> ( target -- toolbar )
  32     horizontal <track>
  33         1 >>fill
  34         +baseline+ >>align
  35         { 5 5 } >>gap
  36         swap
  37         [ [ "toolbar" ] dip class-of get-command-at commands>> ]
  38         [ '[ [ _ ] 2dip <toolbar-button> f track-add ] ]
  39         bi assoc-each ;
  40
  41 : format-toolbar ( toolbar -- toolbar )
  42     { 5 0 } <border>
  43     toolbar-background <solid> >>interior
  44     { 1 0 } >>fill ;
  45
  46 : add-toolbar ( track -- track )
  47     dup <toolbar> format-toolbar f track-add ;