##+##########################################################################
#
# button_listbox.tcl -- Multicolumn list box with column 0 a button
# image which generates <<ButtonListBoxPress>> when clicking on the
# button image.
# by Keith Vetter 2018-11-25
#
# Usage:
#   ::ttk::frame .f
#   set w [::ButtonListBox::Create .f -headers {Column1 Column2} -widths {10 20} -banding 0]
#   ::ButtonListBox::AddItem $w {column1_data column2_data}
#   bind $w <<ButtonListBoxPress>> {puts "Button Press for %d" }
# Note: the columns are sortable by clicking on the headers

namespace eval ::ButtonListBox {
    package require Tk
    variable CONFIG
    variable DEFAULT
    array set DEFAULT {
        headers {}
        widths {}
        banding 0
        buttonImage ::ButtonListBox::help
        color,0 white color,1 \#aaffff
    }
}

##+##########################################################################
#
# ::ButtonListBox::Create -- Creates and packs a new tile table widget
# into a parent frame.
#
#
proc ::ButtonListBox::Create {parent args} {
    variable CONFIG
    set w $parent.tree
    ::ButtonListBox::_ParseArgs $w $args

    ::ttk::treeview $w -columns $CONFIG($w,headers)  \
        -yscroll "$parent.vsb set" -xscroll "$parent.hsb set"
    scrollbar $parent.vsb -orient vertical -command "$w yview"
    scrollbar $parent.hsb -orient horizontal -command "$w xview"

    # Set up headings and widths
    set font [::ttk::style lookup [$w cget -style] -font]
    foreach col $CONFIG($w,headers) hSize $CONFIG($w,widths) {
        $w heading $col -text $col -anchor c \
            -image ::ButtonListBox::arrowBlank \
            -command [list ::ButtonListBox::_SortBy $w $col 0]
        if {[string is integer -strict $hSize]} {
            $w column $col -width $hSize
        } else {
            if {$hSize eq ""} { set hSize $col }
            set width [font measure $font [string cat $hSize $hSize]]
            $w column $col -width $width
        }
    }
    # Fix up heading #0 (over the tree section)
    # $w heading \#0 -command [list ::ButtonListBox::_SortBy $w \#0 1] \
    #     -image ::ButtonListBox::arrowBlank
    $w column \#0 -width 45 -stretch 0

    #bind $w <<TreeviewSelect>> {set ::id [%W selection]} ;# Debugging
    bind $w <1> [list ::ButtonListBox::_ButtonPress %W %x %y]

    grid $w $parent.vsb -sticky nsew
    grid $parent.hsb          -sticky nsew
    grid column $parent 0 -weight 1
    grid row    $parent 0 -weight 1

    return $w
}
proc ::ButtonListBox::_ParseArgs {widget myargs} {
    variable CONFIG
    variable DEFAULT
    foreach {key value} [array get DEFAULT] {
        set CONFIG($widget,$key) $value
    }

    foreach {key value} $myargs {
        set key2 [string range $key 1 end]
        if {[string index $key 0] ne "-" || $key2 ni [array names DEFAULT]} {
            error "unknown option $key"
        }
        if {$value eq {}} { error "missing value for $key" }
        set CONFIG($widget,$key2) $value
    }
}
proc ::ButtonListBox::AddItem {w itemData} {
    variable CONFIG
    set id [$w insert {} end -text "" -image $CONFIG($w,buttonImage) -values $itemData]
    $w item $id -tags $id ;# For banding
    ::ButtonListBox::_BandTable $w
    return $id
}
##+##########################################################################
#
# ::ButtonListBox::AddManyItems -- Fills in tree with given data
#
proc ::ButtonListBox::AddManyItems {w data} {
    variable CONFIG
    $w delete [$w child {}]
    foreach datum $data {
        set id [$w insert {} end -values $datum -text "" -image $CONFIG($w,buttonImage)]
        $w item $id -tags $id
    }
    ::ButtonListBox::_SortBy $w [$w heading #1 -text] 0
    ::ButtonListBox::_BandTable $w
}
##+##########################################################################
#
# ::ButtonListBox::Clear -- Deletes all items
#
proc ::ButtonListBox::Clear {w} {
    $w delete [$w child {}]
}
#
# Internal routines
#
image create bitmap ::ButtonListBox::arrow(0) -data {
    #define arrowUp_width 7
    #define arrowUp_height 4
    static char arrowUp_bits[] = {
        0x08, 0x1c, 0x3e, 0x7f
    };
}
image create bitmap ::ButtonListBox::arrow(1) -data {
    #define arrowDown_width 7
    #define arrowDown_height 4
    static char arrowDown_bits[] = {
        0x7f, 0x3e, 0x1c, 0x08
    };
}
image create bitmap ::ButtonListBox::arrowBlank -data {
    #define arrowBlank_width 7
    #define arrowBlank_height 4
    static char arrowBlank_bits[] = {
        0x00, 0x00, 0x00, 0x00
    };
}
image create photo ::ButtonListBox::help -data {
    iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAFo9M/3AAADFklEQVQ4jZ2TW2zTdRTHP/1ba2Ln1Clk
    7eJwHYQp1sVJnCgsxsRM2YiXESPIRnzxATNfyMwSw807vrhopgwFZSRcxrqmEDPBzEQaAkLCw5xkuAtz
    0nvZ6Lq2//77u/hAVo3zye/jyTnfc77ne45Naw2AAXB2JKxtCxHbile6tFEwsWmt+TwwqutWlhFNmtgB
    ZCFL27ZeEtGbmWLNAuwd302Grv0x5r52fYb7Skqq7Q01DrfffwWVz5EUtpHbghNlIw9UlL76UmMdga5W
    R5Hjg4F4uN5juCzLIq/snL4Y3djz9qM+A+DUxbDuGxh0OR2K4ckoV6em+DM03v/Ypm/GDIBLw9PIXJot
    2w+w4clKvuwJUP/QUqZ/Hz1cbHG3t71aSvGDEqJcK/Fpbvzb9wEW6fg37AAfB5ItdVV39Aszjd1u5+SF
    ZKR728NuAKPz8LRndRX9u3uGuLfUwfcXJrn/zqxrfcdgCMCIROKnD/qHSc/MEAiOs/P1Wo6eDNLatMIN
    YI9FIhWJ1Bx5M0X7y17WtnZTsCxudxi3nIpFY5+0NdciTZP5rEUmPYvOzzH402+3ptRa427YPf/RkV+0
    57l3df2WLv1h7zntXPlmi9b6b5l3PfLWDiUK7ygholrJ583JQxP/uYfPBtPVUqnNUqg2qWW5FIKCUFEp
    Ra8Q6sjerQ9O/DO/SLCnL9pSkOLQs16nMxS9wdnLccavJ5BS41rqZJ23gmWV93D0zFRGFsTW47safEWC
    9q+u7FxXW7ZnPp1ln+8yVjbHme6NC9cKKF7sGMAqCDY3PY5W4P/x113nvt70ngEQjsQ7nXbBvr7zZOZu
    kjNTrH1jP10nLjGXMQknMiyvLCWVTHDw+BAedwnJWLyzaHUsEg2lzcrl5UtKuTo7ixR5tJIc8wU55gui
    LAu0RKNwly9jJjNP6kYiVPyoZCzeuGOvP/zCmipea67D0AJhZlhV42ZVjRupLLTMsr5xDU3PeNnesT+c
    TaUaF7mw5InOFqXkF80bnnY9tdpDidMBQCpl8vP5UU75hyIo1Z4dO+Bb5ML/xV9NZK9JY/hkUAAAAABJ
    RU5ErkJggg==
}

##+##########################################################################
#
# ::ButtonListBox::_SortBy -- Code to sort tree content when clicked on a header
#
proc ::ButtonListBox::_SortBy {tree col direction} {
    # Build something we can sort
    # if {$col eq "\#0"} { set col [lindex [$tree cget -columns] 0] }
    set sortData [lmap row [$tree children {}] {list [$tree set $row $col] $row}]

    set dir [expr {$direction ? "-decreasing" : "-increasing"}]

    # Now reshuffle the rows into the sorted order
    set r -1
    foreach rinfo [lsort -dictionary -index 0 $dir $sortData] {
        $tree move [lindex $rinfo 1] {} [incr r]
    }

    # Switch the heading command so that it will sort in the opposite direction
    set cmd [list ::ButtonListBox::_SortBy $tree $col [expr {!$direction}]]
    $tree heading $col -command $cmd
    # if {$col eq [lindex [$tree cget -columns] 0]} {
    #     set cmd [list ::ButtonListBox::_SortBy $tree #0 [expr {!$direction}]]
    #     $tree heading #0 -command $cmd
    # }
    ::ButtonListBox::_BandTable $tree
    ::ButtonListBox::_ArrowHeadings $tree $col $direction
}
##+##########################################################################
#
# ::ButtonListBox::_ArrowHeadings -- Puts in up/down arrows to show sorting
#
proc ::ButtonListBox::_ArrowHeadings {tree sortCol dir} {
    set idx -1
    foreach col [$tree cget -columns] {
        incr idx
        set img ::ButtonListBox::arrowBlank
        if {$col == $sortCol} {
            set img ::ButtonListBox::arrow($dir)
        }
        $tree heading $idx -image $img
    }
    set img ::ButtonListBox::arrowBlank
    if {$sortCol eq "\#0"} {
        set img ::ButtonListBox::arrow($dir)
    }
    $tree heading "\#0" -image $img
}
##+##########################################################################
#
# ::ButtonListBox::_BandTable -- Draws bands on our table
#
proc ::ButtonListBox::_BandTable {tree} {
    variable CONFIG
    if {! $CONFIG($tree,banding)} return

    set id 0
    foreach row [$tree children {}] {
        set id [expr {! $id}]
        set tag [$tree item $row -tag]
        $tree tag configure $tag -background $CONFIG($tree,color,$id)
    }
}
##+##########################################################################
#
# ::ButtonListBox::_ButtonPress -- handles mouse click which can
#  toggle checkbutton, control selection or resize headings.
#
proc ::ButtonListBox::_ButtonPress {w x y} {
    lassign [$w identify $x $y] what id detail

    # Disable resizing heading #0
    if {$what eq "separator" && $id eq "\#0"} {
        return -code break
    }
    if {$what eq "item"} {
        set column1 [$w heading #1 -text]
        event generate $w <<ButtonListBoxPress>> -data [$w set $id $column1]
        return -code break
    }
}

################################################################

if { [file tail [info script]] == [file tail $::argv0] } {
    # Demo code: opens two toplevels both with a ButtonListBox

    proc Demo {} {
        set headers {Id Surface Highway Name}
        set hwidths {100 70 70 150}
        set data {
            {38449949 dirt path {Loop Trail}}
            {38449969 dirt path {Bear Gulch Trail}}
            {38450161 dirt path {Bear Gulch Trail}}
            {38904103 dirt path {Sierra Morena Trail}}
            {38905166 dirt path {Tafoni Trail}}
            {42054541 dirt track {Bear Gulch Trail}}
            {42054542 dirt track {Bear Gulch Trail}}
            {234792351 dirt path {Alambique Trail}}
            {234792352 dirt path {Madrone Trail}}
            {234897703 dirt path {Madrone Trail}}
            {235211301 dirt path {Bear Gulch Trail}}
            {235557435 dirt track {Bear Gulch Trail}}
            {235557436 dirt path {Loop Trail}}
            {235557440 dirt path {Redwood Trail}}
            {235557444 dirt track {}}
            {235557446 dirt track {}}
            {249015506 dirt path {Trail11 Bypass}}
            {249361145 dirt path {}}
            {249361146 dirt path {}}
            {249361147 dirt path {}}
            {327010065 dirt path {Molder Trail}}
            {512377049 dirt path {El Corte de Madera Creek Trail}}
        }
        set parent .top1
        destroy $parent
        toplevel $parent
        wm title $parent "Teague Hill Trails"
        set w [ButtonListBox::Create $parent -headers $headers -widths $hwidths -banding 1]
        set tree $w
        foreach datum $data {
            ::ButtonListBox::AddItem $w $datum
        }
        # ::ButtonListBox::AddManyItems $w $data
        bind $tree <<ButtonListBoxPress>> {puts "Button Press for %d" }
        $w config -height 20


        set headers {Player "Home Runs" RBI  BA Slug}
        set hwidths {200 70 70 70 70}
        set data {
            {"Barry Bonds" 762 1996 .298 .606}
            {"Hank Aaron" 755 2297 .305 .554}
            {"Babe Ruth" 714 2214 .342 .689}
            {"Alex Rodriguez" 696 2086 .294 .550}
            {"Willie Mays" 660 1903 .301 .557}
            {"Albert Pujols" 641 2004 .301 .552}
            {"Ken Griffey" 630 1836 .296 .537}
            {"Jim Thome" 612 1699 .276 .554}
            {"Sammy Sosa" 609 1667 .273 .533}
            {"Frank Robinson" 586 1812 .294 .537}
            {"Mark McGwire" 583 1414 .263 .588}
            {"Harmon Killebrew" 573 1584 .256 .508}
            {"Rafael Palmeiro" 569 1835 .288 .514}
            {"Reggie Jackson" 563 1702 .262 .490}
            {"Manny Ramirez" 555 1831 .312 .585}
            {"Mike Schmidt" 548 1595 .267 .527}
            {"David Ortiz" 541 1768 .286 .551}
            {"Mickey Mantle" 536 1509 .298 .556}
            {"Jimmie Foxx" 534 1922 .325 .609}
            {"Willie McCovey" 521 1555 .270 .514}
            {"Frank Thomas" 521 1704 .301 .554}
            {"Ted Williams" 521 1839 .344 .633}
            {"Ernie Banks" 512 1636 .274 .499}
            {"Eddie Mathews" 512 1453 .271 .509}
            {"Mel Ott" 511 1860 .304 .533}
            {"Gary Sheffield" 509 1676 .291 .513}
            {"Eddie Murray" 504 1917 .287 .476}
        }

        set parent .top2
        destroy $parent
        toplevel $parent
        wm title $parent "Baseball 500 Home Run Club"
        set w [ButtonListBox::Create $parent -headers $headers -widths $hwidths -banding 0]
        set tree $w
        foreach datum $data {
            ::ButtonListBox::AddItem $w $datum
        }
        # ::ButtonListBox::AddManyItems $w $data
        bind $tree <<ButtonListBoxPress>> {puts "Button Press for %d" }
        $w config -height 20
    }

    Demo
}

return