unicodeout.tcl 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114
  1. # unicodeout.tcl --
  2. #
  3. # This demonstration script shows how you can produce output (in label
  4. # widgets) using many different alphabets.
  5. if {![info exists widgetDemo]} {
  6. error "This script should be run from the \"widget\" demo."
  7. }
  8. package require Tk
  9. # On Windows, we need to determine whether the font system will render
  10. # right-to-left text.
  11. if {[tk windowingsystem] eq {win32}} {
  12. set rkey [join {
  13. HKEY_LOCAL_MACHINE
  14. SOFTWARE
  15. Microsoft
  16. {Windows NT}
  17. CurrentVersion
  18. LanguagePack
  19. } \\]
  20. set w32langs {}
  21. if {![catch {package require registry}]} {
  22. if {[catch {registry values $rkey} w32langs]} {
  23. set w32langs {}
  24. }
  25. }
  26. }
  27. set w .unicodeout
  28. catch {destroy $w}
  29. toplevel $w
  30. wm title $w "Unicode Label Demonstration"
  31. wm iconname $w "unicodeout"
  32. positionWindow $w
  33. label $w.msg -font $font -wraplength 4i -anchor w -justify left \
  34. -text "This is a sample of Tk's support for languages that use\
  35. non-Western character sets. However, what you will actually see\
  36. below depends largely on what character sets you have installed,\
  37. and what you see for characters that are not present varies greatly\
  38. between platforms as well. The strings are written in Tcl using\
  39. UNICODE characters using the \\uXXXX escape so as to do so in a\
  40. portable fashion."
  41. pack $w.msg -side top
  42. ## See Code / Dismiss buttons
  43. set btns [addSeeDismiss $w.buttons $w]
  44. pack $btns -side bottom -fill x
  45. pack [label $w.wait -text "Please wait while loading fonts..." \
  46. -font {Helvetica 12 italic}]
  47. pack [frame $w.f] -expand 1 -fill both -padx 2m -pady 1m
  48. grid columnconfigure $w.f 1 -weight 1
  49. set i 0
  50. proc addSample {w language args} {
  51. global font i
  52. set sample [join $args ""]
  53. set j [incr i]
  54. label $w.f.l$j -font $font -text "${language}:" -anchor nw -pady 0
  55. label $w.f.s$j -font $font -text $sample -anchor nw -width 30 -pady 0
  56. grid $w.f.l$j $w.f.s$j -sticky ew -pady 0
  57. grid configure $w.f.l$j -padx 1m
  58. }
  59. # Processing when some characters are missing might take a while, so make
  60. # sure we're displaying something in the meantime...
  61. set oldCursor [$w cget -cursor]
  62. $w conf -cursor watch
  63. update
  64. if {[tk windowingsystem] eq {x11}
  65. || (([tk windowingsystem] eq {win32}) && ({ARABIC} ni $w32langs))} {
  66. # Using presentation forms (pre-layouted)
  67. addSample $w Arabic \
  68. "\uFE94\uFEF4\uFE91\uFEAE\uFECC\uFEDF\uFE8D " \
  69. "\uFE94\uFEE4\uFEE0\uFEDC\uFEDF\uFE8D"
  70. } else {
  71. # Using standard text characters
  72. addSample $w Arabic \
  73. "\u0627\u0644\u0643\u0644\u0645\u0629 " \
  74. "\u0627\u0644\u0639\u0631\u0628\u064A\u0629"
  75. }
  76. addSample $w "Trad. Chinese" "\u4E2D\u570B\u7684\u6F22\u5B57"
  77. addSample $w "Simpl. Chinese" "\u6C49\u8BED"
  78. addSample $w Greek \
  79. "\u0395\u03BB\u03BB\u03B7\u03BD\u03B9\u03BA\u03AE " \
  80. "\u03B3\u03BB\u03CE\u03C3\u03C3\u03B1"
  81. if {[tk windowingsystem] eq {x11}
  82. || (([tk windowingsystem] eq {win32}) && ({HEBREW} ni $w32langs))} {
  83. # Visual order (pre-layouted)
  84. addSample $w Hebrew \
  85. "\u05EA\u05D9\u05E8\u05D1\u05E2 " \
  86. "\u05D1\u05EA\u05DB"
  87. } else {
  88. # Standard logical order
  89. addSample $w Hebrew \
  90. "\u05DB\u05EA\u05D1 " \
  91. "\u05E2\u05D1\u05E8\u05D9\u05EA"
  92. }
  93. addSample $w Japanese \
  94. "\u65E5\u672C\u8A9E\u306E\u3072\u3089\u304C\u306A, " \
  95. "\u6F22\u5B57\u3068\u30AB\u30BF\u30AB\u30CA"
  96. addSample $w Korean "\uB300\uD55C\uBBFC\uAD6D\uC758 \uD55C\uAE00"
  97. addSample $w Russian \
  98. "\u0420\u0443\u0441\u0441\u043A\u0438\u0439 \u044F\u0437\u044B\u043A"
  99. # We're done processing, so change things back to normal running...
  100. destroy $w.wait
  101. $w conf -cursor $oldCursor