util/X86LINUX64/lib/tk8.6/demos/unicodeout.tcl

   1 # unicodeout.tcl --
   2 #
   3 # This demonstration script shows how you can produce output (in label
   4 # widgets) using many different alphabets.
   5
   6 if {![info exists widgetDemo]} {
   7     error "This script should be run from the \"widget\" demo."
   8 }
   9
  10 package require Tk
  11
  12 set w .unicodeout
  13 catch {destroy $w}
  14 toplevel $w
  15 wm title $w "Unicode Label Demonstration"
  16 wm iconname $w "unicodeout"
  17 positionWindow $w
  18
  19 label $w.msg -font $font -wraplength 4i -anchor w -justify left \
  20         -text "This is a sample of Tk's support for languages that use\
  21         non-Western character sets.  However, what you will actually see\
  22         below depends largely on what character sets you have installed,\
  23         and what you see for characters that are not present varies greatly\
  24         between platforms as well.  The strings are written in Tcl using\
  25         UNICODE characters using the \\uXXXX escape so as to do so in a\
  26         portable fashion."
  27 pack $w.msg -side top
  28
  29 ## See Code / Dismiss buttons
  30 set btns [addSeeDismiss $w.buttons $w]
  31 pack $btns -side bottom -fill x
  32
  33 ## The frame that will contain the sample texts.
  34 pack [frame $w.f] -side bottom -expand 1 -fill both -padx 2m -pady 1m
  35 grid columnconfigure $w.f 1 -weight 1
  36 set i 0
  37 proc addSample {w language args} {
  38     global font i
  39     set sample [join $args ""]
  40     set j [incr i]
  41     label $w.f.l$j -font $font -text "${language}:" -anchor nw -pady 0
  42     label $w.f.s$j -font $font -text $sample -anchor nw -width 30 -pady 0
  43     grid $w.f.l$j $w.f.s$j -sticky ew -pady 0
  44     grid configure $w.f.l$j -padx 1m
  45 }
  46
  47 ## A helper procedure that determines what form to use to express languages
  48 ## that have complex rendering rules...
  49 proc usePresentationFormsFor {language} {
  50     switch [tk windowingsystem] {
  51         aqua {
  52             # OSX wants natural character order; the renderer knows how to
  53             # compose things for display for all languages.
  54             return false
  55         }
  56         x11 {
  57             # The X11 font renderers that Tk supports all know nothing about
  58             # composing characters, so we need to use presentation forms.
  59             return true
  60         }
  61         win32 {
  62             # On Windows, we need to determine whether the font system will
  63             # render right-to-left text. This varies by language!
  64             try {
  65                 package require registry
  66                 set rkey [join {
  67                     HKEY_LOCAL_MACHINE
  68                     SOFTWARE
  69                     Microsoft
  70                     {Windows NT}
  71                     CurrentVersion
  72                     LanguagePack
  73                 } \\]
  74                 return [expr {
  75                     [string toupper $language] ni [registry values $rkey]
  76                 }]
  77             } trap error {} {
  78                 # Cannot work it out, so use presentation forms.
  79                 return true
  80             }
  81         }
  82         default {
  83             # Default to using presentation forms.
  84             return true
  85         }
  86     }
  87 }
  88
  89 ## Processing when some characters are not currently cached by the display
  90 ## engine might take a while, so make sure we're displaying something in the
  91 ## meantime...
  92 pack [label $w.wait -text "Please wait while loading fonts..." \
  93         -font {Helvetica 12 italic}]
  94 set oldCursor [$w cget -cursor]
  95 $w conf -cursor watch
  96 update
  97
  98 ## Add the samples...
  99 if {[usePresentationFormsFor Arabic]} {
 100     # Using presentation forms (pre-layouted)
 101     addSample $w Arabic \
 102             "\uFE94\uFEF4\uFE91\uFEAE\uFECC\uFEDF\uFE8D " \
 103             "\uFE94\uFEE4\uFEE0\uFEDC\uFEDF\uFE8D"
 104 } else {
 105     # Using standard text characters
 106     addSample $w Arabic \
 107             "\u0627\u0644\u0643\u0644\u0645\u0629 " \
 108             "\u0627\u0644\u0639\u0631\u0628\u064A\u0629"
 109 }
 110 addSample $w "Trad. Chinese"  "\u4E2D\u570B\u7684\u6F22\u5B57"
 111 addSample $w "Simpl. Chinese" "\u6C49\u8BED"
 112 addSample $w French "Langue fran\u00E7aise"
 113 addSample $w Greek \
 114          "\u0395\u03BB\u03BB\u03B7\u03BD\u03B9\u03BA\u03AE " \
 115          "\u03B3\u03BB\u03CE\u03C3\u03C3\u03B1"
 116 if {[usePresentationFormsFor Hebrew]} {
 117     # Visual order (pre-layouted)
 118     addSample $w Hebrew \
 119             "\u05EA\u05D9\u05E8\u05D1\u05E2 \u05D1\u05EA\u05DB"
 120 } else {
 121     # Standard logical order
 122     addSample $w Hebrew \
 123             "\u05DB\u05EA\u05D1 \u05E2\u05D1\u05E8\u05D9\u05EA"
 124 }
 125 addSample $w Hindi \
 126     "\u0939\u093f\u0928\u094d\u0926\u0940 \u092d\u093e\u0937\u093e"
 127 addSample $w Icelandic "\u00CDslenska"
 128 addSample $w Japanese \
 129          "\u65E5\u672C\u8A9E\u306E\u3072\u3089\u304C\u306A, " \
 130          "\u6F22\u5B57\u3068\u30AB\u30BF\u30AB\u30CA"
 131 addSample $w Korean "\uB300\uD55C\uBBFC\uAD6D\uC758 \uD55C\uAE00"
 132 addSample $w Russian \
 133         "\u0420\u0443\u0441\u0441\u043A\u0438\u0439 \u044F\u0437\u044B\u043A"
 134
 135 ## We're done processing, so change things back to normal running...
 136 destroy $w.wait
 137 $w conf -cursor $oldCursor