vertical labels
MGS - Here's a nasty-ish hack to make labels with vertical text. Not rotated text, just with the letters stacked on top of each other. For spaces, you need to insert two newlines.
label .l -text "Vertical\n\nLabel" -wraplength 1
pack .lMake sure the label is packed/gridded so as not to expand or fill horizontally.
RS Another way is:
label .l2 -text [join [split "Vertical text" ""] \n]
This way is slower and alters the actual text contained in the label rather than just how it wraps, though. -FW - RS: Well, it processes a copy of the text, which is perfectly normal in Tcl - but needs no workaround for spaces... ;-)
AMG: Or this, which is faster (1.0 microseconds versus 1.7 microseconds in my test):
label .l3 -text [string range [regsub -all {} "Vertical text" \n] 1 end]Mike Tuxford thinks both of those are clever and would come in handy for use with Animated Vertical Tabs
ulis, 2003-01-23. Torsten in c.l.t. asked for a vertical label package. Here it is.
Vlabel package
if {![info exists ::vlabel::version]} {
namespace eval ::vlabel {
namespace export vlabel
package require Tk
variable version 0.1
package provide Vlabel $version
proc vlabel {w args} {
label $w
rename $w ::vlabel::_$w
interp alias {} ::$w {} ::vlabel::vdispatch $w
if {[llength $args] %2 == 1} {
return -code error "value for \"[lindex $args end]\" missing"
}
if {$args != ""} { eval vconfig $w $args }
return $w
}
proc vtext {text} { join [split $text {}] \n }
proc vdispatch {w {cmd ""} args} {
set rc [catch {
switch -glob -- $cmd {
con* { uplevel 1 ::vlabel::vconfig $w $args }
default { uplevel 1 ::vlabel::_$w $cmd $args }
}
} res]
if {$rc != 1} {
return -code $rc $res
} else {
return -code 1 [string map [list ::vlabel::_$w $w] $res]
}
}
proc vconfig {w args} {
set l [llength $args]
if {$l == 0} { return [eval ::vlabel::_$w config $args] }
set n 0
foreach {key value} $args {
incr n
if {$n == $l} { return [::vlabel::_$w config $key] }
switch -glob -- $key {
-text { ::vlabel::_$w config -text [vtext $value] }
default { ::vlabel::_$w config $key $value }
}
incr n
}
}
}
}Demo
package require Vlabel namespace import ::vlabel::vlabel pack [vlabel .l -text vlabel -bg gold]
ulis, 2004-01-24. The request was a little more: a rotated text that doesn't cost any time or memory. I can't do that in pure Tcl but here is a proc that does the trick, wasting time and memory (and needing Img).
The proc
package require Img
proc rlabel {w side args} {
if {$side ne "up"} { set side bottom }
label $w {*}$args
pack $w
update
image create photo photo -format window -data $w
destroy $w
set width [image width photo]
set height [image height photo]
set data [photo data]
image create photo photo2
for {set x 0} {$x < $width} {incr x} {
for {set y 0} {$y < $height} {incr y} {
set xx $x
set yy $y
if {$side eq "bottom"} { set xx [expr {$width - $x - 1}] }
if {$side eq "up"} { set yy [expr {$height - $y - 1}] }
photo2 put [lindex $data $yy $xx] -to $y $x
}
}
label $w -image photo2
return $w
}A test
set font {Helvetica -16 bold}
pack [rlabel .vl up -text "a rlabel" -fg navy -bg azure -font $font] -side left
AMG: Sadly, as the screenshot illustrates, this design approach clashes badly with subpixel antialiasing. Getting that right requires that the text engine itself be given the ability to render rotated text. Alternately, disable subpixel antialiasing when drawing the text to be rotated, but I have no clue how to do that on a widget-by-widget basis.
See also
KBK 2008-11-03 Another possibility is to do rotated text in a canvas as line drawing primitives. A version of this is in the Half Bakery at https://wiki.tcl-lang.org/_repo/hershey/