tklib 0.6-2 / usr / share / tcltk / tklib0.6 / tkpiechart / boxlabel.tcl

This file is indexed.

/usr/share/tcltk/tklib0.6/tkpiechart/boxlabel.tcl is in tklib 0.6-2.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
# copyright (C) 1995-2004 Jean-Luc Fontaine (mailto:jfontain@free.fr)

package require Tk 8.3
package require stooop


::stooop::class pieBoxLabeler {

    proc pieBoxLabeler {this canvas args} pieLabeler {$canvas $args} switched {
        $args
    } {
        ::set ($this,array) [::stooop::new canvasLabelsArray $canvas]
        switched::complete $this
    }

    proc ~pieBoxLabeler {this} {
        ::stooop::delete $($this,array)
    }

    proc options {this} {
        # 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 -font\
                $pieLabeler::(default,font) $pieLabeler::(default,font)\
            ]\
            [list -justify left left]\
            [list -offset 5 5]\
            [list -xoffset 0 0]\
        ]
    }

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

    proc new {this slice args} {
        # variable arguments are for the created canvas label object
        ::set label [eval ::stooop::new canvasLabel\
            $pieLabeler::($this,canvas) $args\
            [list\
                -justify $switched::($this,-justify)\
                -font $switched::($this,-font) -selectrelief sunken\
            ]\
        ]
        canvasLabelsArray::manage $($this,array) $label
        # refresh our tags
        $pieLabeler::($this,canvas) addtag pieLabeler($this)\
            withtag canvasLabelsArray($($this,array))
        # always append semi-column to label:
        switched::configure $label -text [switched::cget $label -text]:
        ::set ($this,selected,$label) 0
        return $label
    }

    proc delete {this label} {
        canvasLabelsArray::delete $($this,array) $label
        unset ($this,selected,$label)
    }

    proc set {this label value} {
        # update string part after last semi-column
        regsub {:[^:]*$} [switched::cget $label -text] ": $value" text
        switched::configure $label -text $text
    }

    proc label {this label args} {
        ::set text [switched::cget $label -text]
        if {[llength $args] == 0} {
            regexp {^(.*):} $text dummy text
            return $text
        } else {                   ;# update string part before last semi-column
            regsub {^.*:} $text [lindex $args 0]: text
            switched::configure $label -text $text
        }
    }

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

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

    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)
        # first reposition labels array below pie graphics
        ::set array $($this,array)
        ::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 room {this arrayName} {
        upvar 1 $arrayName data

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

}

APT Browse - Built by Thomas Orozco.