# copyright (C) 1997-2001 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

set rcsId {$Id: blt2d.tcl,v 2.19 2001/02/04 11:30:52 jfontain Exp $}


class blt2DViewer {

    proc blt2DViewer {this parentPath path {labelsColorHeight 0}} viewer {} {
        pack propagate $parentPath 0           ;# so that -width and -height options acting on container frame in derived class work
        $path configure -cursor {} -plotpadx 2 -plotpady 2   ;# use minimum padding for extreme values, flat zero line to be visible
        $path yaxis configure -tickshadow {} -title {} -tickfont $font::(smallNormal)
        $path legend configure -hide 1                                ;# use custom labeler instead allowing coloring for thresholds
        set labels [new colorLabels $parentPath -colorheight $labelsColorHeight]
        viewer::setupDropSite $this $parentPath                               ;# allow dropping of data cells in whole viewer window
        set ($this,elements) {}
        set ($this,colorIndex) 0
        set ($this,path) $path                                                                                    ;# BLT viewer path
        set ($this,labels) $labels
    }

    proc ~blt2DViewer {this} {
        if {[info exists ($this,drag)]} {
            delete $($this,drag)
        }
        eval delete $($this,elements)                                                                    ;# delete existing elements
        if {[info exists ($this,selector)]} {
            delete $($this,selector)
        }
        delete $($this,labels)
    }

    proc supportedTypes {this} {
        return {integer real}
    }

    proc dragData {this format} {
        set legends [selector::selected $($this,selector)]
        set selectedElements {}
        foreach element $($this,elements) {
            if {[lsearch -exact $legends $($this,legend,$element)]<0} continue
            lappend selectedElements $element
        }
        switch $format {
            OBJECTS {
                if {[llength $selectedElements]>0} {
                    return $selectedElements                                            ;# return selected elements if there are any
                } elseif {[llength $($this,elements)]==0} {
                    return $this                                                   ;# return graph itself if it contains no elements
                } else {
                    return {}                                                                            ;# return nothing otherwise
                }
            }
            DATACELLS {
                return [cellsFromElements $this $selectedElements]
            }
        }
    }

    proc validateDrag {this legend x y} {
        if {($legend==0)&&([llength $($this,elements)]==0)} {
            return 1                                                                                   ;# allow drag of empty viewer
        } elseif {[lsearch -exact [selector::selected $($this,selector)] $legend]>=0} {
            return 1                                                                     ;# allow dragging from selected legend only
        } else {
            return 0
        }
    }

    proc monitorCell {this array row column} {
        set cell ${array}($row,$column)
        if {[lsearch -exact [cellsFromElements $this $($this,elements)] $cell]>=0} return                  ;# already charted, abort
        viewer::registerTrace $this $array
        set color [lindex $global::viewerColors $($this,colorIndex)]
        set element [newElement $this $($this,path) -color $color]
        set labels $($this,labels)
        if {[llength $($this,elements)]==0} {                                             ;# display labels on the first new element
            pack $widget::($labels,path) -side right -anchor n -padx 2 -pady 2 -before $($this,path)
        }
        set legend [colorLabels::new $labels -color $color]
        # keep track of element existence
        switched::configure $element -deletecommand "blt2DViewer::deletedElement $this $array $element"
        set ($this,colorIndex) [expr {($($this,colorIndex)+1)%[llength $global::viewerColors]}]             ;# circle through colors
        lappend ($this,elements) $element
        set ($this,label,$element) [viewer::label $array $row $column]
        set ($this,legend,$element) $legend
        set ($this,cell,$element) $cell
        if {$composite::($this,-draggable)} {                                       ;# selector may not exist if dragging disallowed
            set labelPath $composite::($legend,label,path)
            set drag [new dragSite -path $labelPath -validcommand "blt2DViewer::validateDrag $this $legend"]
            dragSite::provide $drag OBJECTS "blt2DViewer::dragData $this"
            dragSite::provide $drag DATACELLS "blt2DViewer::dragData $this"
            set ($this,drag,$element) $drag
            set selector $($this,selector)
            selector::add $selector $legend
            bind $labelPath <ButtonRelease-1> "selector::select $selector $legend"
            bind $labelPath <Control-ButtonRelease-1> "selector::toggle $selector $legend"
            bind $labelPath <Shift-ButtonRelease-1> "selector::extend $selector $legend"
        }
        if {[string first ? $($this,label,$element)]>=0} {                                         ;# label cannot be determined yet
            set ($this,relabel,$element) {}
        }
    }

    proc cells {this} {
        return [cellsFromElements $this $($this,elements)]
    }

    proc deletedElement {this array element} {
        viewer::unregisterTrace $this $array                                          ;# trace may no longer be needed on this array
        ldelete ($this,elements) $element
        if {$composite::($this,-draggable)} {
            delete $($this,drag,$element)
            selector::remove $($this,selector) $($this,legend,$element)
        }
        colorLabels::delete $($this,labels) $($this,legend,$element)
        if {[llength $($this,elements)]==0} {
            pack forget $widget::($($this,labels),path)                                   ;# no need to display an empty labels area
        }
        unset ($this,cell,$element) ($this,label,$element) ($this,legend,$element)
    }

    proc update {this array args} {                                                               ;# update display using cells data
        updateTimeDisplay $this [set seconds [clock seconds]]
        foreach element $($this,elements) {
            set cell $($this,cell,$element)
            if {[string first $array $cell]<0} continue                                  ;# check that cell belongs to updated array
            if {[catch {set value [set $cell]}]} {
                updateElement $this $element $seconds ?                                                     ;# data no longer exists
                composite::configure $($this,legend,$element) -text "$($this,label,$element): ?"
            } else {
                if {[info exists ($this,relabel,$element)]} {                              ;# if label is not yet defined, update it
                    viewer::parse $cell array row column type
                    set label [viewer::label $array $row $column]
                    set ($this,label,$element) $label
                    if {[string first ? $label]<0} {                                                 ;# label now completely defined
                        unset ($this,relabel,$element)
                    }
                }
                updateElement $this $element $seconds $value                           ;# may be ? if cell value is meant to be void
                composite::configure $($this,legend,$element) -text "$($this,label,$element): $value"
            }
        }
    }

    virtual proc newElement {this path args}                                       ;# let derived class create an element of its own

    virtual proc updateElement {this element seconds value}      ;# let derived class (such as graph, bar chart, ...) update element

    virtual proc updateTimeDisplay {this seconds} {}        ;# eventually let derived class (such as graph) update axis, for example

    proc cellsFromElements {this elements} {
        set cells {}
        foreach element $elements {
            lappend cells $($this,cell,$element)
        }
        return $cells
    }

    proc setLegendsState {this legends select} {
        if {$select} {
            set relief sunken
        } else {
            set relief flat
        }
        foreach legend $legends {
            composite::configure $legend -relief $relief
        }
    }

    proc allowDrag {this} {
        set ($this,drag) [new dragSite -path $($this,path) -validcommand "blt2DViewer::validateDrag $this 0"]    ;# for empty viewer
        dragSite::provide $($this,drag) OBJECTS "blt2DViewer::dragData $this"        ;# drag sites for legends are setup dynamically
        set ($this,selector) [new objectSelector -selectcommand "blt2DViewer::setLegendsState $this"]
    }

    proc setCellColor {this array row column color} {
        set cell ${array}($row,$column)
        foreach element $($this,elements) {
            if {[string equal $($this,cell,$element) $cell]} {
                composite::configure $($this,legend,$element) -background $color
                return                                                       ;# done since there cannot be duplicate monitored cells
            }
        }
    }

}
