Encoding table generator

Richard Suchenwirth 2005-10-21 - As work required me to modify encodings, I needed a way to visualize what I had done. The following code works for one-byte encodings, which is all I need, and creates a 16x16 table on a canvas, filling each with the glyph and the hexadecimal Unicode of one of the 256 code points in a given encoding.

For convenience, a "screen shot" is also taken and written as GIF image in the current directory (this requires the Img extension). This version is updated so it really reads the encoding file, and grays out a field (except 00) if "0000" is specified there. Otherwise, Tcl's encoding convertfrom seems to fall through to iso8859-1 ...

 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 21-oct-2005 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
 }]

Category Characters | Arts and crafts of Tcl-Tk programming