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\xE7aise"
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 "\xCDslenska"
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  if {([tk windowingsystem] ne "x11") || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))} {
135      if {[package vsatisfies [package provide Tcl] 8.7-]} {
136  	addSample $w Emoji "😀💩👍🇳🇱"
137      } else {
138  	addSample $w Emoji \
139  		"\uD83D\uDE00\uD83D\uDCA9\uD83D\uDC4D\uD83C\uDDF3\uD83C\uDDF1"
140      }
141  }
142  
143  ## We're done processing, so change things back to normal running...
144  destroy $w.wait
145  $w conf -cursor $oldCursor