# 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: viewer.tcl,v 2.87 2006/10/29 17:16:50 jfontain Exp $


class viewer {                                                                             ;# handle viewers related functionalities
    # viewers do not derive from a common interface class but rather support a common set a options through the composite class

    set (list) {}
if {$global::withGUI} { ;# >8
    set (background) $widget::option(label,background)              ;# so that all viewers have the same background on all platforms
    set (rightRedArrow) [image create photo -data {R0lGODlhBQAJAIAAAP8AAP8AACH5BAEKAAEALAAAAAAFAAkAAAIMRB5gp9v2YlJsJRQKADs=}]
    set (rightDarkGrayArrow) [image create photo -data {R0lGODlhBQAJAIAAAKCgoP///yH5BAEKAAEALAAAAAAFAAkAAAIMRB5gp9v2YlJsJRQKADs=}]
    set (limitAreaWidth) 40
    set (limitAreaHeight) 20
} ;# >8

    proc viewer {this} {
        lappend (list) $this
    }

    proc ~viewer {this} {
        dataTrace::unregister $this                                                                       ;# remove all array traces
        if {[info exists ($this,drop)]} {
            delete $($this,drop)
        }
        ldelete (list) $this
if {$global::withGUI} { ;# >8
        pages::monitorActiveCells                ;# refresh pages monitored cells since cells with thresholds could have disappeared
        thresholdLabel::monitorActiveCells                                               ;# refresh global thresholds viewer as well
} ;# >8
    }

if {$global::withGUI} { ;# >8

    proc new {class} {                                                                 ;# wrapper for proper initialization per type
        switch $class {
            ::canvas::iconic {
                set name [canvas::iconic::chooseFile]
                if {$name eq ""} {
                    return 0                                                                                             ;# canceled
                }
                set viewer [::new canvas::iconic $global::canvas -draggable 1 -static $global::static -file $name]
            }
            ::currentValueTable {                                 ;# needs to know mode (real time or database) at construction time
                set viewer [::new currentValueTable $global::canvas $global::pollTime -draggable 1 -interval $global::pollTime]
            }
            ::dataGraph - ::dataStackedGraph {
                set viewer [::new $class $global::canvas\
                    -labelsposition $global::graphLabelsPosition -draggable 1 -interval $global::pollTime\
                ]
            }
            ::dataSideBarChart - ::dataStackedBarChart - ::dataOverlapBarChart {
                set viewer [::new $class $global::canvas -labelsposition $global::graphLabelsPosition -draggable 1]
            }
            ::data2DPieChart - ::data3DPieChart - ::freeText {
                set viewer [::new $class $global::canvas -draggable 1]
            }
            ::summaryTable {
                set viewer [::new summaryTable $global::canvas -draggable 1 -interval $global::pollTime]
            }
            ::predictor {
                set viewer [::new predictor $global::canvas -draggable 1]
            }
            default {
                error "cannot handle new $class"
            }
        }
        return $viewer
    }

} ;# >8

    virtual proc supportedTypes {this}

    proc view {this cells} {                                                                  ;# cells is a list of data array cells
        set list {}
        foreach cell $cells {
            unset -nocomplain type
            parse $cell array row column type
            # no corresponding module (happens when loading a viewer from a save file without the corresponding module)
            if {![info exists $array] || ![info exists type]} continue
            if {[lsearch -exact [supportedTypes $this] $type] < 0} {
if {$global::withGUI} { ;# >8
                wrongTypeMessage $type
} ;# >8
                return 0                                                                                     ;# give up on all cells
            }
            set update($array) {}
            lappend list $array $row $column
        }
        # warning: it is important to monitor cell in the original order as some viewers, such as freetext, expect it:
        foreach {array row column} $list {
            monitorCell $this $array $row $column
if {$global::withGUI} { ;# >8
            set cell ${array}($row,$column)
            set data [thresholds::cellData $array $row $column]
            foreach {color level summary} $data {                                        ;# possibly initialize cell thresholds data
                thresholdCondition $this $array $row $column $color $level $summary
            }
            setCellColor $this $cell [cellThresholdColorFromData $cell $data]
} ;# >8
        }
        foreach array [array names update] {                                        ;# update viewer with current values immediately
            update $this $array
        }
        return 1                                                                                       ;# cells accepted for viewing
    }

    virtual proc monitorCell {this array row column}

    # public procedure. note that type will be set only if the cell array actually exists when this procedure is invoked
    proc parse {dataCell arrayName rowName columnName typeName} {
        upvar 1 $arrayName cellArray $rowName cellRow $columnName cellColumn $typeName cellType

        if {([scan $dataCell {%[^(](%lu,%u)} array row column] != 3) || ($column < 0)} {
            error "\"$dataCell\" is not a valid array cell"
        }
        set cellArray $array; set cellRow $row; set cellColumn $column
        catch {set cellType [modules::type $array $row $column]}
    }

    proc updateInterval {value} {                                             ;# static procedure for updating all viewers intervals
        foreach viewer $(list) {
            catch {composite::configure $viewer -interval $value}                 ;# some viewers do not support the interval option
        }
    }

    # Derive a label from cell using the tabular data index columns (array name must be qualified) and return it along with the
    # incomplete status, meaning that the label could not be fully determined, as can happen, for example, when the data cell no
    # longer exists.
    proc label {array row column {identify {}}} {                                                     ;# allow forcing module header
        set label {}
        if {$identify eq ""} {
            set identify $global::cellsLabelModuleHeader                                                     ;# use default behavior
        }
        if {$identify} {
            set identifier [modules::identifier $array]                                         ;# see if array needs identification
            if {$identifier ne ""} {                             ;# data comes from a module array (could come from a summary table)
                regsub {<0>$} $identifier {} identifier            ;# remove trailing namespace index for first instance of a module
                set label "$identifier: "
            }
        }
        if {[catch {set ${array}(indexColumns)} columns]} {     ;# no index columns (note: they are used to generate the cell label)
            set columns 0                                                                 ;# use first column as single index column
        }
        foreach index $columns {                                                                      ;# use index columns for label
            if {[catch {set ${array}($row,$index)} value]} {
                append label {? }               ;# cell may no longer exist if originating from a save file, give user some feedback
            } elseif {$value ne ""} {                                                                          ;# ignore empty cells
                append label "$value "
            }
        }
        append label [set ${array}($column,label)]
        # consider the label incomplete if it contains any question mark characters, reflecting the presence of missing data rows,
        # void numeric data cells, or existing cells from a summary table pointing to void data. note that is valid data contains
        # question mark characters, then the incomplete status is incorrect, which should be rare and have only a minor impact on
        # performance (it causes the corresponding data labels to be updated at each poll in data viewers).
        return [list $label [string match {*\?*} $label]]
    }

    virtual proc update {this array}                                                              ;# update display using cells data

    proc registerTrace {this array {last 0}} {
        dataTrace::register $this $array "viewer::update $this $array" $last
    }

    proc unregisterTrace {this array} {
        dataTrace::unregister $this $array
    }

    # note: cells must always been returned in the same order (dictionary sorting suggested) so that record layer does not detect
    # erroneous changes, incorrectly requiring the user to save dashboard when exiting application
    virtual proc cells {this}

if {$global::withGUI} { ;# >8

    virtual proc initializationConfiguration {this} { ;# configuration with switch / value option pairs for initialization from file
        return {}
    }

    proc setupDropSite {this path} {                                 ;# allow dropping of data cells, viewer mutation or kill action
        set ($this,drop) [::new dropSite -path $path -formats {DATACELLS VIEWER KILL} -command "viewer::handleDrop $this"]
    }

    proc handleDrop {this} {
        if {![catch {set data $dragSite::data(DATACELLS)}]} {
            view $this $data
        } elseif {![catch {set data $dragSite::data(VIEWER)}]} {
            mutate $this $data
        } elseif {[info exists dragSite::data(KILL)]} {
            delete $this                                                                                           ;# self destructs
            updateViewObjectsMenu
        }
    }

    proc mutate {this class} {
        if {$class eq [classof $this]} return                                        ;# no need to create a viewer of the same class
        set viewer [viewer::new $class]
        if {$viewer == 0} return
        # only attempt to view cells that still exist (for example, some cells may come from a vanished summary table)
        set cells {}
        set count 0
        foreach cell [cells $this] {
            if {[info exists $cell]} {
                lappend cells $cell
            }
            incr count
        }
        if {[llength $cells] > 0} {
            view $viewer $cells
        }
        if {[llength $cells] < $count} {                                                                 ;# warn user when necessary
            lifoLabel::flash $global::messenger [mc {some data cells no longer exist}]
        }
        if {[manageable $this]} {
            foreach {x y width height} [canvasWindowManager::getGeometry $global::windowManager $widget::($this,path)] {}
            set level [canvasWindowManager::getStackLevel $global::windowManager $widget::($this,path)]
        } else {                                                                                          ;# must be a canvas viewer
            set x [composite::cget $this -x]; set y [composite::cget $this -y]                            ;# a viewer is a composite
            set width {}; set height {}; set level {}
        }
        delete $this                                                                                       ;# delete existing viewer
        if {[manageable $viewer]} {
            # viewer is as destroyable as previously deleted viewer
            manageViewer $viewer 1 -static $global::static -setx $x -sety $y -setwidth $width -setheight $height -level $level\
                -dragobject $viewer
        }
        if {$class eq "::canvas::iconic"} {
            composite::configure $viewer -x $x -y $y
        }
        updateViewObjectsMenu
    }

    proc cellThresholdColorFromData {cell data} {
        set manager [::new thresholdsManager]
        foreach {color level summary} $data {
            thresholdsManager::condition $manager $cell $color $level $summary
        }
        set color [lindex [lindex [thresholdsManager::colorsAndTexts $manager] 0] 0]
        delete $manager
        return $color
    }

    proc cellThresholdColor {array row column} {
        return [cellThresholdColorFromData ${array}($row,$column) [thresholds::cellData $array $row $column]]
    }

    proc cellThresholdCondition {array row column color level summary} {
        set topColor [cellThresholdColor $array $row $column]
        foreach viewer $(list) {
            thresholdCondition $viewer $array $row $column $color $level $summary
            setCellColor $viewer ${array}($row,$column) $topColor
        }
    }

    # viewers should implement at most one of the following procedures:
    # note: viewers using a dataTable object might need none, as ::cellThresholdCondition{} may be enough to do the job

    # latest threshold condition (reset if summary is not defined (empty)):
    virtual proc thresholdCondition {this array row column color level summary} {}
    # gives the color of the most important and recent threshold (reset if color is empty):
    virtual proc setCellColor {this cell color} {}

    virtual proc manageable {this} {return 1}                         ;# whether it should be managed by the internal window manager

    proc monitoring {cell} {                                                                            ;# viewers monitoring a cell
        set viewers {}
        foreach viewer $(list) {
            if {[monitored $viewer $cell]} {
                lappend viewers $viewer
            }
        }
        return $viewers
    }

    virtual proc monitored {this cell}

    # If this is the first time a color is requested for that cell, give a new color, else give the color already used by that cell,
    # so that a cell always has the same color in all its container viewers, until it is no longer monitored by any viewer.
    # When the cell is no longer displayed by the viewer, the color must be returned using returnDisplayColor{}, so that the color
    # can be made available for other cells.
    proc getDisplayColor {cell} {
        variable colorIndex                                          ;# cell to color index mapping (index in global viewers colors)
        variable usageCount                                                   ;# number of times a cell is displayed using its color

        if {![info exists colorIndex($cell)]} {                           ;# return a new color, if possible, not used by any viewer
            set colors [llength $global::viewerColors]
            for {set index 0} {$index < $colors} {incr index} {
                set count($index) 0
            }
            foreach {name index} [array get colorIndex] {                                                        ;# scan used colors
                incr count($index)
            }
            set color 0
            set minimum $global::32BitIntegerMaximum
            for {set index 0} {$index < $colors} {incr index} {                                    ;# find the next least used color
                if {$count($index) < $minimum} {
                    set minimum $count($index)
                    set color $index
                }
            }
            set colorIndex($cell) $color
            set usageCount($cell) 0
        }
        incr usageCount($cell)
        return [lindex $global::viewerColors $colorIndex($cell)]
    }
    proc returnDisplayColor {cell} {                                 ;# use to return display color obtained using getDisplayColor{}
        variable colorIndex
        variable usageCount

        if {[catch {incr usageCount($cell) -1}]} return                                            ;# cell color came from save file
        if {$usageCount($cell) == 0} {                                                          ;# cell no longer displayed in color
            unset colorIndex($cell) usageCount($cell)
        }
    }

    proc limitEntry {this path anchor x y option name font command yCommand type} {                  ;# note: Y command may be empty
        set entry [entry $path.maximum -borderwidth 0 -highlightthickness 0 -width 10 -font $font]
        switch $type {
            float {setupEntryValidation $entry {{checkFloatingPoint %P}}; set type double}
            signed {setupEntryValidation $entry {{check32BitSignedInteger %P}}; set type integer}
            unsigned {setupEntryValidation $entry {{check31BitUnsignedInteger %P}}; set type integer}
            default {error "invalid type: $type"}
        }
        lifoLabel::push $global::messenger\
            [format [mc {enter %s value (empty for automatic scale, Return to valid, Escape to abort)}] $name]
        # when Return or Enter is pressed, pass new value (if valid type) as limit, else if Escape is pressed, abort:
        foreach key {<KP_Enter> <Return>} {
            bind $entry $key "
                if {\[string is $type \[%W get\]\]} {
                    $command \[%W get\]
                    destroy %W
                    lifoLabel::pop $global::messenger
                }
            "
        }
        bind $entry <Escape> "destroy %W; lifoLabel::pop $global::messenger"
        $entry insert 0 [composite::cget $this $option]
        $entry selection range 0 end                                  ;# initially select all characters, which is a common behavior
        if {$yCommand ne ""} {set y [uplevel #0 $yCommand]}                                                ;# allow dynamic ordinate
        place $entry -anchor $anchor -x $x -y $y
        focus $entry
        ::update idletasks                                                                     ;# so entry is visible and grab works
        grab $entry
    }

    proc wrongTypeMessage {type} {
        lifoLabel::flash $global::messenger [format [mc {cannot display data of type %s}] $type]
        bell
        if {![info exists (wrongTypeDrop)]} {
            set (wrongTypeDrop) {}
            tk_messageBox -title {moodss: drag and drop} -type ok -icon info -message [format [mc\
                {Some viewers only accept a limited set of data types (if this case, this viewer cannot display data of type %s)}\
            ] $type]
        }
    }

    proc createColorsMenu {parentPath command} {
        set menu [menu $parentPath.colorsMenu -tearoff 0]
        set spaces {   }                            ;### Tk bug: use 6 spaces for windows because otherwise labels look too thin ###
        if {$::tcl_platform(platform) eq "windows"} {set spaces {      }}
        set rows 0
        set index 0
        foreach color $global::viewerColors {
            $menu add command -label $spaces -background $color -activebackground $color
            regsub -all %c $command $color string                                                            ;# use color in command
            $menu entryconfigure $index -hidemargin 1 -command $string
            if {$rows >= 3} {
                $menu entryconfigure $index -columnbreak 1
                set rows 0
            }
            incr rows
            incr index
        }
        return $menu
    }

    virtual proc updateLabels {this} {}

} ;# >8

    proc numericType {type} {
        switch $type {
            integer - real {return 1}
            default {return 0}
        }
    }

    virtual proc saved {this} {return 1}                               ;# whether it is supposed to be saved in a configuration file

}
