# 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: sumtable.tcl,v 2.19 2001/01/12 21:45:31 jfontain Exp $}


class summaryTable {

    set (nextDataIndex) 0                            ;# used when data array index is not specified as an option when creating table

    proc summaryTable {this parentPath args} composite {[new frame $parentPath] $args} viewer {} {
        composite::complete $this

        variable $($this,dataName)                                                   ;# after completion, data array name is defined

        array set $($this,dataName) {
            updates 0
            0,label data 0,type ascii 0,message {data cell description}
            1,label current 1,type real 1,message {current value}
            2,label average 2,type real 2,message {average value since viewer creation}
            3,label minimum 3,type real 3,message {minimum value since viewer creation}
            4,label maximum 4,type real 4,message {maximum value since viewer creation}
            sort {0 increasing}
            indexColumns 0
        }
        set ($this,nextRow) 0

        # wait till after completion before creating table since some options are not dynamically settable
        # use column widths which may have been set at this summary table construction time when data table did not exist yet
        set table [new dataTable $widget::($this,path)\
            -data summaryTable::$($this,dataName) -draggable $composite::($this,-draggable)\
            -titlefont $composite::($this,-titlefont) -columnwidths $composite::($this,-columnwidths)\
        ]
        ### hack: drag and drop code should be separated from dataTable which should provide a selected member procedure ###
        # allow dropping of data cells ### use same path as drag path to avoid drops in table from table ###
        viewer::setupDropSite $this $dataTable::($table,tablePath)
        if {$composite::($this,-draggable)} {
            # extend data table drag capabilities ### hack ### also eventually allow row selection only instead of cells ###
            dragSite::provide $dataTable::($table,drag) OBJECTS "summaryTable::dragData $this"
            # intercept original data cells dragging
            dragSite::provide $dataTable::($table,drag) DATACELLS "summaryTable::dragData $this"
        }
        pack $widget::($table,path) -fill both -expand 1
        set ($this,dataTable) $table
    }

    proc ~summaryTable {this} {
        variable [set dataName $($this,dataName)]
        variable ${this}cellRow

        foreach {name wish} [array get {} $this,rowLastWish,*] {                   ;# delete remaining last wishes, one for each row
            delete $wish                                                                                ;# which in turn deletes row
        }
        delete $($this,dataTable)
        catch {unset ${this}cellRow}
        incr ${dataName}(updates)                                        ;# so related viewers can eventually show disappeared cells
        unset $dataName
        if {[string length $composite::($this,-deletecommand)]>0} {
            uplevel #0 $composite::($this,-deletecommand)                                   ;# always invoke command at global level
        }
    }

    proc iconData {} {
        return {
            R0lGODdhJAAkAOMAAPj8+Hh4eAAAAHh8eNjc2ICEgIiQiJCYkKCkoKisqLi8uMDEwMjQyNDY0ODk4Ojs6CwAAAAAJAAkAAAE/hDIKQO99s5cNeUaiH2aYJ5o
            qqZbFQyDQBDDbN/1jRMmDIMymm43nNUEg84lmCs2h8ckQARA+q7YLBapDLxiAGF4TAjXyOSj9UeRAZLl+BiOLie505JZzj/z93hUa1qEWYEuMExFRotCPT5A
            jItPOlFKbZJOjZZ5S4WfW1IZXol7daZ/joNSEm50f69od6J6Yql+dZyCoLwxtFNfipObPKuYQsPDh0uZUMTLbb2gyyy2uamAKleup3bdb1VZBeMFAqjX3VHk
            4wbtBqvSoe7tB/UHwprKA/b1CP4I+Jzp++cvgcEEASs9G3DQoIKHClZInNgD4sMFGDHGA5URI4OPIyBDihxJsmSDkyhTqlzJsqWDlzBjypxJs+aDmzhz6tzJ
            s2cEADs=
        }
    }

    proc options {this} {
        # data index must be forced so that initialization always occur
        return [list\
            [list -columnwidths {} {}]\
            [list -dataindex {}]\
            [list -deletecommand {} {}]\
            [list -draggable 0 0]\
            [list -titlefont $font::(mediumBold) $font::(mediumBold)]\
        ]
    }

    proc set-columnwidths {this value} {
        # data table may not have been built if option was passed at construction time
        if {![info exists ($this,dataTable)]} return
        composite::configure $($this,dataTable) -columnwidths $value
    }

    # data array name index must be specifiable so that data viewers depending on summary table data array name (through their
    # monitored cells) do not fail accessing that data (required when generating viewers from save file)
    proc set-dataindex {this value} {
        if {$composite::($this,complete)} {
            error {option -dataindex cannot be set dynamically}
        }
        if {[string length $value]>0} {                             ;# specified, else use internally generated next available index
            if {$value<$(nextDataIndex)} {
                error "specified data index ($value) is lower than internal summary table index"
            }
            set (nextDataIndex) $value
        }
        set ($this,dataName) $(nextDataIndex)data                                             ;# generate unique name based on index
        incr (nextDataIndex)
    }

    proc set-deletecommand {this value} {}

    foreach option {-draggable -titlefont} {
        proc set$option {this value} "
            if {\$composite::(\$this,complete)} {
                error {option $option cannot be set dynamically}
            }
        "
    }

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

    proc monitorCell {this array row column} {
        variable [set dataName $($this,dataName)]
        variable ${this}cellRow

        set cell ${array}($row,$column)
        if {[info exists ${this}cellRow($cell)]} return                                                  ;# already displayed, abort
        viewer::registerTrace $this $array
        set label [viewer::label $array $row $column]
        set row $($this,nextRow)                                                                     ;# next row for this data table
        set ${dataName}($row,0) $label
        if {[catch {set $cell} current]} {                                                                    ;# cell does not exist
            set ${dataName}($row,1) ?
        } else {
            set ${dataName}($row,1) $current
        }
        array set $dataName [list $row,2 ? $row,3 ? $row,4 ?]                             ;# initialize average, minimum and maximum
        set ${dataName}($row,updates) 0
        set ${dataName}($row,sum) 0.0
        set ${this}cellRow($cell) $row                                                                          ;# remember cell row
        # setup action when a row is deleted through a cell drop in eraser site
        set ($this,rowLastWish,$row) [new lastWish "summaryTable::deleteRow $this $cell"]
        incr ($this,nextRow)
        if {[string first ? $label]>=0} {                                                          ;# label cannot be determined yet
            set ($this,relabel,$row) {}
        }
        set ${dataName}(updates) 0                      ;# let data table update itself (so colors can be set on cells, for example)
    }

    proc update {this array args} {
        variable [set dataName $($this,dataName)]
        variable ${this}cellRow

        foreach {cell row} [array get ${this}cellRow] {
            if {[string first $array $cell]<0} continue                ;# no need to update if cell does not belong to updated array
            if {[catch {set $cell} current]||[string equal $current ?]} {                          ;# cell does not exist or is void
                set ${dataName}($row,1) ?                               ;# do not touch other columns as their content remains valid
            } else {                                                                                                ;# data is valid
                if {[info exists ($this,relabel,$row)]} {                                  ;# if label is not yet defined, update it
                    viewer::parse $cell array cellRow cellColumn type
                    set label [viewer::label $array $cellRow $cellColumn]
                    set ${dataName}($row,0) $label
                    if {[string first ? $label]<0} {                                                 ;# label now completely defined
                        unset ($this,relabel,$row)
                    }
                }
                set ${dataName}($row,1) $current
                set sum [expr {[set ${dataName}($row,sum)]+$current}]
                set ${dataName}($row,2) [format %.2f [expr {$sum/[incr ${dataName}($row,updates)]}]]
                set value [set ${dataName}($row,3)]
                if {[string equal $value ?]||($current<$value)} {                                   ;# eventually initialize minimum
                    set ${dataName}($row,3) $current
                }
                set value [set ${dataName}($row,4)]
                if {[string equal $value ?]||($current>$value)} {                                   ;# eventually initialize maximum
                    set ${dataName}($row,4) $current
                }
                set ${dataName}($row,sum) $sum
            }
        }
        incr ${dataName}(updates)                                                                    ;# let data table update itself
    }

    proc cells {this} {
        variable ${this}cellRow

        return [array names ${this}cellRow]
    }

    proc dragData {this format} {
        variable ${this}cellRow

        switch $format {
            OBJECTS {
                foreach cell [dataTable::dragData $($this,dataTable) $format] {         ;# gather rows with at least 1 selected cell
                    regexp {\(([^,]+)} $cell dummy row
                    set selected($row) {}
                }
                set lastWishes {}
                foreach row [array names selected] {
                    lappend lastWishes $($this,rowLastWish,$row)
                }
                if {[llength $lastWishes]==0} {
                    return $this                                                                  ;# self destruct if no rows remain
                } else {
                    return $lastWishes
                }
            }
            DATACELLS {
                foreach {cell row} [array get ${this}cellRow] {                                ;# revert original cell / row mapping
                    set original($row) $cell
                }
                set cells {}
                foreach cell [dataTable::dragData $($this,dataTable) DATACELLS] {
                    viewer::parse $cell array row column type
                    if {$column==1} {                   ;# current value: replace with original cell to propagate color, for example
                        lappend cells $original($row)
                    } else {
                        lappend cells $cell
                    }
                }
                return $cells
            }
        }
    }

    proc deleteRow {this cell} {                                   ;# last wish object is deleted after completion of this procedure
        variable [set dataName $($this,dataName)]
        variable ${this}cellRow

        set row [set ${this}cellRow($cell)]
        unset ${dataName}($row,0) ${dataName}($row,1) ${dataName}($row,2) ${dataName}($row,3) ${dataName}($row,4)\
            ${dataName}($row,updates) ${dataName}($row,sum) ($this,rowLastWish,$row)
        unset ${this}cellRow($cell)
        dataTable::update $($this,dataTable)
    }

    # data index is needed so that data array that other eventual data viewers depend on is reused when initializing from save file
    proc initializationConfiguration {this} {
        scan $($this,dataName) %u index                                                     ;# retrieve leading index from data name
        set list [list -dataindex $index]
        foreach {option value} [dataTable::initializationConfiguration $($this,dataTable)] {                        ;# in data table
            if {[string equal $option -columnwidths]} {                                             ;# look for column widths option
                lappend list -columnwidths $value
                break                                                                                                        ;# done
            }
        }
        return $list
    }

    proc setCellColor {this array row column color} {                                                   ;# cell is row current value
        variable [set dataName $($this,dataName)]
        variable ${this}cellRow

        set source ${array}($row,$column)
        foreach {cell row} [array get ${this}cellRow] {
            if {[string equal $cell $source]} {
                dataTable::setCellColor $($this,dataTable) $row 1 $color
                return
            }
        }
    }

}
