if 0 {

The Windows charmap utility drives me crazy.  It has no way I can find to configure the size of the character display - you have to actually click on one and get the little pop-up in order to see the character.  Aside from the basic ascii characters, none of the characters are recognizable.

Okay, thanks to [AMucha] I have changed the code to remove the real bottleneck - huge numbers of font creations.  Sometimes you just need someone to point out the obvious.  It's ''much'' better now.

That said, his suggested code does not seem to work entirely right either.  See bottom for symptoms.

}

======
        package require Tk

        wm withdraw .

        proc setfont { { name1 "" } { name2 "" } { op "" } } {
          set fontname [ file tail [ file rootname $::curfont ] ]
 #tk_dialog .info curfont "curfont=$fontname" "" 0 OK
          font configure utf8font_16 -family $fontname
          font configure utf8font_24 -family $fontname
        }

        font create utf8font_16 -family Tahoma -size 16
        font create utf8font_24 -family Tahoma -size 24
        set curfont "Tahoma.ttf"

        proc relabel { args } {
          set ::lastscr ""
          set row $::currow
          for { set i 0 } { $i < 200 } { incr i } {
                set r [ expr { int($i/20)+1 } ]
                set c [ expr { ($i%20)+1 } ]
                if { $c == 1 } { .top.rowlbl$r configure \
                        -text [ format %04X [expr {$row+$i}]]
                }
                set text [ format %04X [expr {$row+$i}]]
                if { "0x$text" > "0xffff" } { set text "" } else { eval set char "\\u$text" }
                .top.btn-$r-$c configure -text $char -font utf8font_16
          }
        }

        proc insert { w } {
          set char [ $w cget -text ]
          .top.entry insert end $char
        }

        set currow 0
        toplevel .top
 #bind .top <ButtonPress-3> {tk_dialog .info curfont "curfont=$::curfont ([ file tail [ file rootname $::curfont ] ])" "" 0 OK}
        wm protocol .top WM_DELETE_WINDOW { exit }
        # set fontlist [ glob C:/WINDOWS/Fonts/\*  ] (lpz 2012 06 25)
        set fontlist [ glob [file join $::env(Systemroot) Fonts *] ]
        ttk::combobox .top.fontlist -textvariable ::curfont \
          -state readonly -values $fontlist -width 36
        bind .top.fontlist <<ComboboxSelected>> setfont
        label .top.font -text "Font: " -anchor w
        grid .top.font -row 0 -column 0 -sticky e
        grid .top.fontlist -row 0 -column 1 -columnspan 21 \
          -sticky snew
        for {  set i 1 } { $i <= 20 } { incr i } {
          for { set j 1 } { $j <= 10 } { incr j } {
        button .top.btn-$j-$i -width 1 -text "x" \
          -command [ list insert .top.btn-$j-$i ] \
          -font utf8font_16
                grid .top.btn-$j-$i -row $j -column $i -sticky snew
          }
        }
        for { set i 1 } { $i <= 10 } { incr i } {
          label .top.rowlbl$i -text "NNNN"
          grid .top.rowlbl$i -row $i -column 0
        }
        scale .top.scale -showvalue 0 -from 0x0000 -to [expr {0xffff-200}] \
          -variable currow -resolution 200
        bind .top.scale <ButtonRelease-1> relabel
        grid .top.scale -row 1 -rowspan 11 -column 21 -sticky ns

        label .top.copy -text "Copy:"
        grid .top.copy -row 11 -column 0 -sticky e

        entry .top.entry -font utf8font_24
        grid .top.entry -row 11 -column 1 -columnspan 21 -sticky nsew
        relabel
======

----
if 0 {

[AMucha] 2009 June 04

   1. '''Always''' brace your expressions!
Hey, "Quick and Dirty, remember? =)

[AMG]: Braced [expr]essions run quicker. :^)

   1. You create 200 distinct fonts with each call to relabel! (put the line with "font create" before the for-loop)
Carp.  I knew it had to be something obvious.

   1. Better still you should use a named font 
 font create utf8font_16 -family Tahoma -size 16
 font create utf8font_24 -family Tahoma -size 24
 # in your bouttons you use
   button .top.btn-$j-$i -width 1 -text "x" \
      -command [ list insert .top.btn-$j-$i ] \
      -font utf8font_16
 # if your font changes you only say (once!)
 font configure utf8font_16 -family [ file rootname $::curfont ]
 # and automagicaly all your buttons use the new font

Okay, the above code now reflects that.  It has the following problems:
   * Selecting a font from the combobox does not trigger the trace on curfont.
   * Adding a binding for the <<ComboboxSelected>> virtual event forces the call to setfont, but even though the font is being set as you suggested, it is not reflected in the display.  The display does seem to change, but not to the requested font.
   * I have added a debug line to display curfont when button-3 is pressed.  It shows the correct values.

.
   1. Read the manpage about "font families". Your code will then work with computers without a C:/WINDOWS/Fonts/ directory.

}

----

[JFL] A very useful tool. Thanks for contributing it!

Here's an update with the following changes:

   * Made the number of rows and the number of columns configurable in global variables.
   * Changed the default from 20x10 to 32x16. (ASCII sequences look much better, but requires a large display)
   * Simplified relabel: Using two nested loops instead of one. (Allows removing all math)
   * Renamed row counters as r, and column counters as c, everywhere. (For consistency)
   * Gave a fixed size to all buttons: -width 2 -height 1 (Avoids jerks on PgUp/PgDn ; Large non-ASCII characters look much better.)
   * Added key bingings for scrolling the list with the keyboard.

======
set nCols 32 ; # Number of columns displayed
set nRows 16 ; # Number of rows displayed

set nPerScreen [expr $nCols * $nRows]
set nColsPlus1 [expr $nCols + 1]
set nRowsPlus1 [expr $nRows + 1]

package require Tk

wm withdraw .

proc setfont { { name1 "" } { name2 "" } { op "" } } {
  set fontname [ file tail [ file rootname $::curfont ] ]
  # tk_dialog .info curfont "curfont=$fontname" "" 0 OK
  font configure utf8font_16 -family $fontname
  font configure utf8font_24 -family $fontname
}

font create utf8font_16 -family Tahoma -size 16
font create utf8font_24 -family Tahoma -size 24
set curfont "Tahoma.ttf"

proc relabel { args } {
  set ::lastscr ""
  set i $::currow
  for { set r 1 } { $r <= $::nRows } { incr r } {
    .top.rowlbl$r configure -text [ format %04X $i ]
    for { set c 1 } { $c <= $::nCols } { incr c ; incr i } {
      set text [ format %04X $i ]
      if { "0x$text" > "0xffff" } { set char "" } else { eval set char "\\u$text" }
      .top.btn-$r-$c configure -text $char -font utf8font_16
    }
  }
}

proc insert { w } {
  set char [ $w cget -text ]
  .top.entry insert end $char
}

set currow 0
toplevel .top
# bind .top <ButtonPress-3> {tk_dialog .info curfont "curfont=$::curfont ([ file tail [ file rootname $::curfont ] ])" "" 0 OK}
wm protocol .top WM_DELETE_WINDOW { exit }
set fontlist [ glob C:/WINDOWS/Fonts/\* ]
ttk::combobox .top.fontlist -textvariable ::curfont \
  -state readonly -values $fontlist -width 36
bind .top.fontlist <<ComboboxSelected>> setfont
label .top.font -text "Font: " -anchor w
grid .top.font -row 0 -column 0 -sticky e
grid .top.fontlist -row 0 -column 1 -columnspan $nColsPlus1 -sticky snew
for { set r 1 } { $r <= $nRows } { incr r } {
  for { set c 1 } { $c <= $nCols } { incr c } {
    button .top.btn-$r-$c -width 2 -height 1 -text "x" \
           -command [ list insert .top.btn-$r-$c ] \
           -font utf8font_16
    grid .top.btn-$r-$c -row $r -column $c -sticky snew
  }
}
for { set r 1 } { $r <= $nRows } { incr r } {
  label .top.rowlbl$r -text "NNNN"
  grid .top.rowlbl$r -row $r -column 0
}
scale .top.scale -showvalue 0 -from 0x0000 -to [expr {0xffff-$nPerScreen}] \
  -variable currow -resolution $nPerScreen
bind .top.scale <ButtonRelease-1> relabel
grid .top.scale -row 1 -rowspan $nRows -column $nColsPlus1 -sticky ns

bind .top <Home> {set currow 0 ; relabel}
bind .top <Prior> {incr currow [expr -$nPerScreen] ; if {$currow < 0} {set currow 0} ; relabel}
bind .top <Up> {incr currow [expr -$nCols] ; if {$currow < 0} {set currow 0} ; relabel}
bind .top <Down> {incr currow $nCols ; relabel}
bind .top <Next> {incr currow $nPerScreen ; relabel}
bind .top <End> {set currow [expr {0x10000-$nPerScreen}] ; relabel}

label .top.copy -text "Copy:"
grid .top.copy -row $nRowsPlus1 -column 0 -sticky e

entry .top.entry -font utf8font_24
grid .top.entry -row $nRowsPlus1 -column 1 -columnspan $nColsPlus1 -sticky nsew
relabel
======
----
[MHo] 2009-06-22: 
======
   set fontlist [ glob C:/WINDOWS/Fonts/\* ]
======
could be rewritten as
======
   set fontlist [ glob [file join $::env(Systemroot) Fonts *] ]
======
to make it a little more independent from the characteristic of the windows installation.


<<categories>> Application | Human Language