# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: colorlab.tcl,v 1.14 2006/01/28 19:16:59 jfontain Exp $


class colorLabels {

    proc colorLabels {this parentPath args} composite {[::new frame $parentPath] $args} {
        set ($this,labels) {}
        composite::complete $this
    }

    proc ~colorLabels {this} {
        eval ::delete $($this,labels)
     }

    proc options {this} {
        return [list\
            [list -colorheight 0 0]\
        ]
    }

    proc set-colorheight {this value} {
        if {$composite::($this,complete)} {
            error {option -colorheight cannot be set dynamically}
        }
    }

    proc new {this popupMenu args} {
        set label [eval ::new label $widget::($this,path) -colorheight $composite::($this,-colorheight) $args]
        if {[string length $popupMenu] > 0} {
            set command "set colorLabels::label::(clicked) $label; tk_popup $popupMenu %X %Y"
            foreach path [concat $widget::($label,path) [winfo children $widget::($label,path)]] {
                bind $path <ButtonPress-3> $command
            }
        }
        lappend ($this,labels) $label
        refresh $this
        return $label
    }

    proc delete {this label} {
        ldelete ($this,labels) $label
        ::delete $label
        refresh $this
    }

    proc refresh {this} {
        set path $widget::($this,path)
        catch {eval grid forget [grid slaves $path]}
        set row 0
        foreach label $($this,labels) {
            grid $widget::($label,path) -row $row -sticky new
            incr row
            grid rowconfigure $path $row -minsize 1             ;# insert a single pixel wide vertical separator area between labels
            incr row
        }
    }

}


class colorLabels {

    class label {

        proc label {this parentPath args} composite {[new frame $parentPath] $args} {
            set path $widget::($this,path)
            # use color label width and text padding identical to pie box labeler
            composite::manage $this [new frame $path -highlightbackground black -highlightthickness 1 -width 11] frame\
                [new label $path -font $font::(mediumNormal) -anchor nw -justify left -padx 2] label
            pack $composite::($this,frame,path) -side left
            pack $composite::($this,label,path) -fill both -expand 1
            composite::complete $this
        }

        proc ~label {this} {}

        proc options {this} {
            return [list\
                [list -background {} {}]\
                [list -color {} {}]\
                [list -colorheight 0 0]\
                [list -relief flat flat]\
                [list -text {} {}]\
            ]
        }

        proc set-background {this value} {
            if {[string length $value] == 0} {
                set value $widget::option(label,background)
            }
            $composite::($this,label,path) configure -background $value
        }

        proc set-color {this value} {
            $composite::($this,frame,path) configure -background $value
        }

        proc set-colorheight {this value} {
            update $this
        }

        proc set-relief {this value} {
             $composite::($this,label,path) configure -relief $value
        }

        proc set-text {this value} {
            $composite::($this,label,path) configure -text $value
            update $this
        }

        proc update {this} {
            set height $composite::($this,-colorheight)
            if {$height <= 0} {
                set height [winfo reqheight $composite::($this,label,path)]
            }
            $composite::($this,frame,path) configure -height $height
        }

        proc height {this} {       ;# valid anytime, otherwise an update is needed before frame container returns the correct height
            return [winfo reqheight $composite::($this,label,path)]
        }

    }

}
