Scid  4.7.0
•All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros
language.tcl
Go to the documentation of this file.
1 ### lang.tcl: Support for multiple-language menus, buttons, etc.
2 ### Part of Scid, which is Copyright 2001-2003 Shane Hudson.
3 
4 array set langEncoding {}
5 set languages {}
6 
7 if {[catch {encoding names}]} {
8  set hasEncoding 0
9 } else {
10  set hasEncoding 1
11 }
12 ################################################################################
13 # Translation of pieces
14 # Note to adopt also tkscid.cpp to allow for a new langauge as well
15 # as add transPieces to langPieces[] in game.cpp
16 ################################################################################
17 array set transPieces {}
18 
19 set transPieces(F) { P P K R Q D R T B F N C }
20 set untransPieces(F) { P P R K D Q T R F B C N }
21 set transPieces(S) { P P K R Q D R T B A N C }
22 set untransPieces(S) { P P R K D Q T R A B C N }
23 set transPieces(D) { P B K K Q D R T B L N S }
24 set untransPieces(D) { B P K K D Q T R L B S N }
25 set transPieces(I) { P P K R Q D R T B A N C }
26 set untransPieces(I) { P P R K D Q T R A B C N }
27 set transPieces(N) { P p K K Q D R T B L N P }
28 set untransPieces(N) { p P K K D Q T R L B P N }
29 set transPieces(C) { P P K K Q D R V B S N J }
30 set untransPieces(C) { P P K K D Q V R S B J N }
31 ## TODO Put in the right letters for greek
32 set transPieces(G) { P B K K Q D R T B L N S }
33 set untransPieces(G) { B P K K D Q T R L B S N }
34 set transPieces(H) { P G K K Q V R B B F N H }
35 set untransPieces(H) { G P K K V Q B R F B H N }
36 set transPieces(O) { P B K K Q D R T B L N S }
37 set untransPieces(O) { B P K K D Q T R L B S N }
38 set transPieces(W) { P B K K Q D R T B L N S }
39 set untransPieces(W) { B P K K D Q T R L B S N }
40 set transPieces(K) { P P K R Q D R T B A N C }
41 set untransPieces(K) { P P R K D Q T R A B C N }
42 set transPieces(U) { P S K K Q D R T B L N R }
43 set untransPieces(U) { S P K K D Q T R L B R N }
44 
45 ################################################################################
46 proc trans { msg } {
47  if { $::language == "E" || ! $::translatePieces || $msg == "\[end\]"} {
48  return $msg
49  }
50  if { [ catch { set t [string map $::transPieces($::language) $msg]}] } {
51  return $msg
52  }
53  return $t
54 }
55 ################################################################################
56 proc untrans { msg } {
57  if { $::language == "E" || ! $::translatePieces || $msg == "\[end\]"} {
58  return $msg
59  }
60  if { [ catch { set t [string map $::untransPieces($::language) $msg]}] } {
61  return $msg
62  }
63  return $t
64 }
65 ################################################################################
66 #
67 ################################################################################
68 proc addLanguage {letter name underline encodingSystem filename} {
69  lappend ::languages $letter
70  set ::langName($letter) $name
71  set ::langUnderline($letter) $underline
72  set ::langEncoding($letter) $encodingSystem
73  set ::langSourceFile($letter) $filename
74 }
75 ################################################################################
76 # menuText:
77 # Assigns the menu name and help message for a menu entry and language.
78 ################################################################################
79 proc menuText {lang tag label underline {helpMsg ""}} {
80  set ::menuLabel($lang,$tag) $label
81  set ::menuUnder($lang,$tag) $underline
82  if {$helpMsg != ""} {
83  set ::helpMessage($lang,$tag) $helpMsg
84  }
85 }
86 ################################################################################
87 # helpMsg:
88 # Assigns the help message for a particular language for a button.
89 # ################################################################################
90 proc helpMsg {lang button message} {
91  set ::helpMessage($lang,$button) $message
92 }
93 
94 array set tr {}
95 array set translations {}
96 ################################################################################
97 # translate:
98 # Assigns a translation for future reference.
99 ################################################################################
100 proc translate {lang tag label} {
101  regsub {\\n} $label "\n" label
102  set ::translations($lang,$tag) $label
103  set ::tr($tag) $label
104  foreach extra {":" "..."} {
105  set newtag "${tag}${extra}"
106  set newlabel "${label}${extra}"
107  set ::translations($lang,$newtag) $newlabel
108  set ::tr($newtag) $newlabel
109  }
110 }
111 ################################################################################
112 # translateECO:
113 # Given a pair list of ECO opening name phrase translations,
114 # assigns the translations for future reference.
115 ################################################################################
116 proc translateECO {lang pairList} {
117  foreach {from to} $pairList {
118  sc_eco translate $lang $from $to
119  }
120 }
121 ################################################################################
122 # tr:
123 # Given a tag and language, returns the stored text for that tag.
124 ################################################################################
125 proc tr {tag {lang ""}} {
126  global menuLabel tr
127  if {$lang == ""} {set lang $::language}
128  if {$lang == "X"} {return $tag}
129  # First, look for a menu label
130  if {[info exists menuLabel($lang,$tag)]} {
131  return $menuLabel($lang,$tag)
132  }
133  if {[info exists menuLabel(E,$tag)]} {
134  return $menuLabel(E,$tag)
135  }
136  # Now look for a regular button/message translation
137  if {[info exists tr($tag)]} {
138  return $tr($tag)
139  }
140  # Finally, just give up and return the original tag
141  return $tag
142 }
143 ################################################################################
144 #
145 ################################################################################
146 proc setLanguage {} {
147  global menuLabel menuUnder helpTitle helpText
148  set lang $::language
149 
150  if { $::translatePieces } {
151  switch $lang {
152  C {sc_info language cz}
153  D {sc_info language de}
154  F {sc_info language fr}
155  G {sc_info language gr}
156  H {sc_info language hu}
157  I {sc_info language it}
158  K {sc_info language ca}
159  N {sc_info language ne}
160  O {sc_info language no}
161  S {sc_info language es}
162  U {sc_info language fi}
163  W {sc_info language sw}
164  default {sc_info language en}
165  }
166  } else {
167  sc_info language en
168  }
169 
170  if {[catch {
171  if {[info exists ::langSourceFile($lang)]} {
172  source -encoding $::langEncoding($lang) [file nativename [file join "$::scidTclDir" "lang/$::langSourceFile($lang)"]]
173  unset ::langSourceFile($lang)
174  }
175  setLanguage_$lang
176  } err]} {
177  tk_messageBox -message "Error loading $lang language: $err"
178  }
179 
180  # If using Tk, translate all menus:
181  if {[winfo exists .menu]} { setLanguageMenus}
182  # update notation window
183  if {[winfo exists .pgnWin]} { ::pgn::Refresh 1}
184 
185  foreach i [array names ::tr] {
186  if {[info exists ::translations($lang,$i)]} {
187  set ::tr($i) $::translations($lang,$i)
188  } elseif {[info exists ::translations(E,$i)]} {
189  set ::tr($i) $::translations(E,$i)
190  }
191  }
192 }
193 ################################################################################
194 # Will switch language only for Scid backoffice, no UI
195 # Used to make callbacks use english by default
196 ################################################################################
197 proc setLanguageTemp { lang } {
198  switch $lang {
199  C {sc_info language cz}
200  D {sc_info language de}
201  F {sc_info language fr}
202  G {sc_info language gr}
203  H {sc_info language hu}
204  I {sc_info language it}
205  K {sc_info language ca}
206  N {sc_info language ne}
207  O {sc_info language no}
208  S {sc_info language es}
209  U {sc_info language fi}
210  W {sc_info language sw}
211  default {sc_info language en}
212  }
213 }
214 
215 addLanguage E English 0 iso8859-1 english.tcl
216 addLanguage K Català 2 iso8859-1 catalan.tcl
217 addLanguage C Czech 0 iso8859-2 czech.tcl
218 addLanguage D Deutsch 0 iso8859-1 deutsch.tcl
219 addLanguage F Francais 0 iso8859-1 francais.tcl
220 addLanguage G Greek 0 utf-8 greek.tcl
221 addLanguage H Hungarian 0 iso8859-2 hungary.tcl
222 addLanguage I Italian 0 iso8859-1 italian.tcl
223 addLanguage N Nederlands 0 iso8859-1 nederlan.tcl
224 addLanguage O Norsk 1 iso8859-1 norsk.tcl
225 addLanguage P Polish 0 iso8859-2 polish.tcl
226 addLanguage B {Brazil Portuguese} 0 iso8859-1 portbr.tcl
227 addLanguage R Russian 1 utf-8 russian.tcl
228 addLanguage Y Serbian 2 iso8859-2 serbian.tcl
229 addLanguage S Español 1 iso8859-1 spanish.tcl
230 addLanguage U Suomi 1 iso8859-1 suomi.tcl
231 addLanguage W Swedish 1 iso8859-1 swedish.tcl
232 
233 setLanguage
234 
235 ### End of file: lang.tcl
Generated by   doxygen 1.8.13