package require Tk
package require Img
proc encoding'literally {name char} {
scan $char %c i
set row [expr {$i/16}]
set col [expr {($i%16)*4}]
set f [open $::tcl_library/encoding/$name.enc]
for {set i -4} {$i <= $row} {incr i} {gets $f line}
K [string range $line $col [incr col 3]] [close $f]
}
proc K {a b} {set a}
pack [canvas .c -width 700 -height 700 -background white]
set hex 0
for {set i 30} {$i<700} {incr i 40} {
.c create line $i 30 $i 670
.c create line 30 $i 670 $i
if {$hex < 16} {
.c create text [expr $i+20] 15 -text [format %02X $hex]
.c create text 15 [expr $i+20] -text [format %01X0 $hex]
incr hex
}
}
set encoding [lindex $argv 0]
.c create text 30 680 -text "Encoding: $encoding" -anchor w
set font {Courier 16 bold}
for {set row 0} {$row < 16} {incr row} {
for {set col 0} {$col < 16} {incr col} {
set i [expr $row*16+$col]
set c [encoding convertfrom $encoding [format %c $i]]
if {[encoding'literally $encoding $c] ne "0000"} {
.c create text [expr $col*40+50] [expr $row*40+44] -text $c -font $font
set unicode [format %04X [scan $c %c]]
.c create text [expr $col*40+50] [expr $row*40+62] -text $unicode
} elseif {$i > 0 } {
.c create rect [expr $col*40+30] [expr $row*40+30] \
[expr $col*40+70] [expr $row*40+70] -stipple gray25 -fill black
}
}
}
#-- produce screenshot as GIF image
after 100 {
[image create photo -data .c] write $encoding.gif -format GIF
}VK 2005-10-21: Way good... following comments: instead of last block 'after 100', why not to be a button:
pack [button .b -text {produce screenshot as GIF image} -command {
image create photo im1 -data .c
im1 write $encoding.gif -format GIF
}]PYK 2017-08-19: Tcl doesn't fall back to iso-8859-1, but when it encounters an invalid byte sequence in some encoding, it uses the Unicode code point having the number represented by that byte. The first 256 Unicode code points correspond to ascii and iso-8859-1, so those are the characters that show up for code points that are undefined in a single-byte encoding.See also:
