# 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: threshman.tcl,v 1.11 2006/09/29 09:31:59 jfontain Exp $


# a cell thresholds manager for the page and message viewer

class thresholdsManager {

    set (number) 0                                                                       ;# unique: the higher the most recent entry

    proc thresholdsManager {this} {}

    proc ~thresholdsManager {this} {
        variable ${this}number
        variable ${this}text

        catch {unset ${this}number ${this}text}
    }

    proc condition {this cell color level text} {                                                   ;# a threshold condition occured
        variable ${this}number
        variable ${this}text

        if {[string length $color] == 0} {set color $viewer::(background)}              ;# use viewer background in absence of color
        foreach {red green blue} [winfo rgb . $color] {}
        set color #[format %04X $red][format %04X $green][format %04X $blue]                                  ;# use a unique format
        set key [list $cell $color $level]                                           ;# a cell may have several thresholds set on it
        if {[string length $text] == 0} {                                                                ;# threshold is being reset
            catch {unset ${this}number($key) ${this}text($key)}
        } else {                                                                                ;# new or update threshold condition
            set ${this}number($key) [incr (number)]
            set ${this}text($key) $text
        }
    }

    # return the colors and texts, most important and most recent first, in the form of 2 lists without duplicates
    proc colorsAndTexts {this} {
        variable ${this}number
        variable ${this}text

        set texts {}
        set list {}
        foreach {key number} [array get ${this}number] {
            foreach {cell color level} $key {}
            # was: lappend list [list $level $key $color $number]                              ;# use level in integer form instead:
            lappend list [list $thresholds::threshold::level($level) $key $color $number]
        }
        # sort by importance level, most important first (lowest in integer form), and only keep maximum importance:
        # was: foreach list [lsort -command thresholds::threshold::compareLevels -index 0 -decreasing $list]
        foreach list [lsort -integer -index 0 $list] {      ;# use integer levels for much improved performance when many thresholds
            foreach {level key color number} $list {}
            if {![info exists minimum]} {set minimum $level}
            # was: if {[thresholds::threshold::compareLevels $level $minimum] < 0} break
            if {$level > $minimum} break                                                  ;# only keep maximum importance thresholds
            set colorNumber($color) $number                                                                   ;# suppress duplicates
            set textNumber([set ${this}text($key)]) $number
        }
        set list {}
        foreach {color number} [array get colorNumber] {lappend list [list $color $number]}
        set colors {}
        foreach list [lsort -decreasing -integer -index end $list] {lappend colors [lindex $list 0]}            ;# most recent first
        set list {}
        foreach {text number} [array get textNumber] {lappend list [list $text $number]}
        set texts {}
        foreach list [lsort -decreasing -integer -index end $list] {lappend texts [lindex $list 0]}             ;# most recent first
        return [list $colors $texts]
    }

}
