JOB 2017-12-12: Based on
Quick photo rotation, a code snippet from
RS, I created a small utility package for the incredible
tablelist widget brought to us by
Csaba Nemethi. Please also note that tablelist 6.0 is out now and offers even more enrichments (tablelist header subcommands and more!). The embeddedWindows.tcl demo gives a glance of what's new.
With the following text2rotatedimage package you can create vertical aligned header text, which might be quite useful to decrease the overall width of a tablelist widget.
Of course you can also create buttons or labes with vertical text:
Down below is the source code of the package. It is flagged as experimental, so please feel free to place any comments or improvements.
package ifneeded text2rotatedimage 0.1 [list source [file join $dir text2rotatedimage.tcl]]
# -------------------------------------------------------------------------
# text2rotatedimage.tcl
# -------------------------------------------------------------------------
# (c) 2016, Johann Oberdorfer - Engineering Support | CAD | Software
# johann.oberdorfer [at] googlemail.com
# www.johann-oberdorfer.eu
# -------------------------------------------------------------------------
# This source file is distributed under the BSD license.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# See the BSD License for more details.
#
# Credits:
# Many thanks to Richard Suchenwirth for his ideas and the
# source code published on the tcler's wiki: http://wiki.tcl.tk/12545
#
# Description:
#
# Create an image file (*.png) out from a given text string.
# - The image file name is the same as the text
# - and unless otherwise specified,
# the image is stored in the temp directory.
# - If an image file already exists, it wont'b be generated.
#
# The reason for this was basicly to generate vertical text for
# tablelist header items (by overriding the header label images).
# The implemented solution is pretty slow but simple and
# serves the purpose.
#
# -------------------------------------------------------------------------
# Change History:
# 17-12-09: Initial release, Johann Oberdorfer
# -------------------------------------------------------------------------
package require Img
package require fileutil
package provide text2rotatedimage 0.1
namespace eval text2rotatedimage {
namespace export text2imagefile rotateheadertext
proc imgrot90 {img {clockwise 0}} {
set w [image width $img]
set h [image height $img]
set matrix [string repeat "{[string repeat {0 } $h]} " $w]
if $clockwise {
set x0 0; set y [expr {$h-1}]; set dx 1; set dy -1
} else {
set x0 [expr {$w-1}]; set y 0; set dx -1; set dy 1
}
foreach row [$img data] {
set x $x0
foreach pixel $row {
lset matrix $x $y $pixel
incr x $dx
}
incr y $dy
}
set im2 [image create photo -width $h -height $w]
$im2 put $matrix
return $im2
}
# arguments:
# dir: specifies the directory, where to write the file,
# do nothing, if the file already exists,
# text: to be converted to a rotated image,
# args: additional arguments to manipulate font
# (same as for the label widget), see demo code
#
proc text2imagefile {dir text args} {
# fall back solution, in case the directory does not exist
#
if { ![file isdirectory $dir] } {
set dir [fileutil::tempdir]
}
set fname [file join $dir "${text}.png"]
# puts ">> Processing $fname ..."
if { ![file exists $fname] } {
set t [toplevel .temp]
wm geometry $t "+5+5"
wm attributes . -alpha 1 -topmost 1
raise $t
pack [eval [list label $t.l -text $text] $args]
update ;# idletasks
# need to hold on for a while, to make sure
# label creation is finished (got some strange behavior
# when running this code within a starkit executable under windows)
# note: "tkwait visibility $t" is not working under windows at all (!)
#
after 300 "set [namespace current]::_continue_ 1"
tkwait variable "[namespace current]::_continue_"
set i0 [image create photo -data $t.l]
destroy $t
set img [imgrot90 $i0]
$img write $fname -format PNG
}
return $fname
}
# rotates the header text of a given tablelist
# note: run this function after a tablelist widget has been already
# initialized with data. this way, the user is not forced to wait
# for too long...
#
proc rotateheadertext {dir tbl ctrl_list} {
if { ![info exists tbl] || ![winfo exists $tbl] } {
return
}
set tbl_labels [$tbl labels]
if { [llength $tbl_labels] == 0 } {
return
}
# read header information...
set cnt 0
set empty_titles {}
foreach lpath $tbl_labels {
set ltext [$lpath cget -text]
if { [lindex $ctrl_list $cnt] == 1 } {
# the following command sequence also returns
# each individual label widget path
# set lpath [$tbl labelpath $cnt]
# puts ">> Processing: $ltext ..."
set fname [text2imagefile $dir $ltext]
if { [file exists $fname] } {
update
set img [image create photo -file $fname]
$lpath configure -image $img
update idletasks
}
lappend empty_titles {}
} else {
lappend empty_titles $ltext
}
incr cnt
}
# reset column titles, otherwise they are still shown and
# will mess up with the already declared images :=( ...
$tbl configure -columntitles $empty_titles -labelpady 4
}
}- text2rotatedimage_test.tcl
set dir [file dirname [info script]]
lappend auto_path [file join $dir "."]
package require Img
package require text2rotatedimage
namespace import text2rotatedimage::*
set tempdir [file join $dir "temp"]
file mkdir $tempdir
# --Testing demo, usage example:
wm withdraw .
set cnt 0
foreach txt {Hello-world example} {
if {$cnt == 0} {
text2imagefile $tempdir $txt -fg red -font {Courier 11}
} else {
text2imagefile $tempdir $txt
}
incr cnt
}
set t [toplevel .test]
raise $t
ttk::button $t.l \
-image [image create photo -file [file join $tempdir "Hello-world.png"]]
pack $t.l- text2rotatedimage_tabelist_test.tcl
In order to get the code running, please copy over the checked.gif and unchecked.gif images from the tablelist package.
# specify, where to find support packages:
set cdir [file dirname [info script]]
lappend auto_path [file join $cdir "."]
lappend auto_path [file join $cdir "../../lib"]
package require Img
package require tablelist_tile 6.0
package require text2rotatedimage
# --Testing demo, usage example:
catch {console show}
# ---- BEGIN: copied over from tablelist's demo ----
wm title . "Tablelist test..."
set f [ttk::frame .f]
set tbl $f.tbl
tablelist::tablelist $tbl \
-columns {0 "No." right
0 "Available" center
0 "Name" left
0 "Baud Rate" right
0 "Data Bits" center
0 "Parity" left
0 "Stop Bits" center
0 "Handshake" left
0 "Activation Date" center
0 "Activation Time" center
0 "Cable Color" center} \
-height 0 -width 0
# -editstartcommand editStartCmd -editendcommand editEndCmd
set btn [ttk::button $f.btn -text "Close" -command exit]
#
# Manage the widgets
#
pack $btn -side bottom -pady 10
pack $tbl -side top -expand yes -fill both
pack $f -expand yes -fill both
$tbl columnconfigure 0 -sortmode integer
$tbl columnconfigure 1 -name available -editable yes \
-editwindow ttk::checkbutton -formatcommand emptyStr
$tbl columnconfigure 2 -name lineName -editable yes -editwindow ttk::entry \
-sortmode dictionary
$tbl columnconfigure 3 -name baudRate -editable yes -editwindow ttk::combobox \
-sortmode integer
if {[info commands ttk::spinbox] eq ""} {
$tbl columnconfigure 4 -name dataBits -editable yes -editwindow spinbox
} else {
$tbl columnconfigure 4 -name dataBits -editable yes -editwindow ttk::spinbox
}
$tbl columnconfigure 5 -name parity -editable yes -editwindow ttk::combobox
$tbl columnconfigure 6 -name stopBits -editable yes -editwindow ttk::combobox
$tbl columnconfigure 7 -name handshake -editable yes -editwindow ttk::combobox
$tbl columnconfigure 8 -name actDate -editable yes -editwindow ttk::entry \
-formatcommand formatDate -sortmode integer
$tbl columnconfigure 9 -name actTime -editable yes -editwindow ttk::entry \
-formatcommand formatTime -sortmode integer
$tbl columnconfigure 10 -name color -editable yes \
-editwindow ttk::menubutton -formatcommand emptyStr
proc emptyStr val { return "" }
proc formatDate val { return [clock format $val -format "%Y-%m-%d"] }
proc formatTime val { return [clock format $val -format "%H:%M:%S"] }
#
# Create two images, to be displayed in tablelist cells with boolean values
#
image create photo checkedImg -file [file join $cdir checked.gif]
image create photo uncheckedImg -file [file join $cdir unchecked.gif]
#
# Create 16 images representing different colors
#
set colorNames {
"red" "green" "blue" "magenta"
"yellow" "cyan" "light gray" "white"
"dark red" "dark green" "dark blue" "dark magenta"
"dark yellow" "dark cyan" "dark gray" "black"
}
set colorValues {
#FF0000 #00FF00 #0000FF #FF00FF
#FFFF00 #00FFFF #C0C0C0 #FFFFFF
#800000 #008000 #000080 #800080
#808000 #008080 #808080 #000000
}
foreach name $colorNames value $colorValues {
set colors($name) $value
}
foreach value $colorValues {
image create photo img$value -height 13 -width 13
img$value put gray50 -to 0 0 13 1 ;# top edge
img$value put gray50 -to 0 1 1 12 ;# left edge
img$value put gray75 -to 0 12 13 13 ;# bottom edge
img$value put gray75 -to 12 1 13 12 ;# right edge
img$value put $value -to 1 1 12 12
}
set clock [expr {[clock seconds] + 600}]
for {set i 0; set n 1} {$i < 16} {set i $n; incr n} {
$tbl insert end [list $n [expr {$i < 8}] "Line $n" 9600 8 None 1 XON/XOFF \
$clock $clock [lindex $colorNames $i]]
set availImg [expr {($i < 8) ? "checkedImg" : "uncheckedImg"}]
$tbl cellconfigure end,available -image $availImg
$tbl cellconfigure end,color -image img[lindex $colorValues $i]
}
# ---- END: copied over from tablelist's demo ----
set tempdir [file join $cdir "temp"]
file mkdir $tempdir
set ctrl_list {1 1 0 1 1 1 1 0 0 0 1}
# set ctrl_list {}; foreach dummy [$tbl labels] { lappend ctrl_list 1 }
# finally:
# ----------------------------------------------------------
text2rotatedimage::rotateheadertext $tempdir $tbl $ctrl_list
# ----------------------------------------------------------
