root/other-projects/trunk/image-generation/shape_arabic.pl

#!/usr/bin/perl
# -*-Perl-*-

#---
# $Id$
#
# ------------
# Description:
# ------------
#  Perl script that does arabic utf-8 shaping
#
#  - Note how easy shaping really is.
#  - This should be used an a learning tool for those interested
#    in Arabic and in perl (its a learning medium).
#
# -----------------
# Revision Details:    (Updated by Revision Control System)
# -----------------
#  $Date$
#  $Author$
#  $Revision$
#  $Source$
#
# (www.arabeyes.org - under GPL license)
#---

# Point to and use Perl version 5.8 (or greater)
use 5.8.0;

# Try to be clean in variable usage, etc
use strict;

# Enable full UTF-8 support
use utf8;
use open ':utf8';
binmode(STDOUT, ":utf8");

# Enable Automatic command-line parsing
require "newgetopt.pl";

my (
    $this_script,
    $opt_debug,
    $opt_file,
    $out_line,
   );

# Specify global variable values and init some Variables
$this_script    = $0;
$this_script    =~ s|^.*/([^/]*)|$1|;

# Process the command line
&get_args();

if (! $opt_file )
{
    print "ERROR($this_script): Specify input file to process with '-file' option\n";
    &usage(1);
}

open (INFILE, "< $opt_file") or die "Can't open $opt_file - $! \n";

while (<INFILE>)
{
    $out_line .= &shape_line($_);
}
print $out_line;

exit(0);

       ###        ###
######## Procedures ########
       ###        ###

##
# Do the actual Arabic Shaping
sub shape_line
{
    my ($line)          = @_;

    use constant ISOLATED       => 0;
    use constant INITIAL        => 1;
    use constant MEDIAL         => 2;
    use constant FINAL          => 3;

    my (
        @char,
        $cur,
        $prev,
        $next,
        $index,
        $prev_index,
        $next_index,
        $out,
        $str,
       );

    # Hex values noted for all entries.
    #          iso-8859-6       =>      [     s,      i,      m,      f]
    my %map     = (
                   "621"        =>      ["FE80",      0,      0,      0],       # HAMZA
                   "622"        =>      ["FE81",      0,      0, "FE82"],       # ALEF_MADDA
                   "623"        =>      ["FE83",      0,      0, "FE84"],       # ALEF_HAMZA_ABOVE
                   "624"        =>      ["FE85",      0,      0, "FE86"],       # WAW_HAMZA
                   "625"        =>      ["FE87",      0,      0, "FE88"],       # ALEF_HAMZA_BELOW
                   "626"        =>      ["FE89", "FE8B", "FE8C", "FE8A"],       # YEH_HAMZA
                   "627"        =>      ["FE8D",      0,      0, "FE8E"],       # ALEF
                   "628"        =>      ["FE8F", "FE91", "FE92", "FE90"],       # BEH
                   "629"        =>      ["FE93",      0,      0, "FE94"],       # TEH_MARBUTA
                   "62A"        =>      ["FE95", "FE97", "FE98", "FE96"],       # TEH
                   "62B"        =>      ["FE99", "FE9B", "FE9C", "FE9A"],       # THEH
                   "62C"        =>      ["FE9D", "FE9F", "FEA0", "FE9E"],       # JEEM
                   "62D"        =>      ["FEA1", "FEA3", "FEA4", "FEA2"],       # HAH
                   "62E"        =>      ["FEA5", "FEA7", "FEA8", "FEA6"],       # KHAH
                   "62F"        =>      ["FEA9",      0,      0, "FEAA"],       # DAL
                   "630"        =>      ["FEAB",      0,      0, "FEAC"],       # THAL
                   "631"        =>      ["FEAD",      0,      0, "FEAE"],       # REH
                   "632"        =>      ["FEAF",      0,      0, "FEB0"],       # ZAIN
                   "633"        =>      ["FEB1", "FEB3", "FEB4", "FEB2"],       # SEEN
                   "634"        =>      ["FEB5", "FEB7", "FEB8", "FEB6"],       # SHEEN
                   "635"        =>      ["FEB9", "FEBB", "FEBC", "FEBA"],       # SAD
                   "636"        =>      ["FEBD", "FEBF", "FEC0", "FEBE"],       # DAD
                   "637"        =>      ["FEC1", "FEC3", "FEC4", "FEC2"],       # TAH
                   "638"        =>      ["FEC5", "FEC7", "FEC8", "FEC6"],       # ZAH
                   "639"        =>      ["FEC9", "FECB", "FECC", "FECA"],       # AIN
                   "63A"        =>      ["FECD", "FECF", "FED0", "FECE"],       # GHAIN
                   "640"        =>      [ "640",      0,      0,      0],       # TATWEEL
                   "641"        =>      ["FED1", "FED3", "FED4", "FED2"],       # FEH
                   "642"        =>      ["FED5", "FED7", "FED8", "FED6"],       # QAF
                   "643"        =>      ["FED9", "FEDB", "FEDC", "FEDA"],       # KAF
                   "644"        =>      ["FEDD", "FEDF", "FEE0", "FEDE"],       # LAM
                   "645"        =>      ["FEE1", "FEE3", "FEE4", "FEE2"],       # MEEM
                   "646"        =>      ["FEE5", "FEE7", "FEE8", "FEE6"],       # NOON
                   "647"        =>      ["FEE9", "FEEB", "FEEC", "FEEA"],       # HEH
                   "648"        =>      ["FEED",      0,      0, "FEEE"],       # WAW
                   "649"        =>      ["FEEF",      0,      0, "FEF0"],       # ALEF_MAKSURA
                   "64A"        =>      ["FEF1", "FEF3", "FEF4", "FEF2"],       # YEH
                   # exceptions
                   "644622"     =>      ["FEF5",      0,      0, "FEF6"],       # LAM_ALEF_MADDA
                   "644623"     =>      ["FEF7",      0,      0, "FEF8"],       # LAM_ALEF_HAMZA_ABOVE
                   "644625"     =>      ["FEF9",      0,      0, "FEFA"],       # LAM_ALEF_HAMZA_BELOW
                   "644627"     =>      ["FEFB",      0,      0, "FEFC"],       # LAM_ALEF

                   ## ---- My additions for Farsi ----
                   # I think there is a bug in this script which causes an initial "Peh"
                   # to be treated as isolated. This is why the isolated value for "Peh"
                   # is set to the initial value.
                   "67E"        =>     [ "FB58", "FB58", "FB59", "FB57" ],      # FARSI PEH
                   "686"        =>     [ "FB7A", "FB7C", "FB7D", "FB7B" ],      # FARSI TCHEH
                   "6AF"        =>     [ "FB92", "FB94", "FB95", "FB93" ],      # FARSI GAF
                   "6CC"        =>     [ "FBFC", "FBFE", "FBFF", "FBFD" ],      # FARSI YEH
                  );

    my %special_is_next         = ( "640" => 1 );
    my %special_is_comb1        = ( "644" => 1 );
    my %special_is_comb2        = ( 
                                    "622" => 1,
                                    "623" => 1,
                                    "625" => 1,
                                    "627" => 1,
                                  );

    my %special_is_composing    = (
                                    "64B" => 1,         # FATHATAN
                                    "64C" => 1,         # DAMMATAN
                                    "64D" => 1,         # KASRATAN
                                    "64E" => 1,         # FATHA
                                    "64F" => 1,         # DAMMA
                                    "650" => 1,         # KASRA
                                    "651" => 1,         # SHADDA
                                    "652" => 1,         # SUKUN
                                    "653" => 1,         # MADDAH ABOVE
                                    "654" => 1,         # HAMZA ABOVE
                                    "655" => 1,         # HAMZA BELOW
                                    "670" => 1,         # SUPERSCRIPT ALEF 
                                    "6D6" => 1,         # HIGH LIG. SAD WITH LAM WITH ALEF MAKSURA
                                    "6D7" => 1,         # HIGH LIG. QAF WITH LAM WITH ALEF MAKSURA
                                    "6D8" => 1,         # HIGH MEEM INITIAL FORM
                                    "6D9" => 1,         # HIGH LAM ALEF
                                    "6DA" => 1,         # HIGH JEEM
                                    "6DB" => 1,         # HIGH THREE DOTS
                                    "6DC" => 1,         # HIGH SEEN
# The 2 entires below should not be here - contact unicode.org !!
#                                   "6DD" => 1,         # END OF AYAH
#                                   "6DE" => 1,         # START OF RUB EL HIZB
                                    "6DF" => 1,         # HIGH ROUNDED ZERO
                                    "6E0" => 1,         # HIGH UPRIGHT RECTANGULAR ZERO
                                    "6E1" => 1,         # HIGH DOTLESS HEAD OF KHAH
                                    "6E2" => 1,         # HIGH MEEM ISOLATED FORM
                                    "6E3" => 1,         # LOW SEEN
                                    "6E4" => 1,         # HIGH MADDA
                                    "6E7" => 1,         # HIGH YEH
                                    "6E8" => 1,         # HIGH NOON
                                    "6EA" => 1,         # EMPTY CENTRE LOW STOP
                                    "6EB" => 1,         # EMPTY CENTRE HIGH STOP
                                    "6EC" => 1,         # HIGH STOP WITH FILLED CENTRE
                                    "6ED" => 1,         # LOW MEEM
                                  );

    @char = split ("", $line);

    for ($index = 0; $index <= $#char; $index++)
    {
        $cur = unpack("U", $char[$index]);
        $cur = sprintf "\U%x\E", $cur;
        if ( $opt_debug )
        {
            print "---- $index ----\n";
            print "NOW - $cur \n";
        }
        if ( defined $map{$cur} )
        {
            # Previous character status
            $prev_index = $index;

          PREV_CHECK:
            {
                $prev_index--;
                $prev = unpack("U", $char[$prev_index]);
                $prev = sprintf "\U%x\E", $prev;
                if ( $opt_debug )
                {
                    print "prev - $prev \n";
                }

                # Get rid of all previous composers
                if ( $special_is_composing{$prev} )
                {
                    redo PREV_CHECK;
                }
            }
            
            if (
                ($index == 0)          ||
                !defined $map{$prev}   ||
                (!$map{$prev}[INITIAL] &&
                 !$map{$prev}[MEDIAL]
                )
               )
            {
                # Don't have a 'prev'
                if ( $opt_debug )
                {
                    print "prev not defined \n";
                }
                undef $prev;
            }

            # Next     character status
            $next_index = $index;

            NEXT_CHECK:
            {
                $next_index++;
                $next = unpack("U", $char[$next_index]);
                $next = sprintf "\U%x\E", $next;
                if ( $opt_debug )
                {
                    print "next - $next \n";
                }

                # Get rid of all next composers
                if ( $special_is_composing{$next} )
                {
                    redo NEXT_CHECK;
                }
            }

            if (
                ($index == $#char)      ||
                !defined $map{$next}    ||
                (!$map{$next}[MEDIAL]   &&
                 !$map{$next}[FINAL]    &&
                 !$special_is_next{$next}
                )
               )
            {
                # Don't have a 'next'
                if ( $opt_debug )
                {
                    print "next not defined \n";
                }
                undef $next;
            }

            # Shape the special combinational characters
            if ( $special_is_comb1{$cur} )
            {
                if (defined $next )
                {
                    if ( $special_is_comb2{$next} )
                    {
                        $out = ( (defined $prev) ? $map{"$cur$next"}[FINAL] : $map{"$cur$next"}[ISOLATED] );
                        $str .= pack("U", hex($out));
                        if ( $opt_debug )
                        {
                            print "Got me a complex - use $out ($str)\n";
                        }
                        $index++;
                        next;
                    }
                }
            }

            # Medial
            if ( (defined $prev) && (defined $next) )
            {
                # In case there is no medial, move to next :-)
                if ( $out = $map{$cur}[MEDIAL] )
                {
                    $str .= pack("U", hex($out));
                    if ( $opt_debug )
                    {
                        print "Got prev & next - use $out ($str)\n";
                    }
                    next;
                }
            }

            # Final
            if ( (defined $prev) )
            {
                if ( $out = $map{$cur}[FINAL] )
                {
                    $str .= pack("U", hex($out));
                    if ( $opt_debug )
                    {
                        print "Got prev - use $out ($str)\n";
                    }
                    next;
                }
            }

            # Initial
            if ( (defined $next) )
            {
                if ( $out = $map{$cur}[INITIAL] )
                {
                    $str .= pack("U", hex($out));
                    if ( $opt_debug )
                    {
                        print "Got next - use $out ($str)\n";
                    }
                    next;
                }
            }

            # Isolated/Seperated (Stand-alone)
            $out = $map{$cur}[ISOLATED];
            $str .= pack("U", hex($out));
            if ( $opt_debug )
            {
                print "Got nothing - use $out ($str)\n";
            }
        }
        else
        {
            $str .= pack("U", hex($cur));
        }
    }

    if ( $opt_debug )
    {
        print "return - $str \n";
    }
    return ($str);
}

##
# Print the simple usage
sub usage
{
    my ($die_after)     = @_;

    print "Usage: $this_script <-file filename>  [-debug] \n";
    if ( $die_after ) { exit(5); }
}

##
# Get the command line arguments
sub get_args
{
  &NGetOpt (
            "debug"     =>      \$opt_debug,                    # enable the printing of debug output
            "file=s"    =>      \$opt_file,                     # specify a filename to process
           ) || ( $? = 257, die "Invalid argument\n" );
}