set rcsId {$Id: perilabel.tcl,v 2.10 2002/05/19 15:19:59 jfontain Exp $}


::stooop::class piePeripheralLabeler {

    variable PI 3.14159265358979323846

    proc piePeripheralLabeler {this canvas args} pieLabeler {$canvas $args} switched {$args} {
        switched::complete $this
        ::set ($this,array) [::stooop::new canvasLabelsArray $canvas -justify $switched::($this,-justify)]
        ::set ($this,valueWidth) [font measure $switched::($this,-smallfont) $switched::($this,-widestvaluetext)]
        ::set ($this,valueHeight) [font metrics $switched::($this,-smallfont) -ascent]
    }

    proc ~piePeripheralLabeler {this} {
        ::stooop::delete $($this,array)
        $pieLabeler::($this,canvas) delete pieLabeler($this)          ;# delete remaining items (should be in pieLabeler destructor)
    }

    proc options {this} {                        ;# bullet width, font and justify options are used when creating a new canvas label
        # justify option is used for both the labels array and the labels
        return [list\
            [list -bulletwidth 20 20]\
            [list -font $pieLabeler::(default,font) $pieLabeler::(default,font)]\
            [list -justify left left]\
            [list -offset 5 5]\
            [list -smallfont {Helvetica -10} {Helvetica -10}]\
            [list -widestvaluetext 0.00 0.00]\
        ]
    }

    foreach option {-bulletwidth -font -justify -offset -smallfont -widestvaluetext} {                 ;# no dynamic options allowed
        proc set$option {this value} "
            if {\$switched::(\$this,complete)} {
                error {option $option cannot be set dynamically}
            }
        "
    }

    proc set-smallfont {this value} {
        if {$switched::($this,complete)} {
            error {option -smallfont cannot be set dynamically}
        }
    }

    proc new {this slice args} {                                       ;# variable arguments are for the created canvas label object
        ::set canvas $pieLabeler::($this,canvas)
        ::set text [$canvas create text 0 0 -font $switched::($this,-smallfont) -tags pieLabeler($this)]       ;# create value label
        ::set label [eval ::stooop::new canvasLabel $pieLabeler::($this,canvas) $args\
            [list\
                -justify $switched::($this,-justify) -bulletwidth $switched::($this,-bulletwidth)\
                -font $switched::($this,-font) -selectrelief sunken\
            ]\
        ]
        canvasLabelsArray::manage $($this,array) $label
        $canvas addtag pieLabeler($this) withtag canvasLabelsArray($($this,array))                               ;# refresh our tags
        ::set ($this,textItem,$label) $text                                             ;# value text item is the only one to update
        ::set ($this,slice,$label) $slice
        ::set ($this,selected,$label) 0
        return $label
    }

    proc anglePosition {degrees} {
        return [expr {(2*($degrees/90))+(($degrees%90)!=0)}]          ;# quadrant specific index with added value for exact quarters
    }

    ::set index 0                                                         ;# build angle position / value label anchor mapping array
    foreach anchor {w sw s se e ne n nw} {
        ::set (anchor,[anglePosition [expr {$index*45}]]) $anchor
        incr index
    }
    unset index anchor

    proc set {this label value} {
        ::set text $($this,textItem,$label)
        position $this $text $($this,slice,$label)
        $pieLabeler::($this,canvas) itemconfigure $text -text $value
    }

    proc label {this label args} {
        if {[llength $args]==0} {
            return [switched::cget $label -text]
        } else {
            switched::configure $label -text [lindex $args 0]
        }
    }

    proc labelBackground {this label args} {
        if {[llength $args]==0} {
            return [switched::cget $label -textbackground]
        } else {
            switched::configure $label -textbackground [lindex $args 0]
        }
    }

    proc position {this text slice} {              ;# place the value text item next to the outter border of the corresponding slice
        variable PI

        slice::data $slice data                                                    ;# retrieve current slice position and dimensions
        # calculate text closest point coordinates in normal coordinates system (y increasing in north direction)
        ::set midAngle [expr {$data(start)+($data(extent)/2.0)}]
        ::set radians [expr {$midAngle*$PI/180}]
        ::set x [expr {($data(xRadius)+$switched::($this,-offset))*cos($radians)}]
        ::set y [expr {($data(yRadius)+$switched::($this,-offset))*sin($radians)}]
        ::set angle [expr {round($midAngle)%360}]
        if {$angle>180} {
            ::set y [expr {$y-$data(height)}]                                                           ;# account for pie thickness
        }

        ::set canvas $pieLabeler::($this,canvas)
        ::set coordinates [$canvas coords $text]                 ;# now transform coordinates according to canvas coordinates system
        $canvas move $text [expr {$data(xCenter)+$x-[lindex $coordinates 0]}] [expr {$data(yCenter)-$y-[lindex $coordinates 1]}]
        # finally set anchor according to which point of the text is closest to pie graphics
        $canvas itemconfigure $text -anchor $(anchor,[anglePosition $angle])
    }

    proc delete {this label} {
        canvasLabelsArray::delete $($this,array) $label
        $pieLabeler::($this,canvas) delete $($this,textItem,$label)
        unset ($this,textItem,$label) ($this,slice,$label) ($this,selected,$label)
        # finally reposition the remaining value text items next to their slices
        foreach label [canvasLabelsArray::labels $($this,array)] {
            position $this $($this,textItem,$label) $($this,slice,$label)
        }
    }

    proc selectState {this label {selected {}}} {
        if {[string length $selected]==0} {                                                   ;# return current state if no argument
            return $($this,selected,$label)
        }
        switched::configure $label -select $selected
        ::set ($this,selected,$label) $selected
    }

    proc update {this left top right bottom} {                                   ;# whole pie coordinates, includings labeler labels
        ::set canvas $pieLabeler::($this,canvas)
        ::set array $($this,array)                                               ;# first reposition labels array below pie graphics
        ::set width [expr {$right-$left}]
        if {$width!=[switched::cget $array -width]} {
            switched::configure $array -width $width                                                                ;# fit pie width
        } else {
            canvasLabelsArray::update $array
        }
        foreach {x y} [$canvas coords canvasLabelsArray($array)] {}
        $canvas move canvasLabelsArray($array) [expr {$left-$x}] [expr {$bottom-[canvasLabelsArray::height $array]-$y}]
    }

    proc updateSlices {this left top right bottom} {
        foreach label [canvasLabelsArray::labels $($this,array)] {                                     ;# position peripheral labels
            position $this $($this,textItem,$label) $($this,slice,$label)
        }
    }

    proc room {this arrayName} {
        upvar $arrayName data

        ::set data(left) [expr {$($this,valueWidth)+$switched::($this,-offset)}]
        ::set data(right) $data(left)
        ::set data(top) [expr {$switched::($this,-offset)+$($this,valueHeight)}]
        ::set box [$pieLabeler::($this,canvas) bbox canvasLabelsArray($($this,array))]
        if {[llength $box]==0} {                                                                                    ;# no labels yet
            ::set data(bottom) $data(top)
        } else {                                                                        ;# room taken by all labels including offset
            ::set data(bottom) [expr {$data(top)+[lindex $box 3]-[lindex $box 1]}]
        }
    }

}
