# copyright (C) 1997-98 Jean-Luc Fontaine (mailto:jfontain@mygale.org)
# 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 1.26 1998/10/11 09:27:20 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 dataPieChart::($this,slices) {}
        # allow dropping of data cells
        set dataPieChart::($this,drop) [new dropSite\
            -path $path -formats DATACELLS -command "viewer::view $this \$dragSite::data(DATACELLS)"\
        ]

        composite::complete $this

        # wait till completion to create pie since -selectable option is not dynamically settable
        set padding [$path cget -borderwidth]
        set dataPieChart::($this,pie) [new pie $path $padding $padding\
            -title {} -thickness $thickness -selectable $composite::($this,-draggable)\
            -labeler [new piePeripheralLabeler $path\
                -font $font::(mediumNormal) -smallfont $font::(smallNormal) -widestvaluetext {00.0 %}\
            ]\
        ]
        set padding [expr {2*$padding}]                                      ;# width and height are diminished by twice the padding
        bind $path <Configure>\
            "switched::configure $dataPieChart::($this,pie) -width \[expr {%w-$padding}\] -height \[expr {%h-$padding}\]"
    }

    proc ~dataPieChart {this} {
        delete $dataPieChart::($this,pie) $dataPieChart::($this,drop)
        catch {delete $dataPieChart::($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 draggable Draggable 0 0]\
            [list -height height Height 200]\
            [list -width width 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 dataPieChart::($this,drag) [new dragSite -path $widget::($this,path) -validcommand "dataPieChart::validateDrag $this"]
        dragSite::provide $dataPieChart::($this,drag) OBJECTS "dataPieChart::dragData $this"
        dragSite::provide $dataPieChart::($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 $dataPieChart::($this,pie)]
        switch $format {
            OBJECTS {
                if {[llength $slices]>0} {
                    return $slices                                                        ;# return selected slices if there are any
                } elseif {[llength $dataPieChart::($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 $dataPieChart::($this,slices)]==0} {
            return 1                                                                                   ;# allow drag of empty viewer
        }
        # allow dragging if only from a selected slice
        return [expr {\
            [lsearch -exact [slice::selected $dataPieChart::($this,pie)] [slice::current $dataPieChart::($this,pie)]]>=0\
        }]
    }

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

    proc monitorCell {this array row column} {
        viewer::registerTrace $this $array
        set cell ${array}($row,$column)
        if {[lsearch -exact [cellsFromSlices $this $dataPieChart::($this,slices)] $cell]>=0} return        ;# already charted, abort
        set slice [new slice $dataPieChart::($this,pie) [viewer::label $array $row $column]]
        lappend dataPieChart::($this,slices) $slice
        switched::configure $slice -deletecommand "dataPieChart::deletedSlice $this $array $slice"  ;# keep track of slice existence
        set dataPieChart::($this,cell,$slice) $cell
    }

    proc update {this array args} {                              ;# update display using cells data. ignore eventual trace arguments
        set cells [cellsFromSlices $this $dataPieChart::($this,slices)]
        set sum 0.0                                                                             ;# force floating point calculations
        foreach cell $cells {
            catch {set sum [expr {$sum+[set $cell]}]}                              ;# ignore errors as data cell may no longer exist
        }
        foreach slice $dataPieChart::($this,slices) cell $cells {
            if {[catch {set $cell} value]||($sum==0)} {                            ;# handle invalid cells and divide by zero errors
                slice::update $slice 0 ?
            } else {
                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 dataPieChart::($this,slices) $slice
        unset dataPieChart::($this,cell,$slice)
        if {[llength $dataPieChart::($this,slices)]==0} {
            delete $this                                                            ;# self destruct when there are no more elements
        }
    }

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

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

class dataPieChart {

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

        proc slice {this pie label args} switched {$args} {
            set ($this,pie) $pie
            set slice [pie::newSlice $pie $label]
            set ($this,slice) $slice
            set (this,$slice) $this                                                            ;# keep track of slice wrapper object
            switched::complete $this
        }

        proc ~slice {this} {
            pie::deleteSlice [set ($this,pie)] [set ($this,slice)]
            unset (this,[set ($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 {} {}]\
            ]
        }

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

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

        proc selected {pie} {                                                            ;# return selected slices for specified pie
            set list {}
            foreach slice [pie::selectedSlices $pie] {
                lappend list [set (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 [set (this,$slice)]                                                 ;# return object corresponding with slice
            }            
        }

    }

}

class data2DPieChart {

    proc data2DPieChart {this parentPath args} dataPieChart {$parentPath 0 -width 200 -height 220 $args} {}

    proc ~data2DPieChart {this} {}

    proc iconData {} {
        return {
            R0lGODdhKAAoAKUAAHt5e87PzgAAANbX1v///zFhIXNJAKX3e/ffSpznc+/XQozPY+fHOXvHWta2Mc6mKUJJQhBhe63X54y+1pTH3lKWrWumvVIIY2sYe4wQ
            pb0o1qUYvbUYzq0Yzr0Y3t44/95B/+dJ/+dR/+dZ/9YY9+dh/94o/+9x/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG/kCAcEgsGo/IYQAgaDqf0Kh02lwKAthsYIDlbrVer3Y8ZgYI6DQaoG6z2+n3Gm09wwlyeN6t
            flsHd3iBgoF5fmZJRAWLBQaOiUZ1hWiLB5YFCJkIjnxxdEyAdwCVlpeampxzngSSdwWlBwkJB5inCrcGqqp1R6+wsgu1t8MMDAZJf3C+lsALwcO3xdLHfZ9X
            bcuxCc4JDQXR0g7i4rmryWq+stsL698K0uHk1ayIQ8vq3c7e8PEODw/l8AhpRSmWtgYN9O0rNq7hv4CHBIQikK7ZOoQFGDb09+/hLjNpXqljl3ABQm8OO6oE
            +PGKvVj6TCpEubImQAhECL7iNvNk/iNHQIMGZRNxYgGeJk+ejCChadMJEqBSmDChQgSi1uxQPJBQqVKmTqE2nUrVglWs9CTaQ9jNK0KwTqNGpTrBbAScSkCG
            bOsWrty5dO0KIUSQotulT5/SLSsYbWHDff8uDty4ZZQCh+FOZlzBqhQrFy5gGD0as1emmzlbJc0ag5UMsGPDNv12AtnFFnJ3jsBag2/fVjZwEE6cQwfaESbn
            Xr6bdAcPHz5A/2Clg/Hr1jscLxBhuXfdVnmP7gCivHkQ1bWrX689QoTO8OG7Z00eRIj7+Ktr6LC/P4jnHniAgXsEEkhffeeZZ0WAIHjQoAggiCDhhB205px2
            E2aY4YIiQHgA4YcaasheiCSKsOAIKKao4oostuiiFSSUIOOMNNZo4404wojjjjzuaIUJJpwg5JBEFmnkkUcuQcaSTDbZZBAAOw==
        }
    }

}

class data3DPieChart {

    proc data3DPieChart {this parentPath args} dataPieChart {$parentPath 20 -width 250 -height 180 $args} {}

    proc ~data3DPieChart {this} {}

    proc iconData {} {
        return {
            R0lGODdhKAAoAKUAAHt5e87PzgAAANbX1v///zFhIXNJAKX3e/ffSu/XQufHOZznc9a2MY7PYc6mKRBhe63X55TH3oy+1lKWrUJJQk2SMDF5lFIIY2sYe4wQ
            pb0o1qUYvbUYzr0Y3t44/60Yzt5B/+dJ/+dR/+dZ/9YY9+dh/94o/+9x/wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
            AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAKAAoAAAG/kCAcEgsGo/IYQAgaDqf0Kh02lwKAthsYIDlbrVer3Y8ZgYI6DQaoG6z2+n3Gm09wwlyeN6t
            flsHd3iBgoF5fmZJRAWLBQaOBolFdYMEjAeXBQiaCI99ngR/gYuXpAeZmwgJCo5zcXRmdwWlpAunmqoKCgwGhK11RrKzCwsNtrm6DMmQR6FqwbTDDbWpx8jJ
            u5+Tac8H0sQN4Jm51+QMDry+TIDb0N/fBdblDvPohL9Cz9HE+8Xy8//0JMFCEwwcP34FzAFcSC+dgHWVLumTBi7co4sYWdkbWCkaRXfgHkAYSXJkhAgQJEx4
            4HAJvo8wQ5YkeTKChJsrKRDR1tFb/sWfImfWvKlSwgM2hx5uK/DzW8WgKYcSnaDy6MYrSyn+lGny5E2bRVdaTTpgSIEKTLfKlOo17AMLD3Qq4XgWrdoGIonq
            pUr1LVykr7ASrEA4LVC9YYv6/XvVzuDChh8k5qvYguWjgEExgVIX8qIHlPk+GL0YbhQrFy5gWI2hM2HCpGOXtgyXtW0rGXLrzuAaNu3fwGuv1kCcuJUNHJAr
            57DodYXZwYVj6ODBA3UPVj5w0M6dA/PO0H+PZt0BhPnz2T+oX7++A6PwpG2fD0GffnYNH/Dr78CfPwbZ8dlW3nkEgmAFfyCU14EIIIjg4IO2sfYBeQ9WWOGB
            IizYYIMWPlYIAnsfcNihhQeOYOKJKKao4oosWkFCCTDGKOOMNNZoo4s25qhjjlaYYMIJQAYp5JBEFlnkEmQkqeSSSwYBADs=
        }
    }

}