This ''is'' a ''working solution'' <
>
هذا حل فعلا يعمل و هو سهل الاستعمال <
>
The following procedure render_arabic does not completely solve the rendering the Arabic characters to be fully connected. <
>
However, it ''does'' reach the wanted target and goal of making the Arabic smoothly readable.<
>
So you can now type in the code as such:
======
set arabic_rendered_sentence [ render_arabic "مرحبا بكم"]
======
Then get in your Tk something very near to the following result.<
>
Please just understand I am using the text to explain and imagine it with the spaces are just only one millimeter wide.
======
مـ ر حـ بـا بـ كم
======
Download the script http://superlinux.net/downloads/render-arabic.tar.gz%|%here%|%
This video on YouTube explains how it works:<
>
http://youtu.be/ptaQauSBXd0l%|%Render Arabic Language Characters in TCL and Tk%|%
======
#!/usr/bin/wish
#Code written by Rani Fayez Ahmad (Superlinux)
#Website: http://www.superlinux.net
#a procedure to make Arabic readable when displayed in a Tk widget.
proc render_arabic { arabic_string } {
#The given of the problem is an Arabic sentence
#Break the sentence into words
set words [ split $arabic_string ]
#Display the sentence they TCL receives it
#The problem is:
#TCL receives the Arabic letters: (i) in the reverse order (ii) disconnected
#we want to re-render the Arabic to be displayed correctly
#tk_messageBox -message $words
#$count is the word index in the Arabic sentence
set count 0
#the following is just an example of how to get an arabic character index number in the unicode character charts
#set z {} ; foreach el [split "لـ" {}] {puts [scan $el %c]}
#foreach word in the Arabic sentence
foreach word $words {
#if the currently processed word is completely a Latin/russian/Greek or in another meaning completely an ASCI word,
# simply skip this word and move to the next. we only want to find Arabic words completely
if {[string is ascii $word]==1} {
incr count
continue
}
#1-get the sub-string in the word without the last letter
#we will deal with the connection of the last letter later
set sub_word [string range $word 0 end-1]
#All the letters from baa2 to yaa2 when they are NOT the last letter;
#TCL initially has and reads them in their isolated form as in ل م س;
#they must be converted into their initial form e.g لـ مـ سـ
#so replace and convert every occurrence of each of such letters
set sub_word [ string map {"\u0628" \ufe91} $sub_word] ;#ba2 ب
set sub_word [ string map {"\u062A" \ufe97} $sub_word] ;#Ta2 ت
set sub_word [ string map {"\u062B" \ufe9b} $sub_word] ;#thaa2 ث
set sub_word [ string map {"\u062C" \ufe9f} $sub_word] ;#Jeem ج
set sub_word [ string map {"\u062d" \ufea3} $sub_word] ;#7aa2 ح
set sub_word [ string map {"\u062e" \ufeA7} $sub_word] ;#5aa2 خ
set sub_word [ string map {"\u0633" \ufeb3} $sub_word] ;#seen س
set sub_word [ string map {"\u0634" \ufeb7} $sub_word] ;#sheen ش
set sub_word [ string map {"\u0635" \ufebb} $sub_word] ;#SSaad ص
set sub_word [ string map {"\u0636" \ufebf} $sub_word] ;#DDhahd ض
set sub_word [ string map {"\u0637" \ufec3} $sub_word] ;#TTaa2 ط
set sub_word [ string map {"\u0638" \ufec7} $sub_word] ;#tthaa2 Zah ظ
set sub_word [ string map {"\u0639" \ufeCb} $sub_word] ;#3eyn ع
set sub_word [ string map {"\u063A" \ufeCF} $sub_word] ;#ghyn غ
set sub_word [ string map {"\u0641" \ufeD3} $sub_word] ;#faa2 ف
set sub_word [ string map {"\u0642" \ufeD7} $sub_word] ;#quaaf ق
set sub_word [ string map {"\u0643" \ufeDb} $sub_word] ;#kaaf ك
set sub_word [ string map {"\u0644" \ufedf} $sub_word] ;#lam ل
set sub_word [ string map {"\u0645" \ufee3} $sub_word] ;#meem م
set sub_word [ string map {"\u0646" \ufee7} $sub_word] ;#noon ن
set sub_word [ string map {"\u0647" \ufeeb} $sub_word] ;#haa2 هـ
set sub_word [ string map {"\u064A" \ufef3} $sub_word] ;#yaa2 ي
set sub_word [ string map {"\u0626" \ufe8b} $sub_word] ;#hamza 3ala nabera (initial form of yaa2) ئـ
#now replace the whole part of the word that excludes the last letter
#with the conversion done above
set word [string replace $word 0 end-1 $sub_word]
#The following list of characters are the characters initial form mentioned above + the tatweel character
set initials [list \u0640 \ufe90 \ufe97 \ufe9b \ufe9f \ufea3 \ufeA7 \ufb3 \ufeb7 \ufebb \ufebf \ufec3 \ufec7 \ufeCb \ufeCF \ufeD3 \ufeD7 \ufeDb \ufedf \ufee3 \ufee7 \ufeeb \ufef3]
#find the character before the last.
set before_last_char [ string index $word end-1 ]
#for debugging purposes just print the character before the last.
puts $before_last_char
#and try to see if the character before the last is an element of the list $initials defined in the previous line.
#and if it's true, then convert the last character to it's final linked form
#this way they will be joined
if { [lsearch -ascii -inline $initials $before_last_char ] == $before_last_char } {
#now get also last character
set last_character [ string index $word end]
#print it for debugging purposes
puts $last_character
#just to make sure that we we are matching correctly print the Unicode index number of the character
puts [scan $last_character %c]
#now convert the last character into its final linked form
switch -- $last_character {
\u0627 {
#baa2
set word [ string replace $word end end \ufe8e ]
}
\u0628 {
#baa2
set word [ string replace $word end end \ufe90 ]
}
\u0629 {
#taa2 marbootta
set word [ string replace $word end end \ufe94]
}
\u062A {
#ta2 maftoo7a
set word [ string replace $word end end \ufe96 ]
}
\u062B {
#thaa2
set word [ string replace $word end end \ufe9A ]
}
\u062c {
#jeem
set word [ string replace $word end end \ufe9e ]
puts $word
}
\u062d {
#7aa2
set word [ string replace $word end end \ufeA2 ]
}
\u062e {
#5aa2
set word [ string replace $word end end \ufea6 ]
}
\u062f {
#dal
set word [ string replace $word end end \ufeaa ]
}
\u0630 {
#tthal
set word [ string replace $word end end \ufeac ]
}
\u0631 {
#raa2
set word [ string replace $word end end \ufeae ]
}
\u0632 {
#zyn
set word [ string replace $word end end \ufeaf ]
}
\u0633 {
#seen
set word [ string replace $word end end \ufeb2 ]
}
\u0634 {
#sheen
set word [ string replace $word end end \ufeb6 ]
}
\u0635 {
#ssaad
set word [ string replace $word end end \ufeba ]
}
\u0636 {
#ddaad
set word [ string replace $word end end \ufebe ]
}
\u0637 {
#ttaa2
set word [ string replace $word end end \ufec2 ]
}
\u0638 {
#tthaa2
set word [ string replace $word end end \ufec8 ]
}
\u0639 {
#3ayn
set word [ string replace $word end end \ufeca ]
}
\u063a {
#ghyn
set word [ string replace $word end end \ufece ]
}
\u0641 {
#faa2
set word [ string replace $word end end \ufed2 ]
}
\u0642 {
#quaaf
set word [ string replace $word end end \ufed6 ]
}
\u0643 {
#kaaf
set word [ string replace $word end end \ufeda ]
}
\u0644 {
#laam
set word [ string replace $word end end \ufede ]
}
\u0645 {
#meem
set word [ string replace $word end end \ufee2 ]
}
\u0646 {
#noon
set word [ string replace $word end end \ufee6 ]
}
\u0647 {
#haa2
set word [ string replace $word end end \ufeea ]
}
\u0648 {
#waaw
set word [ string replace $word end end \ufeee ]
}
\u0624 {
#waaw with hamza above
set word [ string replace $word end end \ufe86 ]
}
\u0649 {
#alef maqsura
set word [ string replace $word end end \ufef0 ]
}
\u064a {
#yaa2
set word [ string replace $word end end \ufef1 ]
}
default {
#default is nothing to do
}
}
} ;# end of if the character before the last is a member of the list $initials
#now reverse the word for correct displaying on the screen
set word [ string reverse $word]
#add and replace the corrected/conversion-of word with malformed one. in the Arabic sentence
#the whole words in the sentence yet are still in the reverse order
lset words $count $word
#move to the next word
incr count
}
#reverse the order of the list of words of the Arabic sentence and join them into one string.
set words [join [ lreverse $words] ]
#The following line is left for you to see the final result. just remove the comment sign (#)
#tk_messageBox -message $words
return $words
}
#The following is for testing the [proc render_arabic]
#the Arabic sentence means in English :
#The program is not available or changeable (it should be here the word "NOT" (غير) instead of "CHANGEABLE" (متغير) but for debugging purposes there's an additional character) exists/existed
set msg [render_arabic "الـبـرنـامـج غـيـر مـتـوفـر او مـتـغـيـر مـوجـود حـالئـيـا"]
tk_messageBox -detail $msg
======
<> Natural languages | Human Language | Arts and Crafts of Tcl-Tk Programming | Arabic Language |اللغة العربية في TCL/Tk