Version 5 of iKey: a tiny multilingual keyboard

if 0 {Richard Suchenwirth 2002-02-27 - Combining two of my favorite topics, i18n and the iPaq, here is a little study of a pen-pad keyboard for non-Latin writing systems. Windows/CE offers you a virtual keyboard among other input methods, but that is limited to your local locale. If I want to enter e.g. Greek, I have to go through some trouble - or do it in Tcl, of course ;-)

I could not use an overrided toplevel, so the current setup requires a canvas widget. In a global array, the alphabets of possible languages is stored. If you call iKey with one, the characters (plus some punctuation and special characters) are displayed on the canvas, which the caller has to provide (most sensibly 240 wide, 80 high). Tap on one, and it briefly flashes red and is inserted into the widget which has focus. Special characters are "_" which makes a space, and "<" which deletes the last character. For Hebrew, the cursor is moved left after insertion, to facilitate right-to-left writing. }

 proc ikey {c language} {
    set keys $::ikey($language)
    set f {{Bitstream Cyberbit} 10 bold}
    set x 7; set y 7
    $c delete all
    foreach key [clist $keys] {
       $c create text $x $y -text $key -tag ikey \
          -font $f
       if [incr x 15]>220 {set x 7; incr y 15}
    }
    $c bind ikey <1> {
      %W itemconf current -fill red
      after 200 "%W itemconf current -fill black"
      set c [%W itemcget current -text]
      if {$c=="<"} {
          event generate . <BackSpace>
      } else {
         if {$c=="_"} {set c " "}
         catch {[focus] insert insert $c }
         if {$c>="\u05d0" && $c<="\u05ea"} {
            event generate . <Left>
         }
      }
    }
 }

if 0 {This routine turns a compact character list, e.g. {a-d fx z} into a regular one: {a b c d f x z}.}

 proc clist list {
    set res ""
    foreach item [lappend list "_,;.<"] {
        if [regexp {^(.)-(.)$} $item -> from to] {
          scan $to %c to
           for {set i [scan $from %c]} {$i<=$to} {incr i} {
              lappend res [format %c $i]
           }
        } else {
           foreach i [split $item ""] {lappend res $i }
        }
    }
    set res
 }
 array set ::ikey {
  Cyrillic {\u0410-\u044f}
  Greek {1-9 0 - \u0391-\u03a1 \u03a3-\u03c9}
  Hebrew {\u05d0-\u05ea}
 }

if 0 {For demo and self-test, here is a micro-app with an entry and a text, which have no function other than testing that focus is correct:}

 if {[file tail [info script]]==[file tail $argv0]} {
    option add *Font {{Bitstream Cyberbit} 10}
    entry .e
    text .t -height 8 -width 1
    canvas .c -width 240 -height 80 -bg yellow
    pack .e .t .c -fill x
    focus .t
    ikey .c Greek
    bind . <Return> {exec wish $argv0 &; exit}
    . config -menu [menu .m]
    .m add casc -label Language -menu [menu .m.l -tearoff 0]
    foreach i [array names ikey] {
      .m.l add comm -label $i -command "ikey .c $i"
    }
 }

PocketPC | Arts and crafts of Tcl-Tk programming