# 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: datapie.tcl,v 2.21 2001/01/13 14:52:21 jfontain Exp $}


class dataPieChart {

    proc dataPieChart {this parentPath thickness args} composite {
        [new canvas $parentPath -highlightthickness 0 -borderwidth 2] $args
    } viewer {} {
        set path $widget::($this,path)
        set ($this,slices) {}
        viewer::setupDropSite $this $path                                                            ;# allow dropping of data cells

        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 $font::(smallNormal) -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\
        ]
        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}\]"
    }

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

    proc options {this} {
        # force size values
        return [list\
            [list -deletecommand {} {}]\
            [list -draggable 0 0]\
            [list -height 200]\
            [list -width 300]\
        ]
    }

    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 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 {integer real}
    }

    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
        set label [viewer::label $array $row $column]
        set slice [new slice $($this,pie) -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 {[string first ? $label]>=0} {                                                          ;# label cannot be determined yet
            set ($this,relabel,$slice) {}
        }
    }

    proc update {this array args} {                              ;# update display using cells data. ignore eventual trace arguments
        set cells [cellsFromSlices $this $($this,slices)]
        set sum 0.0                                                                             ;# force floating point calculations
        foreach cell $cells {                                                                           ;# first calculate cells sum
            if {![info exists $cell]||[string equal [set $cell] ?]} continue                  ;# cell may no longer exist or be void
            set sum [expr {$sum+[set $cell]}]
        }
        foreach slice $($this,slices) cell $cells {
            # cell may no longer exist or be void, also catch divide by zero errors
            if {![info exists $cell]||[string equal [set $cell] ?]||($sum==0)} {
                slice::update $slice 0 ?
            } else {
                if {[info exists ($this,relabel,$slice)]} {                                ;# if label is not yet defined, update it
                    viewer::parse $cell array row column type
                    set label [viewer::label $array $row $column]
                    switched::configure $slice -label $label
                    if {[string first ? $label]<0} {                                                 ;# label now completely defined
                        unset ($this,relabel,$slice)
                    }
                }
                set value [expr {[set $cell]/$sum}]
                slice::update $slice $value "[format %.1f [expr {$value*100}]] %"
            }
        }
    }

    proc deletedSlice {this array slice} {
        viewer::unregisterTrace $this $array                                          ;# trace may no longer be needed on this array
        ldelete ($this,slices) $slice
        unset ($this,cell,$slice)
    }

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

    proc cells {this} {
        return [cellsFromSlices $this $($this,slices)]
    }

    proc setCellColor {this array row column color} {
        set cell ${array}($row,$column)
        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
            }
        }
    }

}

class dataPieChart {

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

        proc slice {this pie 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
            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 -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 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==
        }
    }

}

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=
        }
    }

}
