Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tcl80 Excluding Merge-Ins
This is equivalent to a diff from 411c59b769 to c6c64c78fc
|
2000-07-30
| ||
| 19:47 | in toggle{}, when last selected index no longer exists, no longer try to keep track of selected index as it would be too complicated (removes a crash that occured after toggling cell 1, cell 2, cell 2 and cell 1). Closed-Leaf check-in: c6c64c78fc user: jfontain tags: tcl80 | |
|
2000-04-06
| ||
| 19:34 | in columnHeight{}, forgot double quotes in fully qualified name. check-in: 490a6a278c user: jfontain tags: tcl80 | |
|
2000-03-05
| ||
| 20:48 | added labelSlice{}. check-in: 4033332bc8 user: jfontain tags: tcl80 | |
|
1999-10-02
| ||
| 20:53 | changed email address to free in copyright notice. check-in: 2573bcaf3f user: jfontain tags: trunk | |
|
1999-08-16
| ||
| 20:59 | in selected{}, use array get instead of names for better performance. check-in: 411c59b769 user: jfontain tags: trunk | |
|
1999-03-30
| ||
| 21:23 | version 5.3. check-in: 4e7d49df37 user: jfontain tags: trunk | |
Changes to modules/tkpiechart/README.
|
| | | | | | | | 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 | Tkpiechart is a Tcl only library which allows the creation of pies with labels in Tcl canvases. This is version 5.4. It was tested with Tcl8.0/Tk8.0 and the netscape plug-in 2.0, on both Linux and Windows platforms (it should work on all Tcl/Tk supported platforms). It is object oriented using the stooop (Simple Tcl Only Object Oriented Programming) extension (version 3.7 or above, tcl file included). If you have netscape with the Tcl plug-in installed, just Open File... demo.tcl and voila! Run the demo script to see what it looks like, read the man pages to understand how to use it. Whether you like it (or hate it), please let me know. I would like to hear about bugs and improvements you would like to see. I will correct the bugs quickly, especially if you send me a test script. If you find a bug in the Tcl code and correct it yourself, please email the modified code so I can include it in the next release. The same goes for improvements. Jean-Luc Fontaine (http://jfontain.free.fr/, mailto:jfontain@free.fr) |
Changes to modules/tkpiechart/boxlabel.tcl.
|
| | | 1 2 3 4 5 6 7 8 |
set rcsId {$Id: boxlabel.tcl,v 1.41.1.1 2000/03/05 20:55:56 jfontain Exp $}
class pieBoxLabeler {
proc pieBoxLabeler {this canvas args} pieLabeler {$canvas $args} switched {$args} {
::set pieBoxLabeler::($this,array) [::new canvasLabelsArray $canvas]
switched::complete $this
}
|
| ︙ | ︙ | |||
43 44 45 46 47 48 49 |
proc delete {this label} {
canvasLabelsArray::delete $pieBoxLabeler::($this,array) $label
unset pieBoxLabeler::($this,selected,$label)
}
proc set {this label value} {
| > > > > > | > > > > > | | > | 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 |
proc delete {this label} {
canvasLabelsArray::delete $pieBoxLabeler::($this,array) $label
unset pieBoxLabeler::($this,selected,$label)
}
proc set {this label value} {
regsub {:[^:]*$} [switched::cget $label -text] ": $value" text ;# update string part after last semi-column
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 {
regsub {^.*:} $text [lindex $args 0]: text ;# update string part before last semi-column
switched::configure $label -text $text
}
}
proc selectState {this label {selected {}}} {
if {[string length $selected]==0} { ;# return current state if no argument
return $pieBoxLabeler::($this,selected,$label)
}
switched::configure $label -select $selected
::set pieBoxLabeler::($this,selected,$label) $selected
|
| ︙ | ︙ |
Deleted modules/tkpiechart/canlabel.tcl.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Changes to modules/tkpiechart/labarray.tcl.
|
| | | 1 2 3 4 5 6 7 8 |
set rcsId {$Id: labarray.tcl,v 1.20.1.2 2000/04/06 19:34:36 jfontain Exp $}
class canvasLabelsArray {
proc canvasLabelsArray {this canvas args} switched {$args} {
set canvasLabelsArray::($this,canvas) $canvas
# use an empty image as an origin marker with only 2 coordinates
set canvasLabelsArray::($this,origin) [$canvas create image 0 0 -tags canvasLabelsArray($this)]
|
| ︙ | ︙ | |||
60 61 62 63 64 65 66 |
position $this $label $index
incr index
}
}
proc position {this label index} {
set canvas $canvasLabelsArray::($this,canvas)
| < < < | | | | > > > > | > | < > > | | | > | > | > | 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 |
position $this $label $index
incr index
}
}
proc position {this label index} {
set canvas $canvasLabelsArray::($this,canvas)
foreach {x y} [$canvas coords $canvasLabelsArray::($this,origin)] {}
set column [expr {$index%2}]
switch $switched::($this,-justify) { ;# arrange labels in two columns
left {
set x [expr {$x+($column*($canvasLabelsArray::($this,width)/2.0))}]
set anchor nw
}
right {
set x [expr {$x+(($column+1)*($canvasLabelsArray::($this,width)/2.0))}]
set anchor ne
}
default { ;# should be center
set x [expr {$x+((1.0+(2*$column))*$canvasLabelsArray::($this,width)/4)}]
set anchor n
}
}
set y [expr {$y+[columnHeight $this $column [expr {$index/2}]]}]
switched::configure $label -anchor $anchor
foreach {xDelta yDelta} [$canvas coords canvasLabel($label)] {} ;# do an absolute positioning using label tag
$canvas move canvasLabel($label) [expr {$x-$xDelta}] [expr {$y-$yDelta}]
}
proc labels {this} {
return $canvasLabelsArray::($this,labels)
}
proc columnHeight {this column {rows 2147483647}} { ;# column must be either 0 or 1
set canvas $canvasLabelsArray::($this,canvas)
set length [llength $canvasLabelsArray::($this,labels)]
set height 0
for {set index $column; set row 0} {($index<$length)&&($row<$rows)} {incr index 2; incr row} {
set coordinates [$canvas bbox canvasLabel([lindex $canvasLabelsArray::($this,labels) $index])]
incr height [expr {[lindex $coordinates 3]-[lindex $coordinates 1]}]
}
return $height
}
proc height {this} {
return [maximum [columnHeight $this 0] [columnHeight $this 1]]
}
proc maximum {a b} {return [expr {$a>$b?$a:$b}]}
}
|
Deleted modules/tkpiechart/objselec.tcl.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |
Changes to modules/tkpiechart/perilabel.tcl.
|
| | | 1 2 3 4 5 6 7 8 |
set rcsId {$Id: perilabel.tcl,v 1.47.1.1 2000/03/05 21:04:00 jfontain Exp $}
class piePeripheralLabeler {
variable PI 3.14159265358979323846
proc piePeripheralLabeler {this canvas args} pieLabeler {$canvas $args} switched {$args} {
switched::complete $this
|
| ︙ | ︙ | |||
72 73 74 75 76 77 78 79 80 81 82 83 84 85 |
unset index anchor
proc set {this label value} {
::set text $piePeripheralLabeler::($this,textItem,$label)
position $this $text $piePeripheralLabeler::($this,slice,$label)
$pieLabeler::($this,canvas) itemconfigure $text -text $value
}
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)}]
| > > > > > > > > | 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 |
unset index anchor
proc set {this label value} {
::set text $piePeripheralLabeler::($this,textItem,$label)
position $this $text $piePeripheralLabeler::($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 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)}]
|
| ︙ | ︙ |
Changes to modules/tkpiechart/pie.tcl.
|
| | | | 1 2 3 4 5 6 7 8 9 10 |
set rcsId {$Id: pie.tcl,v 1.85.1.3 2000/04/06 19:29:27 jfontain Exp $}
package provide tkpiechart 5.4.1
class pie {
set pie::(colors) {#7FFFFF #7FFF7F #FF7F7F #FFFF7F #7F7FFF #FFBF00 #BFBFBF #FF7FFF #FFFFFF}
}
proc pie::pie {this canvas x y args} switched {$args} { ;# note: all pie elements are tagged with pie($this)
set pie::($this,canvas) $canvas
|
| ︙ | ︙ | |||
197 198 199 200 201 202 203 204 205 206 207 208 209 210 |
}
set value [expr {-1*$growth}] ;# finally move the following slices
foreach slice [lrange $pie::($this,slices) [incr index] end] {
slice::rotate $slice $value
}
}
proc pie::selectedSlices {this} { ;# return a list of currently selected slices
set list {}
foreach slice $pie::($this,slices) {
if {[pieLabeler::selectState $pie::($this,labeler) $pie::($this,sliceLabel,$slice)]} {
lappend list $slice
}
| > > > > > | 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 |
}
set value [expr {-1*$growth}] ;# finally move the following slices
foreach slice [lrange $pie::($this,slices) [incr index] end] {
slice::rotate $slice $value
}
}
proc pie::labelSlice {this slice text} {
pieLabeler::label $pie::($this,labeler) $pie::($this,sliceLabel,$slice) $text
update $this ;# necessary if number of lines in label changes
}
proc pie::selectedSlices {this} { ;# return a list of currently selected slices
set list {}
foreach slice $pie::($this,slices) {
if {[pieLabeler::selectState $pie::($this,labeler) $pie::($this,sliceLabel,$slice)]} {
lappend list $slice
}
|
| ︙ | ︙ | |||
243 244 245 246 247 248 249 |
set scale [list\
[expr {($pie::($this,width)-$room(left)-$room(right))/$pie::($this,initialWidth)}]\
[expr {\
($pie::($this,height)-$room(top)-$room(bottom)-$pie::($this,titleRoom))/\
($pie::($this,initialHeight)+$pie::($this,thickness))\
}]\
]
| | | 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 |
set scale [list\
[expr {($pie::($this,width)-$room(left)-$room(right))/$pie::($this,initialWidth)}]\
[expr {\
($pie::($this,height)-$room(top)-$room(bottom)-$pie::($this,titleRoom))/\
($pie::($this,initialHeight)+$pie::($this,thickness))\
}]\
]
switched::configure $pie::($this,backgroundSlice) -scale $scale ;# update scale of background slice
foreach slice $pie::($this,slices) {
switched::configure $slice -scale $scale ;# and other slices
}
if {$pie::($this,titleRoom)>0} { ;# title exists
$canvas coords $pie::($this,title) [expr {$x+($pie::($this,width)/2)}] $y ;# place text above pie and centered
}
# finally update labels now that pie graphics are in position
|
| ︙ | ︙ |
Changes to modules/tkpiechart/pielabel.tcl.
|
| | > > | 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 |
set rcsId {$Id: pielabel.tcl,v 1.40.1.1 2000/03/05 20:54:00 jfontain Exp $}
class pieLabeler {
set pieLabeler::(default,font) {Helvetica -12}
proc pieLabeler {this canvas args} {
::set pieLabeler::($this,canvas) $canvas
}
proc ~pieLabeler {this} {}
virtual proc new {this slice args} ;# must return a canvasLabel
virtual proc delete {this label}
virtual proc set {this label value}
virtual proc label {this args} ;# set or get label if no arguments
virtual proc selectState {this label {state {}}}
# must be invoked only by pie, which knows when it is necessary to update (new or deleted label)
virtual proc update {this left top right bottom}
virtual proc room {this arrayName}
}
|
Changes to modules/tkpiechart/selector.tcl.
|
| | | 1 2 3 4 5 6 7 8 |
set rcsId {$Id: selector.tcl,v 1.4.1.1 2000/07/30 19:47:35 jfontain Exp $}
# implements generic selection on a list of unique identifiers
class selector {
proc selector {this args} switched {$args} {
::set selector::($this,order) 0
|
| ︙ | ︙ | |||
96 97 98 99 100 101 102 |
::set select {}
::set deselect {}
foreach index $indices {
if {[::set ${this}selected($index)]} {
lappend deselect $index
::set ${this}selected($index) 0
| | | | 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 |
::set select {}
::set deselect {}
foreach index $indices {
if {[::set ${this}selected($index)]} {
lappend deselect $index
::set ${this}selected($index) 0
if {[info exists selector::($this,lastSelected)]&&($index==$selector::($this,lastSelected))} {
::unset selector::($this,lastSelected) ;# too complicated to find out what was selected last
}
} else {
lappend select $index
::set ${this}selected($index) 1
::set selector::($this,lastSelected) $index ;# keep track of last selected object for extension
}
::set ${this}order($index) $selector::($this,order) ;# keep track of action order
|
| ︙ | ︙ |
Deleted modules/tkpiechart/slice.tcl.
|
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < |