#!perl
# gen-zh : auxiliary script for Chinese
#
# output files
#
#   t-zh.txt (the whole data/zh.txt)
#   t-zh.t   (a main part of t/loc_zh.t)
#
use strict;
use warnings;

use Unicode::Normalize;
require 'dumpstr';

my @low = qw( 61 65 EA 69 6D 6E 6F 75 FC );
my @upp = qw( 41 45 CA 49 4D 4E 4F 55 DC );
my @tone = qw( 304 301 30C 300 0 );

open my $textf, ">t-zh.txt" or die "t-zh.txt";
binmode $textf;
my $text0 = '';

open my $testf, ">t-zh.t" or die "t-zh.t";
binmode $testf;
my $test0 = '';
my $test1 = '';
my $test2 = '';

for my $i (0..@low-1) {
    my $lb = pack('U', hex $low[$i]);
    my $ub = pack('U', hex $upp[$i]);
    for my $j (0..@tone-1) {
	my $tc = $tone[$j] ? pack('U', hex $tone[$j]) : '';

	my $ldec = NFD($lb).$tc;
	my $udec = NFD($ub).$tc;

	my $sldec = string($ldec);
	my $sudec = string($udec);

	if ($tc) { # has a tone
	    my $nc = $tone[$j+1] ? pack('U', hex $tone[$j+1]) : '';
	    my $snext = string(NFD($lb).$nc);
	    $test0 .= qq|ok(\$objZh->eq($sldec, $snext));\n|;
	}
	if ($lb ne $ldec) { # has a tone, or the base is a composite
	    $test1 .= qq|ok(\$objZh->eq($sldec, $sudec));\n|;
	}

	my $tx1 = '';
	my $tx2 = '';
	for my $bc ($lb, $ub) {
	    my $dec = NFD($bc).$tc;
	    my $com = NFC($bc.$tc);
	    my $cat = $bc.$tc;

	    my $sdec = string($dec);
	    my $scom = string($com);
	    my $scat = string($cat);

	    if ($dec ne $com) {
		$test2 .= qq|ok(\$objZh->eq($sdec, $scom));\n|;
	    }
	    if ($dec ne $cat && $cat ne $com) {
		$test2 .= qq|ok(\$objZh->eq($sdec, $scat));\n|;
	    }
	    my $sacc = $sdec; # U+0340 and U+0341
	    if ($sacc =~ s/(x\{?3)0([01])/${1}4${2}/) {
		$test2 .= qq|ok(\$objZh->eq($sdec, $sacc));\n|;
	    }

	    # .txt
	    my $c = element($com);
	    my @d = split //, $dec;
	    my $dif = $bc eq $d[0] ? "--".(4-$j) : "++".($j+1);

	    if ($dif ne '--0') { # $com is not a simple base
		my $e = $c;
		$tx1 .= "$e;$d[0]$dif\n";
		$tx1 .= "$e;$d[0]$dif\n" if $e =~ s/(\b03)0([01])/${1}4${2}/;
	    }
	    if ($dec ne $cat && $tc ne '') { # $cat is composite + tone
		my $e = element($cat eq $com ? $dec : $cat);
		$tx2 .= "$e;<$c>\n";
		$tx2 .= "$e;<$c>\n" if $e =~ s/(\b03)0([01])/${1}4${2}/;
	    }
	}
	$text0 .= "$tx1$tx2";
    }
}

print $textf $text0;
close $textf or die '$textf';

#------

my $count0 = $test0 =~ s/->eq/->eq/g;
my $count1 = $test1 =~ s/->eq/->eq/g;
my $count2 = $test2 =~ s/->eq/->eq/g;

my $test_count = 2;
print $testf "\n";
print $testf "\$objZh->change(level => 1);\n\n";

print $testf $test0;
$test_count += $count0;
print $testf "\n# $test_count\n\n";

print $testf "\$objZh->change(level => 2);\n\n";

$test0 =~ s/->eq/->lt/g;
print $testf $test0;
$test_count += $count0;
print $testf "\n# $test_count\n\n";

print $testf $test1;
$test_count += $count1;
print $testf "\n# $test_count\n\n";

print $testf "\$objZh->change(level => 3);\n\n";

$test1 =~ s/->eq/->lt/g;
print $testf $test1;
$test_count += $count1;
print $testf "\n# $test_count\n\n";

print $testf $test2;
$test_count += $count2;
print $testf "\n# $test_count\n\n";

close $testf or die '$testf';
