factor/basis/ui/gadgets/toolbar/toolbar.factor

! Copyright (C) 2005, 2009 Slava Pestov, 2015 Nicolas Pénet.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs classes fry kernel locals ui.baseline-alignment ui.commands
ui.gadgets ui.gadgets.borders ui.gadgets.buttons
ui.gadgets.buttons.private ui.gadgets.packs ui.theme
ui.gadgets.tracks ui.pens ui.pens.solid ;
IN: ui.gadgets.toolbar

<PRIVATE

: <toolbar-button-pen> ( -- pen )
    toolbar-background <solid> dup
    toolbar-button-pressed-background <solid> dup dup
    <button-pen> ;

: toolbar-button-theme ( gadget -- gadget )
    dup gadget-child border-button-label-theme
    horizontal >>orientation
    <toolbar-button-pen> >>interior
    dup dup interior>> pen-pref-dim >>min-dim
    { 10 6 } >>size ; inline

PRIVATE>

:: <toolbar-button> ( target gesture command -- button )
    command command-name
    target command command-button-quot
    '[ drop @ ] <button> toolbar-button-theme
    gesture gesture>tooltip >>tooltip ; inline

: <toolbar> ( target -- toolbar )
    horizontal <track>
        1 >>fill
        +baseline+ >>align
        { 5 5 } >>gap
        swap
        [ [ "toolbar" ] dip class-of get-command-at commands>> ]
        [ '[ [ _ ] 2dip <toolbar-button> f track-add ] ]
        bi assoc-each ;

: format-toolbar ( toolbar -- toolbar )
    { 5 0 } <border>
    toolbar-background <solid> >>interior
    { 1 0 } >>fill ;

: add-toolbar ( track -- track )
    dup <toolbar> format-toolbar f track-add ;