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 from within the code:<
> http://youtu.be/ptaQauSBXd0l%|%Render Arabic Language Words in TCL and Tk (Video Take 2) %|% If you are planning to do inputs, then do the following steps: * Use a [text] widget for your input . * Include to the start of your code the two the procedures mentioned below: [render_arabic $arabic_string] and [text_binding_for_rtl $text_widget_path $k ] * Of course, you would be using a number of [text] widgets. Therefore, make a list of your [text] widget windows paths like the following:<
> ====== set list_of_widget_window_paths [list .mytext1 .anotherText2 .toplevel.toplevel_text] ====== * Then you must [bind] all of the [text] widgets as follows:<
> ====== foreach text_widget_window_path $list_of_widget_window_paths { bind $text_widget_window_path [list text_binding_for_rtl %W %k] } ====== And you're done! See it in action here:<
>https://www.youtube.com/watch?v=_B7GhmSXRF8%|%Render Arabic Language Words in TCL and Tk (Video Take 3) %|% ---- ***The Required Procedures*** **** The script to render_arabic $arabic_string**** A procedure to make Arabic readable when displayed in a Tk widget. ====== #!/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 [string trim $arabic_string ]] #Display the sentence they TCL recieves it #The problem is: #TCL receives the arabic letters: (i) in the reverse order (ii) disconnected #we want to rerender 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 {[string is ascii $word]==1} { set original_ascii_word $word set reversed_ascii_word [ string reverse $original_ascii_word] set mapping [list $original_ascii_word $reversed_ascii_word] set arabic_string [ string map $mapping $arabic_string] incr count continue } # else { # set splits [split $word "!@#$%^&*()_+-=~`123456790/\\"] # if { [llength $splits] >1 } { # set split_counter 0 # foreach splitting $splits { # set splitting [render_arabic $splitting] # lset splits $split_counter $splitting # incr split_counter # } # set word [join splits] # incr count # continue # } # } #1-get the substring in the word without the last letter #we will deal with the connection of the last letter later set original_word $word 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 occurence 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 chacracter 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 chacracter 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] if { [string is ascii $last_character] ==1 } { set before_last_char [ render_arabic $before_last_char ] } # \u0627 { #aleph # set word [ string replace $word end end \ufe8e ] #} #now convert the last character into its final linked form switch -- $last_character { \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_reversed [ string reverse $word] set mapping [list $original_word $word] set arabic_string [ string map $mapping $arabic_string] #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] ] set arabic_string [ string reverse $arabic_string] #The following line is left for you to see the final result. just remove the comment sign (#) #tk_messageBox -message $words return $arabic_string } } #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 ====== **** The script of procedure text_binding_for_rtl $text_widget_path $k**** This procedure will eventually call the procedure [render_arabic $arabic_string] . ====== proc text_binding_for_rtl {text_widget_path k} { #Caution!!! *DO NOT* delete the next line of [set event_counter 0] . set event_counter 0 proc local_text_binding_for_rtl {text_widget_path k} { #Algorithm: #%k is the keycode number (%k is an integer not a hexadecimal) of the pressed key. #we print it for correct matching and selection of the keys being pressed. #If the %k is neither the spacebar or the Enter don't process anthing. #We only want to process the very last word. #And the Enter or the Spacebar are the triggers and the signals just to say we have a new word being written in the entry. #Therefore, exctract the last word. The last word must be checked to see whether it's completely an ASCII(Latin) string. #If it's, then don't touch it and skip to the next word #Always keep the latin/ASCII words as they are. #Else, process the word as an arabic word using the procedure [render_arabic] defined above #Also map the last word to the rest of the text widget string just to save time puts "k= $k" global event_counter #Only Key-Enter and Key-Space ban allow the processing of the last word if { $k != 65 && $k != 36 } { set event_counter 0 return } else { incr event_counter } #get the whole text as one string #check whether it's an [entry] widget or if it's an [text] widget set text_widget_type [winfo class $text_widget_path] set all_text "" switch -- $text_widget_type { Text { set all_text [$text_widget_path get 1.0 end] } Entry { set all_text [$text_widget_path get ] } } #if the text is empty or full of so many spaces, then return doing nothing set trimmed_text [string trim $all_text] if { $trimmed_text =="" } { return } if { $event_counter ==1 } { #after trimming white spaces from both ends of the whole text , #convert the text into a list of words to find the last word in the text set words [split [string trim $all_text] ] #for the sake of debugging and monitoring , print the list of words. puts $words #get the last word set last_word [lindex $words end ] #print the last word for debugging. puts $last_word #the word is completely ASCII, skip to the next word by quitting this event if {[string is ascii $last_word]==1} { return } #we render the last word, which is supposed to be an arabic word set last_word_after_rendering [render_arabic $last_word] #print the last word after rendering for debugging puts $last_word_after_rendering #replace every occurence of the original last word with the last word after rendering in all the text #but because it everything is already rendered but the last word, it will be only a replacement of the last word with #the last_word_after_rendering set all_text [ string map [split "$last_word $last_word_after_rendering"] $all_text] set all_text "[string trimright $all_text] " #and finally re-assign the text again to the entry or text widget switch -- $text_widget_type { Text { $text_widget_path replace 1.0 end $all_text } Entry { $text_widget_path delete 0 end $text_widget_path insert end $all_text } } } } local_text_binding_for_rtl $text_widget_path $k } ====== An example of how to call [text_binding_for_rtl $text_widget_path $k]: ====== entry .myent entry .input text .mytxt set list_of_entries [list .myent .mytxt .input] foreach an_entry $list_of_entries { bind $an_entry [list text_binding_for_rtl %W %k] } ====== <> Natural languages | Human Language | Arts and Crafts of Tcl-Tk Programming | اللغة العربية في TCL/Tk