#!/usr/bin/perl

#  Yudit Unicode Editor Source File
#
#  Copyright (C) 2000  Gaspar Sinai <gsinai@yudit.org>  
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

die "No version specified." if ($#ARGV == -1);
$VERSION=shift;

#
# This script makes shaping maps
# isolated
# final
# medial
# initial 
#

@full_date = localtime(time);
$year = $full_date[5] + 1900;
$mon = $full_date[4] + 1;
$mday = $full_date[3];
$date = sprintf ("%4d-%02d-%02d", $year, $mon, $mday);
$name="shape.my";

%STUFF = ();
%KVLE = ();
%DECODER=();

while (<>)
{
  @_ = split(';', $_);
  next if ($#_ < 6);
  $present = $_[0];
  $present = hex $present;
  next if ($present > 0xffff);

  if ($_[5] =~ /<(isolated)> ([0-9A-Fa-f ]+)/
    || $_[5] =~ /<(medial)> ([0-9A-Fa-f ]+)/
    || $_[5] =~ /<(final)> ([0-9A-Fa-f ]+)/
    || $_[5] =~ /<(initial)> ([0-9A-Fa-f ]+)/)
  {
    $present = sprintf ("0000%04X", $present);
    $position = $1;
    @keys = split (' ', $2);
    $plain = "";
    for ($i=0; $i<=$#keys; $i++)
    {
      $plain .= sprintf ("0000%04X ", hex ($keys[$i]));
    }
    $DECODER{$present} = $plain;
    $STUFF{$plain} = "found";
    $KVLE{$plain . $position} =  $present;
  }
}

# shaping forms for other two-form characters

for ("672", "673", "675", "676", "677", "689", "68A",
	"68B", "68F", "690", "692", "693", "694", "695",
	"696", "697", "699", "6C2", "6C3", "6C4", "6CA",
	"6CD", "6CF", "6D5", 		# Arabic
	"710", "715", "716", "717", "718", "719", "71E",
	"728", "72A", "72C"		# Syriac
) {
  $key = "00000" . $_ . " ";
  $KVLE {$key . "isolated" } = "A0001" . $_, $STUFF{$key} = "found",
	$DECODER{"A0001" . $_} = $key
	if (!defined ($KVLE {$key . "isolated" }));
  $KVLE {$key . "final" } = "A0004" . $_, $STUFF{$key} = "found",
	$DECODER{"A0004" . $_} = $key
	if (!defined ($KVLE {$key . "final" }));
}

# shaping forms for other four-form characters

for ("66E", "66F", "678", "67C", "67D", "681", "682",
	"685", "69A", "69B", "69C", "69D", "69E", "69F",
	"6A0", "6A1", "6A2", "6A3", "6A5", "6A7", "6A8",
	"6AA", "6AB", "6AC", "6AE", "6B0", "6B2", "6B4",
	"6B5", "6B6", "6B7", "6B8", "6B9", "6BA", "6BC",
	"6BD", "6BF", "6CE", "6D1", "6FA", "6FB", "6FC",	# Arabic
	"712", "713", "714", "71A", "71B", "71C", "71D",
	"71F", "720", "721", "722", "723", "724", "725",
	"726", "727", "729", "72B"		# Syriac
) {
  $key = "00000" . $_ . " ";
  $KVLE {$key . "isolated" } = "A0001" . $_, $STUFF{$key} = "found",
	$DECODER{"A0001" . $_} = $key
	if (!defined ($KVLE {$key . "isolated" }));
  $KVLE {$key . "initial" } = "A0002" . $_, $STUFF{$key} = "found",
	$DECODER{"A0002" . $_} = $key
	if (!defined ($KVLE {$key . "initial" }));
  $KVLE {$key . "medial" } = "A0003" . $_, $STUFF{$key} = "found",
	$DECODER{"A0003" . $_} = $key
	if (!defined ($KVLE {$key . "medial" }));
  $KVLE {$key . "final" } = "A0004" . $_, $STUFF{$key} = "found",
	$DECODER{"A0004" . $_} = $key
	if (!defined ($KVLE {$key . "final" }));
}

print <<EOD;
#
# Auto-generated by $0 $date
# Generated from http://www.unicode.org/Public/$VERSION/uc/UnicodeData.txt 
# $type map for Yudit.
# This file does not contain ligatures - STextData needs to be changed
# for that.
# Gaspar Sinai <gsinai\@yudit.org>
# Miikka-Markus Alhonen <Miikka-Markus.Alhonen\@tigatieto.com>
#
NAME=shape.my
TYPE=0
COMM=ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData.txt
COMM=shapein -> isolated initial medial final
COMM=Test A-> A i m f
SECTION=shapeout
ENCODE=1
KEY_WIDTH=2
VALUE_WIDTH=2
KEY_LENGTH=0
VALUE_LENGTH=0
#
EOD
$tashkeelin = 0;
for (sort (keys(%STUFF)))
{
  $key = $_;
  $isolated = $KVLE {$key . "isolated" };
  $final = $KVLE {$key . "final" };
  $initial = $KVLE {$key . "initial" };
  $medial = $KVLE {$key . "medial" };
  $isolated = "00000000" if (!defined ($isolated));
  $initial = "00000000" if (!defined ($initial));
  $medial = "00000000" if (!defined ($medial));
  $final = "00000000" if (!defined ($final));
  # Lam-Alef
  if ($key eq "00000644 00000622 "
   || $key eq "00000644 00000623 "
   || $key eq "00000644 00000625 "
   || $key eq "00000644 00000627 "
  )
  {
    print STDERR "forcing Lam-Alef in.\n";
  }
  elsif ($key eq "00000643 00000627 " # URDU needs this.
   || $key eq "00000643 00000644 ") # URDU needs this.
  {
    print STDERR "forcing Urdu Ligatures in.\n";
    $key =~ s/(\S+)\s(\S+)\s/$1 0000200D $2 /; # add ZWJ in between.
  }
  elsif ( (@kparts = split (' ', $key)) > 1)
  {
    $key = "";
    for ($kp=0; $kp<=$#kparts; $kp++)
    {
      $key .= $kparts[$kp];
      $key .= " 0000200D " if ($kp < $#kparts);
    }
    $key .= " ";
    print STDERR "Forcing Ligature: $key\n";
  }
  elsif (length ($key) > 9)
  {
    # print STDERR "ignoring multiple $key keys - till STextData changed\n"; 
     next;
  }
  elsif ($tashkeelin == 0 && hex ($key) > 0x064B)
  {
#
# Concerning tashkeel: I would like text with it to not look garbled.
# Using shaped tashkeel would is nicer.
#
    print <<EOD;
#
# From: Karl Koehler <koehler\@or.uni-bonn.de>
# Concerning tashkeel: I would like text with it to not look garbled.
# Using shaped tashkeel would is nicer.
#
0000064B  -> 0000FE70 0000FE70 0000FE71 0000FE70
0000064E  -> 0000FE76 0000FE76 0000FE77 0000FE76
0000064F  -> 0000FE78 0000FE78 0000FE79 0000FE78
00000650  -> 0000FE7A 0000FE7A 0000FE7B 0000FE7A
00000651  -> 0000FE7C 0000FE7C 0000FE7D 0000FE7C
00000652  -> 0000FE7E 0000FE7E 0000FE7F 0000FE7E
#
# Miikka-Markus Alhonen <Miikka-Markus.Alhonen\@tigatieto.com>
# Syriac: The only obligatory ligature in all script styles: 
# Rish + Seyame (U+072A U+0308)
#
0000072A 00000308 -> A0001001 00000000 00000000 A0004001
#
# Kaf + Alif and Kaf + Lam should have a presentation form as
# it is used in Urdu nastaliq.ttf.
000006A9 0000200D 00000627 -> A0001002 00000000 00000000 A0004002
000006A9 0000200D 00000644 -> A0001003 A0002003 A0003003 A0004003
#
# END
#
EOD

    $tashkeelin = 1;
  }
  print $key . " -> " .  "$isolated $initial $medial $final\n";
}
print <<EOD;
#
# This  decoder can be used to convert data from presentation form
#
COMM=ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData.txt
# This file does not contain ligatures - STextData need to be changed
# for that.
COMM=shapein -> isolated initial medial final
COMM=Test A-> A i m f
SECTION=shapein
ENCODE=0
KEY_WIDTH=2
VALUE_WIDTH=2
KEY_LENGTH=0
VALUE_LENGTH=0
#
EOD
$tashkeelout = 0;
for (sort (keys(%DECODER)))
{
  $plain = $DECODER{$_};
  if ($tashkeelout == 0 && hex ($_) > 0xFE70)
  {
    print <<EOD;
#
# From: Karl Koehler <koehler\@or.uni-bonn.de>
# Concerning tashkeel: I would like text with it to not look garbled.
# Using shaped tashkeel would is nicer.
# Commented by gaspar - duplicate
# FE70 -> 064B
# FE71 -> 064B
# FE72 -> 064C
# FE74 -> 064D
# FE76 -> 064E
# FE77 -> 064E
# FE78 -> 064F
# FE79 -> 064F
# FE7A -> 0650
# FE7B -> 0650
# FE7C -> 0651
# FE7D -> 0651
# FE7E -> 0652
# FE7F -> 0652
# END
#
# Miikka-Markus Alhonen <Miikka-Markus.Alhonen\@tigatieto.com>
# Syriac: The only obligatory ligature in all script styles: 
# Rish + Seyame (U+072A U+0308)
#
A0001001 -> 0000072A 00000308
A0004001 -> 0000072A 00000308
#
# Kaf + Alif and Kaf + Lam should have a presentation form as
# it is used in Urdu nastaliq.ttf.
A0001002 -> 000006A9 0000200D 00000627
A0004002 -> 000006A9 0000200D 00000627
A0001003 -> 000006A9 0000200D 00000644
A0002003 -> 000006A9 0000200D 00000644
A0003003 -> 000006A9 0000200D 00000644
A0004003 -> 000006A9 0000200D 00000644
#
EOD
     $tashkeelout = 1;
  }
  print "$_ -> $plain\n";
}

print "# End\n";
exit (0);