﻿#!/usr/bin/perl
use warnings;
use strict;
use utf8;
use encoding 'utf8';
use Tk;
use Tk::ROText;

my ($Var, @Tab, $Nb, $I, $Texte1, $Texte2, $HEX, $Str, $CarHexa ) = ();

my $Wm =  new MainWindow();
$Wm->geometry("1000x500+100+100");

# Scrolled qui affiche le texte
my $Scroll_1 = $Wm->Scrolled(
  'ROText',
  -scrollbars => 'e',
  -takefocus  => 0,
  -wrap      => 'word',
  -relief    => 'flat',
  -background => '#ABFAA3',
);
$Scroll_1->pack(qw / -side top -fill both -expand 1 /);
configurer_tags($Scroll_1);

my $Saisie = $Wm->Entry(
	-background 	=> 'white',
	-font  				=> "{Simplified Arabic} 24 {bold}",
	-textvariable => \$Var,
);
$Saisie->pack(qw / -side top -fill both -expand 1 /);

my $Bouton = $Wm->Button(
	-text    => 'Send with keyboard AZERTY, QUERTY or Arabic',
	-background  => '#FFE0D0',
	-command => sub {
		$Scroll_1->insert( 'end', $Var, "g18" );
		$Scroll_1->insert( 'end', "\n", "g12" );
		Ecrire_1 ($Var);
		Ecrire_2 ($Var);
		$Scroll_1->insert( 'end', "\n", "g18" );
  } ,
);
$Bouton->pack(qw / -side top -fill both -expand 1 /);

$Texte1 = "الْجَوُّ حَارَّةٌ فِي الْفَصْلِ الصَّيفِ";
$Texte2 = "الجو حارة في الفصل الصيف";

$Scroll_1->insert( 'end', "\n", "g12" );
$Scroll_1->insert( 'end', "Arabic text with caractères diacritiques unsynchronized when clic on with mouse, and moved for left border \n", "g12" );
$Scroll_1->insert( 'end', $Texte1, "g22" );
$Scroll_1->insert( 'end', "\n", "g12" );
$Scroll_1->insert( 'end', "The same Arabic text without caractères diacritiques unsynchronized when clic on with mouse, and less moved for left border \n", "g12" );
$Scroll_1->insert( 'end', $Texte2, "g22" );
$Scroll_1->insert( 'end', "\n", "g12" );

Ecrire_1 ($Texte1);
Ecrire_2 ($Texte2);

#---------------------------------------------------------------
MainLoop;

sub Ecrire_1 {
	my ( $Txt ) = @_;
	@Tab = unpack "(A)*", $Txt;
	$Nb = @Tab;
	print "ECRIRE1=$Nb\n";
	$Scroll_1->insert( 'end', "The same textArabic with caractères diacritiques but not connected unsynchronized when clic on with mouse, and moved for left border \n", "g12" );

	for ($I = 0; $I < $Nb; $I++) {
		#printf ("%x\n",$Tab[$I]);
		$Scroll_1->insert( 'end', $Tab[$I] . " ", "g12" );
	}
	$Scroll_1->insert( 'end', "\n", "g12" );
}

sub Ecrire_2 {
	my ( $Txt ) = @_;	
	@Tab = unpack "(A)*", $Txt;
	$Nb = @Tab;
	print "ECRIRE2=$Nb\n";
	$Scroll_1->insert( 'end', "The same textArabic generated by utf8 unicode \n", "g12" );


	for ($I = 0; $I < $Nb; $I++) {		
		$HEX = ascii_to_hex ($Tab[$I]);
		$CarHexa = "-$HEX+";
		$CarHexa =~ s/\+/\} /go;
		$CarHexa =~ tr/a-z/A-Z/ ;
		$CarHexa =~ s/\-/x\\{0/go;
		print "TOTO=$CarHexa\n";
		$Scroll_1->insert( 'end', $CarHexa, "g12" );
	}
	$Scroll_1->insert( 'end', "\n", "g12" );
}



sub ascii_to_hex ($)
{
	## Convert each ASCII character to a two-digit hex number.
	($Str = shift) =~ s/(.|\n)/sprintf("%02lx", ord $1)/eg;
	return $Str;
}
sub hex_to_ascii ($)
{
	## Convert each two-digit hex number back to an ASCII character.
	($Str = shift) =~ s/([a-fA-F0-9]{2})/chr(hex $1)/eg;
	return $Str;
}

#########################################
# Configuration des polices de caractères
#
sub configurer_tags {
	my $widget_text = shift;
	for my $police ( 12 .. 72 ) {
		if ( $police % 2 == 0 ) {
			$widget_text->tagConfigure(
				"g$police",
				-background => '#ABFAA3',
				-font      => "{Simplified Arabic} $police {bold}",
				-justify    => 'right',
			);
		}
	}
}

=pod


$Ligne =~ s/\x{064E}//go; # Fatha
    	$Ligne =~ s/\x{064B}//go; # FathaTan
    	$Ligne =~ s/\x{0650}//go; # Kasra
    	$Ligne =~ s/\x{064D}//go; # KasraTan
    	$Ligne =~ s/\x{064F}//go; # Damma
    	$Ligne =~ s/\x{064C}//go; # DammaTan
    	$Ligne =~ s/\x{0652}//go; # Soukoune
    	$Ligne =~ s/\x{0651}//go; # Chadda