# Copyright 2016-2025 Paul Obermeier (obermeier@tcl3d.org)
#
# Test program for the treectrl package.
# Modified version of treectrl demo "Column span"

package require Tk
package require treectrl

proc Init {T} {
    global Priv

    set width [font measure DemoFont "Span 1"]
    incr width 4

    # Configure the treectrl widget
    $T configure \
        -showbuttons no \
        -showlines no \
        -showroot no \
        -xscrollincrement $width

    # Create columns
    for {set i 0} {$i < 100} {incr i} {
        $T column create -itemjustify left -justify center -text "$i" \
            -tags C$i
    }

    # Create elements
    $T item state define mouseover

    for {set i 1} {$i <= 20} {incr i} {
        set color gray[expr {50 + $i * 2}]
        $T element create e$i rect -width [expr {$i * $width}] -height 20 \
            -fill [list white mouseover $color {}] -outlinewidth 1 \
            -outline gray70
        if {[winfo depth .] >= 16} {
            lassign [winfo rgb . $color] r g b
            # Can't use min() on 8.4
            set r [expr {int($r * 1.3)}]
            if {$r > 65535} { set r 65535 }
            set g [expr {int($g * 1.3)}]
            if {$g > 65535} { set g 65535 }
            set b [expr {int($b * 1.3)}]
            if {$b > 65535} { set b 65535 }

            set color2 [format "#%04x%04x%04x" $r $g $b]
            $T gradient create g$i -steps 16 \
                -stops [list [list 0.0 $color] [list 0.5 $color] [list 1.0 $color2]]
            $T element configure e$i -fill {white mouseover} \
                -fill [list white mouseover g$i {}]
        }
        $T element create t$i text -text "Span $i" -lines 1
    }

    # Create styles using the elements
    for {set i 1} {$i <= 20} {incr i} {
        set S [$T style create s$i]
        $T style elements $S [list e$i t$i]
        $T style layout $S e$i -detach yes -iexpand x -squeeze x
        $T style layout $S t$i -expand ns -padx 2 -squeeze x
    }

    # Create items and assign styles
    foreach I [$T item create -count 100 -parent root] {
        for {set i 0} {$i < [$T column count]} {} {
            set span [expr {int(rand() * 20) + 1}]
            if {$span > [$T column count] - $i} {
                set span [expr {[$T column count] - $i}]
            }
            $T item style set $I C$i s$span
            $T item span $I C$i $span
            incr i $span
        }
    }

    bind DemoSpan <Motion> {
        Motion %W %x %y
    }
    set Priv(prev) ""
    bindtags $T [list $T DemoSpan TreeCtrl [winfo toplevel $T] all]

    return
}

proc Motion {w x y} {
    global Priv
    set id [$w identify $x $y]
    if {$id eq ""} {
    } elseif {[lindex $id 0] eq "header"} {
    } elseif {[lindex $id 0] eq "item"} {
        set item [lindex $id 1]
        set column [lindex $id 3]
        set curr [list $item $column]
        if {$curr ne $Priv(prev)} {
            if {$Priv(prev) ne ""} {
                eval $w item state forcolumn $Priv(prev) !mouseover
            }
            $w item state forcolumn $item $column mouseover
            set Priv(prev) $curr
        }
        return
    }
    if {$Priv(prev) ne ""} {
        eval $w item state forcolumn $Priv(prev) !mouseover
        set Priv(prev) ""
    }
    return
}

treectrl .t -width 600 -height 300
ttk::label .msg -text \
    [format "Using treectrl %s on %s with %dbit Tcl %s and Tk %s" \
    [package version treectrl] $::tcl_platform(os) \
    [expr $::tcl_platform(pointerSize) * 8] \
    [info patchlevel] $::tk_patchLevel]

grid .t   -row 0 -column 0 -sticky news
grid .msg -row 1 -column 0 -sticky news
grid rowconfigure    . 0  -weight 1
grid columnconfigure . 0  -weight 1

Init .t

bind . <Escape> { exit }

if { [lindex $argv 0] eq "auto" } {
    update
    after 500
    exit
}
