# copyright (C) 1997-2005 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: datapie.tcl,v 2.77 2005/02/07 21:51:35 jfontain Exp $


class dataPieChart {

    set (smallFont) $font::(smallNormal)

    proc dataPieChart {this parentPath thickness args} composite {
        [new canvas $parentPath -background $viewer::(background) -highlightthickness 0 -borderwidth 2] $args
    } viewer {} {
        set path $widget::($this,path)
        set ($this,slices) {}
        viewer::setupDropSite $this $path                                                            ;# allow dropping of data cells
        set menu [menu $path.menu -tearoff 0]
        set ($this,help) [new menuContextHelp $menu]
        set width [$path cget -borderwidth]                          ;# place entry in top left corner, possibly over existing total
        $menu add command -label [mc Total]... -state disabled -command "
            viewer::limitEntry $this $path nw $width [expr {$width - 1}] -total total $(smallFont)\
                {dataPieChart::totalEntered $this} {} unsigned
        "
        menuContextHelp::set $($this,help) 0 [mc {set total value or automatic scaling}]
        if {!$global::readOnly} {
            # do not replace popup menus displayed from canvas items (such as slice color menu):
            if {[package vcompare $::tcl_version 8.4] < 0} {
                bind PopupMenu$this <ButtonPress-3> "if {\[string length \$::tkPriv(popup)\] == 0} {tk_popup $menu %X %Y}"
            } else {
                bind PopupMenu$this <ButtonPress-3> "if {\[string length \$::tk::Priv(popup)\] == 0} {tk_popup $menu %X %Y}"
            }
        }
        bindtags $path [concat [bindtags $path] PopupMenu$this]
        set ($this,colorsMenu) [viewer::createColorsMenu $path {switched::configure $dataPieChart::slice::(clicked) -background %c}]
        set label [new imageLabel $path -font $(smallFont) -bindtags PopupMenu$this]
        place $widget::($label,path) -x 0 -y 0
        set ($this,drop) [new dropSite -path $path -formats DATACELLS -state disabled\
            -regioncommand "dataPieChart::dropRegion $this" -command "dataPieChart::totalCellDrop $this"\
        ]
        set ($this,tips) {}
        if {!$global::readOnly} {
            lappend ($this,tips)\
                [new widgetTip -path $path -rectangle [list 0 0 $viewer::(limitAreaWidth) $viewer::(limitAreaHeight)]]
            lappend ($this,tips) [new widgetTip -path $widget::($label,path)]
        }
        set ($this,total) $label
        set ($this,menu) $menu
        composite::complete $this
        # wait till completion to create pie since -selectable option is not dynamically settable
        set padding [$path cget -borderwidth]
        if {[string equal $::global::pieLabeler peripheral]} {
            set labeler\
                [new piePeripheralLabeler $path -font $font::(mediumNormal) -smallfont $(smallFont) -widestvaluetext {00.0 %}]
        } else {
            set labeler [new pieBoxLabeler $path -font $font::(mediumNormal)]
        }
        set ($this,pie) [new pie $path $padding $padding\
            -title {} -thickness $thickness -selectable $composite::($this,-draggable) -labeler $labeler\
            -colors $global::viewerColors -autoupdate 0\
        ]
        set padding [expr {2 * $padding}]                                    ;# width and height are diminished by twice the padding
        bind $path <Configure> "switched::configure $($this,pie) -width \[expr {%w - $padding}\] -height \[expr {%h - $padding}\]"
        # display help message after object is completely constructed for the message virtual procedure to work:
        after idle "dataPieChart::updateMessage $this"
        updateTip $this
    }

    proc ~dataPieChart {this} {
        if {[info exists ($this,drag)]} {delete $($this,drag)}
        eval delete $($this,slices) $($this,pie) $($this,help) $($this,total) $($this,drop) $($this,tips)
        if {[string length $composite::($this,-deletecommand)] > 0} {
            uplevel #0 $composite::($this,-deletecommand)                                   ;# always invoke command at global level
        }
    }

    proc options {this} {                                                                                             ;# force sizes
        return [list\
            [list -cellcolors {} {}]\
            [list -deletecommand {} {}]\
            [list -draggable 0 0]\
            [list -height 200]\
            [list -total {} {}]\
            [list -totalcell {} {}]\
            [list -width 300]\
        ]
    }

    proc set-cellcolors {this value} {                             ;# colors of soon to be created cells when initializing from file
        if {$composite::($this,complete)} {
            error {option -cellcolors cannot be set dynamically}
        }
        set ($this,nextCellIndex) 0                                                       ;# initialize cell index in list of colors
    }

    proc set-deletecommand {this value} {}

    proc set-draggable {this value} {
        if {$composite::($this,complete)} {
            error {option -draggable cannot be set dynamically}
        }
        if {!$value} return                                                                                           ;# no dragging
        set ($this,drag) [new dragSite -path $widget::($this,path) -validcommand "dataPieChart::validateDrag $this"]
        dragSite::provide $($this,drag) OBJECTS "dataPieChart::dragData $this"
        dragSite::provide $($this,drag) DATACELLS "dataPieChart::dragData $this"
    }

    foreach option {-height -width} {
        proc set$option {this value} "\$widget::(\$this,path) configure $option \$value"
    }

    proc set-total {this value} {
        setTotal $this $value
    }

    proc set-totalcell {this value} {
        setTotalCell $this $value
    }

    proc dragData {this format} {
        set slices [slice::selected $($this,pie)]
        switch $format {
            OBJECTS {
                if {[llength $slices] > 0} {
                    return $slices                                                        ;# return selected slices if there are any
                } elseif {[llength $($this,slices)] == 0} {
                    return $this                                                       ;# return pie itself if it contains no slices
                } else {
                    return {}                                                                            ;# return nothing otherwise
                }
            }
            DATACELLS {
                return [cellsFromSlices $this $slices]
            }
        }
    }

    proc validateDrag {this x y} {
        if {[llength $($this,slices)] == 0} {
            return 1                                                                                   ;# allow drag of empty viewer
        }
        # allow dragging if only from a selected slice
        return [expr {[lsearch -exact [slice::selected $($this,pie)] [slice::current $($this,pie)]] >= 0}]
    }

    proc supportedTypes {this} {
        return $global::numericDataTypes
    }

    proc monitorCell {this array row column} {
        set cell ${array}($row,$column)
        if {[lsearch -exact [cellsFromSlices $this $($this,slices)] $cell] >= 0} return                    ;# already charted, abort
        viewer::registerTrace $this $array
        if {[info exists ($this,nextCellIndex)]} {                           ;# recreate data cell color from recorded configuration
            set color [lindex $composite::($this,-cellcolors) $($this,nextCellIndex)]
            if {[string length $color] == 0} {                 ;# colors list exhausted: we are done initializing from recorded data
                unset color ($this,nextCellIndex)
            } else {
                incr ($this,nextCellIndex)                                                            ;# get ready for upcoming cell
            }
        }
        foreach {label incomplete} [viewer::label $array $row $column] {}
        if {![info exists color]} {set color [viewer::getDisplayColor $cell]}
        if {$global::readOnly} {
            set slice [new slice $($this,pie) {} -background $color -label $label]
        } else {
            set slice [new slice $($this,pie) $($this,colorsMenu) -background $color -label $label]
        }
        lappend ($this,slices) $slice
        switched::configure $slice -deletecommand "dataPieChart::deletedSlice $this $array $slice"  ;# keep track of slice existence
        set ($this,cell,$slice) $cell
        if {$incomplete} {                                                                         ;# label cannot be determined yet
            set ($this,relabel,$slice) {}
        }
        switched::configure $($this,drop) -state normal
        $($this,menu) entryconfigure 0 -state normal
        updateMessage $this
    }

    proc update {this {array {}}} {                                                               ;# update display using cells data
        # note: ignore updated array since all slices and possibly total need be updated when any data related to this pie changes
        set cells [cellsFromSlices $this $($this,slices)]
        set sum $composite::($this,-total)
        if {[string length $sum] == 0} {set sum 0}
        if {![catch {set cell $($this,totalCell)}]} {
            if {[catch {set sum [set $cell]}]} {
                composite::configure $($this,total) -image $viewer::(rightDarkGrayArrow) -text ?
            } else {
                composite::configure $($this,total) -image $viewer::(rightRedArrow) -text $sum
                if {[info exists ($this,relabelTip)]} {updateTip $this}
                if {[string equal $sum ?]} {set sum 0}                                       ;# can happen in database browsing mode
            }
        }
        set sum [expr {double($sum)}]                                                           ;# force floating point calculations
        if {$sum == 0} {                                                                                               ;# auto scale
            foreach cell $cells {                                                                             ;# calculate cells sum
                if {[catch {set value [set $cell]}] || [string equal $value ?] || ![string is double -strict $value]} {
                    continue                                                     ;# cell may no longer exist, be void or non-numeric
                }
                set sum [expr {$sum + abs($value)}]                                                 ;# negative values make no sense
            }
        }
        foreach slice $($this,slices) cell $cells {
            if {[catch {set value [set $cell]}] || [string equal $value ?] || ($sum == 0)} {
                slice::update $slice 0 ?                      ;# cell may no longer exist, be void, also catch divide by zero errors
            } else {
                if {[string is double -strict $value]} {
                    set value [expr {abs($value) / $sum}]                                           ;# negative values make no sense
                    slice::update $slice $value "[format %.1f [expr {$value * 100}]] %"
                } else {                                                                                         ;# non-numeric data
                    slice::update $slice 0 $value
                }
            }
            if {[info exists ($this,relabel,$slice)] && [info exists $cell]} {             ;# if label is not yet defined, update it
                viewer::parse $cell array row column type
                foreach {label incomplete} [viewer::label $array $row $column] {}
                switched::configure $slice -label $label
                if {!$incomplete} {
                    unset ($this,relabel,$slice)                                                     ;# label now completely defined
                }
            }
        }
        pie::update $($this,pie)                           ;# now that all slices are updated, pie automatic update being turned off
    }

    proc deletedSlice {this array slice} {
        viewer::unregisterTrace $this $array                                          ;# trace may no longer be needed on this array
        ldelete ($this,slices) $slice
        viewer::returnDisplayColor $($this,cell,$slice)
        unset ($this,cell,$slice)
        if {[llength $($this,slices)] == 0} {
            composite::configure $this -total {} -totalcell {}                        ;# possibly remove totals as pie becomes empty
            switched::configure $($this,drop) -state disabled
            $($this,menu) entryconfigure 0 -state disabled
        }
        updateMessage $this
    }

    proc cellsFromSlices {this slices} {
        set cells {}
        foreach slice $slices {
            lappend cells $($this,cell,$slice)
        }
        return $cells
    }

    proc cells {this} {                                                               ;# note: always return cells in the same order
        return [cellsFromSlices $this $($this,slices)]
    }

    proc setCellColor {this cell color} {
        foreach slice $($this,slices) {
            if {[string equal $($this,cell,$slice) $cell]} {
                switched::configure $slice -labelbackground $color
                return                                                       ;# done since there cannot be duplicate monitored cells
            }
        }
    }

    proc monitored {this cell} {
        foreach slice $($this,slices) {
            if {[string equal $($this,cell,$slice) $cell]} {
                return 1
            }
        }
        return 0
    }

    proc updateMessage {this} {
        # viewer may have been immediately deleted after construction when a cell of an invalid type was dropped:
        if {[catch {classof $this}]} return
        if {[llength $($this,slices)] == 0} {
            centerMessage $widget::($this,path) [message $this] $widget::option(canvas,background) $global::viewerMessageColor
        } else {
            centerMessage $widget::($this,path) {}
        }
    }

    virtual proc message {this}

    proc setTotal {this value} {                                                                       ;# invoked when -total is set
        if {([string length $value] == 0) || ($value == 0)} {
            composite::configure $($this,total) -text {} -image {}
        } else {
            composite::configure $this -totalcell {}
            composite::configure $($this,total) -text $value -image $viewer::(rightRedArrow)
        }
        if {[info exists ($this,pie)]} {
            update $this
            updateTip $this
        }
    }

    proc totalCellDrop {this} {
        if {[llength $dragSite::data(DATACELLS)] != 1} {
            lifoLabel::flash $global::messenger [mc {only one data cell can be used for total value}]
            bell
            return
        }
        set cell [lindex $dragSite::data(DATACELLS) 0]
        viewer::parse $cell ignore ignore ignore type
        if {[lsearch -exact [supportedTypes $this] $type] < 0} {                          ;# type must exist since cell array exists
            viewer::wrongTypeMessage $type
        } else {
            composite::configure $this -totalcell $cell
        }
    }

    proc setTotalCell {this cell} {                                                                ;# invoked when -totalcell is set
        if {[info exists ($this,totalCell)]} {                                                             ;# there was a total cell
            viewer::parse $($this,totalCell) array ignore ignore ignore
            viewer::unregisterTrace $this $array                                                                ;# no longer monitor
            unset ($this,totalCell)
        }
        composite::configure $($this,total) -text {} -image {}
        if {[string length $cell] == 0} {
            set array {}
        } else {
            viewer::parse $cell array ignore ignore ignore
            viewer::registerTrace $this $array
            set ($this,totalCell) $cell
        }
        if {[info exists ($this,pie)]} {
            update $this $array
            updateTip $this
        }
    }

    proc dropRegion {this} {
        set X [winfo rootx $widget::($this,path)]; set Y [winfo rooty $widget::($this,path)]
        return [list $X $Y [expr {$X + $viewer::(limitAreaWidth)}] [expr {$Y + $viewer::(limitAreaHeight)}]]
    }

    proc initializationConfiguration {this} {
        set colors {}
        foreach slice $($this,slices) {
            lappend colors [switched::cget $slice -background]                       ;# note: always return colors in the same order
        }
        return [list -total $composite::($this,-total) -totalcell $composite::($this,-totalcell) -cellcolors $colors]
    }

    proc totalEntered {this value} {
        if {[string length $value] == 0} {
            composite::configure $this -totalcell {}                                  ;# force deletion of total cell on empty entry
        }
        composite::configure $this -total $value
    }

    proc updateTip {this} {
        if {[info exists ($this,totalCell)]} {
            viewer::parse $($this,totalCell) array row column type
            foreach {label incomplete} [viewer::label $array $row $column] {}
            if {$incomplete} {
                set ($this,relabelTip) {}                                                          ;# label cannot be determined yet
            } else {                                                                                     ;# label completely defined
                catch {unset ($this,relabelTip)}
            }
            set text [format [mc {total cell: %s}] $label]
        } elseif {[string length $composite::($this,-total)] > 0} {
            set text [format [mc {fixed total value set to %s}] $composite::($this,-total)]
        } else {
            set text [mc {set fixed total value or drop cell as dynamic total value here}]
        }
        foreach tip $($this,tips) {switched::configure $tip -text $text}
    }

    proc updateLabels {this} {
        foreach slice $($this,slices) {
            viewer::parse $($this,cell,$slice) array ignore ignore ignore
            set ($this,relabel,$slice) {}
            set update($array) {}
        }
        foreach array [array names update] {
            update $this $array
        }
        if {[info exists ($this,totalCell)]} {                                                              ;# there is a total cell
            updateTip $this
        }
    }

}

class dataPieChart {

    class slice {                                      ;# provide wrapper for pie slice so that deletion through drag and drop works

        proc slice {this pie colorsMenu args} switched {$args} {
            set ($this,pie) $pie
            set slice [pie::newSlice $pie]
            set ($this,slice) $slice
            set (this,$slice) $this                                                            ;# keep track of slice wrapper object
            if {[string length $colorsMenu] > 0} {
                # store slice which was clicked on for the colors menu (avoids creating one menu per slice)
                $pie::($pie,canvas) bind [pie::sliceLabelTag $pie $slice] <ButtonPress-3>\
                    "set dataPieChart::slice::(clicked) $this; tk_popup $colorsMenu %X %Y"
            }
            switched::complete $this
        }

        proc ~slice {this} {
            pie::deleteSlice $($this,pie) $($this,slice)
            unset (this,$($this,slice))
            if {[string length $switched::($this,-deletecommand)] > 0} {
                uplevel #0 $switched::($this,-deletecommand)                                ;# always invoke command at global level
            }
        }

        proc options {this} {
            return [list\
                [list -background {} {}]\
                [list -deletecommand {} {}]\
                [list -label {} {}]\
                [list -labelbackground {} {}]\
            ]
        }

        proc set-deletecommand {this value} {}                                                   ;# data is stored at switched level

        proc set-label {this value} {
            pie::labelSlice $($this,pie) $($this,slice) $value
        }

        proc set-labelbackground {this value} {
            pie::setSliceLabelBackground $($this,pie) $($this,slice) $value
        }

        proc set-background {this value} {
            pie::setSliceBackground $($this,pie) $($this,slice) $value
        }

        proc update {this value string} {
            pie::sizeSlice $($this,pie) $($this,slice) $value $string
        }

        proc selected {pie} {                                                            ;# return selected slices for specified pie
            set list {}
            foreach slice [pie::selectedSlices $pie] {
                lappend list $(this,$slice)
            }
            return $list
        }

        proc current {pie} {                          ;# return current object (whose canvas slice is under the mouse cursor) if any
            set slice [pie::currentSlice $pie]
            if {$slice == 0} {
                return 0                                                                                         ;# no current slice
            } else {
                return $(this,$slice)                                                      ;# return object corresponding with slice
            }
        }

    }

}

class data2DPieChart {

    proc data2DPieChart {this parentPath args} dataPieChart {
        $parentPath 0 -width $global::viewerWidth -height $global::viewerHeight $args
    } {}

    proc ~data2DPieChart {this} {}

    proc iconData {} {
        return {
            R0lGODdhJAAkAKUAAPj4+Hh4eDBgIHBIAKDwePDYSJjwcOjQQJjocODIQJDgcODIOJDgaODAOIjgaNjAOIjYaNi4MIjYYNCwMIDQYMioKEBIQHjIWBBgeKjQ
            4HjAWKDI2HDAWJjI0HDAUJDA0HC4UIi4yPj8+Gi4UIC4yAAAAGiwUHiwwHh8eGiwSHCouICEgGCoSGiouIiQiGCgsJCYkGiguFiYsKCkoFiYqKisqLi8uMDE
            wMjQyNDY0ODk4Ojs6AAAAAAAAAAAAAAAACwAAAAAJAAkAAAG/kCAcCgMEI/G4zBZVBKZSijy6VxWAVKqFRvoer9dgVgwKIPP4GpSTGgLCvBCebpViw14vODA
            78+bdU4CCISFCHt9iQOAgGiDhoUCCZOUlANoXUoCCpydnQILoaKjl1pHAgypqqsCDa6vsA2LgUMCDre4uQIPvL2+D7ONXgIQxcbHEAIRy8zNy5dptRLT1NUS
            AhPZ2tvZwVICFOHi4+HY3OcTs9/k7BQCFfDx8vHqRWHt5O/z+xUDFl+1LggcSFAgmTIIEyY08q2gwwsYMkicSHEiBoanNGjcyFEDhg0gQ4oUeRGLvQACOKhc
            yZIDhg4wY8qUieGfFyICPOjcuRPD3IefQIMGvYjxFIijSJFiCMG0qVOnF0WY1DSiqtURGEho3cqVK1GpSUqIFSvAhNmzJjCcWMu2bVsMY+OimEtXQIq7eDGo
            2Mu3L18MdAOjWEG48AoBLBKzwNCisePHjgEPNkzYheXLlhEnxvCis+fPnSVjxgyjtGnTYjDEkMG6tWsMkk/LnkG7tu0ZsGno3q0bNt3bt2sIH05cOArYyJHT
            Lc68ho3n0KNHF0xXunXoN7Jr3869u/fvOMKLH0++vPnzOdKrX8++vfv3OuLLn0+/vv37O/Lr38+/v///QQAAOw==
        }
    }

    proc message {this} {
        return [mc "2D pie chart:\ndrop data cell(s)"]
    }

}

class data3DPieChart {

    proc data3DPieChart {this parentPath args} dataPieChart {
        $parentPath 20 -width $global::viewerWidth -height $global::viewerHeight $args
    } {}

    proc ~data3DPieChart {this} {}

    proc iconData {} {
        return {
            R0lGODdhJAAkAKUAAPj8+Hh4eDBgIHBIAKD0ePDcSJjwcOjUQJjscODMQJDocODIOJDkaNjAOIjgaNi8MIjcaNC0MIjYYNCwKIDUYMioKIDQYHh8eHjMWBBg
            eKjU4HjIWJjM2EBIQHjEWJDE0HDAUIjAyHC8UIC4yDh8KGi4UHi0wDB4kGi0SHCsuGCwSGiouGCoSGCsSGCgsAAAAFiYqICEgIiQiJCYkKCkoKisqLi8uMDE
            wMjQyNDY0ODk4Ojs6AAAAAAAAAAAAAAAACwAAAAAJAAkAAAG/kCAcCgMEI/G4zBZVBKZSijy6VxWAVKqFRvoer9dgVgwKA/A6G/VOCa4BYV4waxtXsWGvF5w
            6PsPZXaCSgIIhoeGAgmLjIwDWFpoAgqUlZUCC5mam2dpRwIMoaKjAg2mp6gNj1tEAg6vsLEOAg+1tre1q5CfEL2+vxACEcPExcO6SV4CEszNzswCE9LT1NOd
            XkMCFNvc3dsCFeHi4+KrUgIW6err6WRm7/ADF7vZGPb3+PYZGvz9/v0Z5iULs6GgwYMbMnBYyLBhwwwd1AgR4KGixYseMnzYyLFjxwxGzoEYSbIkiAwhUqpc
            uRIkvYkCRMicOTPDiJs4c+bM4HJg7AABJASUGEp0aAYTSJMqTZrhBESJAIAGRUG1KooMKbJq3Zq1qdOQn0iIFaCirNkMK9KqXbvC69eXE8UGZdGibgYXePPq
            deEWpEAhLwK/kDpWDIsMMBIrhsGT54nHTgULvkCZMmG5AhprdgvZaeXPMUKLviyWc+fTAS+IFi2jtWsZYuSSMH36cerXrmfo3q07dunanXlS5s2bhvHjyMfQ
            diqcMvLnNaJLnx79wubGn6lrt8G9u3fvnz9/H9/9hvnz6NOrX88eh/v38OPLn08/h/37+PPr389fh///AAYo4IAE7mDggQgmqOCCDAYBADs=
        }
    }

    proc message {this} {
        return [mc "3D pie chart:\ndrop data cell(s)"]
    }

}