unicodeout.tcl 4.6 KB

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