##+##########################################################################
#
# tileTable.tcl -- Creates multi-column table using tile's treeview widget
# by Keith Vetter, March 21, 2008
# KPV Jun 03, 2008 - added sort arrows on column headers
#

package require Tk
package require tile

namespace eval ::TileTable {}

image create bitmap ::TileTable::arrow(0) -data {
    #define arrowUp_width 7
    #define arrowUp_height 4
    static char arrowUp_bits[] = {
        0x08, 0x1c, 0x3e, 0x7f
    };
}
image create bitmap ::TileTable::arrow(1) -data {
    #define arrowDown_width 7
    #define arrowDown_height 4
    static char arrowDown_bits[] = {
        0x7f, 0x3e, 0x1c, 0x08
    };
}
image create bitmap ::TileTable::arrowBlank -data {
    #define arrowBlank_width 7
    #define arrowBlank_height 4
    static char arrowBlank_bits[] = {
        0x00, 0x00, 0x00, 0x00
    };
}
##+##########################################################################
# 
# ::TileTable::Create -- Creates a new tile table widget
# 
proc ::TileTable::Create {w headers data} {
    
    ::ttk::treeview $w.tree -columns $headers -show headings \
        -yscroll "$w.vsb set" -xscroll "$w.hsb set" -selectmode browse
    scrollbar $w.vsb -orient vertical -command "$w.tree yview"
    scrollbar $w.hsb -orient horizontal -command "$w.tree xview"

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

    set font [::ttk::style lookup [$w.tree cget -style] -font]
    foreach col $headers {
        set name [string totitle $col]
        $w.tree heading $col -text $name -image ::TileTable::arrowBlank \
            -command [list ::TileTable::SortBy $w.tree $col 0] 
        $w.tree column $col -anchor c -width [font measure $font xxx$name]
    }

    set lnum -1
    foreach datum $data {
        $w.tree insert {} end -values $datum -tag tag[incr lnum]

        # Fix up column widths
        foreach col $headers value $datum {
            if {$col eq ""} break
            set len [font measure $font "$value  "]
            if {[$w.tree column $col -width] < $len} {
                $w.tree column $col -width $len
            }
        }
    }
    ::TileTable::BandTable $w.tree
}
##+##########################################################################
# 
# ::TileTable::SortBy -- Code to sort tree content when clicked on a header
# 
proc ::TileTable::SortBy {tree col direction} {
    # Build something we can sort
    set data {}
    foreach row [$tree children {}] {
        lappend data [list [$tree set $row $col] $row]
    }

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

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

    # Switch the heading so that it will sort in the opposite direction
    set cmd [list ::TileTable::SortBy $tree $col [expr {!$direction}]]
    $tree heading $col -command $cmd
    ::TileTable::BandTable $tree
    ::TileTable::ArrowHeadings $tree $col $direction
}
##+##########################################################################
# 
# ::TileTable::ArrowHeadings -- Puts in up/down arrows to show sorting
# 
proc ::TileTable::ArrowHeadings {tree sortCol dir} {
    set idx -1
    foreach col [$tree cget -columns] {
        incr idx
        set img ::TileTable::arrowBlank
        if {$col == $sortCol} {
            set img ::TileTable::arrow($dir)
        }
        $tree heading $idx -image $img
    }
}
##+##########################################################################
# 
# ::TileTable::BandTable -- Draws bands on our table
# 
proc ::TileTable::BandTable {tree} {
    array set colors {0 white 1 \#aaffff}

    set id 1
    foreach row [$tree children {}] {
        set id [expr {! $id}]
        set tag [$tree item $row -tag]
        $tree tag configure $tag -background $colors($id)
    }
}

###############
#
# Demo code
#
set headers {country capital currency}
set data {
    {Argentina          "Buenos Aires"          ARS}
    {Australia          Canberra                AUD}
    {Brazil             Brazilia                BRL}
    {Canada             Ottawa                  CAD}
    {China              Beijing                 CNY}
    {France             Paris                   EUR}
    {Germany            Berlin                  EUR}
    {India              "New Delhi"             INR}
    {Italy              Rome                    EUR}
    {Japan              Tokyo                   JPY}
    {Mexico             "Mexico City"           MXN}
    {Russia             Moscow                  RUB}
    {"South Africa"     Pretoria                ZAR}
    {"United Kingdom"   London                  GBP}
    {"United States"    "Washington, D.C."      USD}
}
toplevel .top
::TileTable::Create .top $headers $data
set tree .top.tree
return