X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/d8cf87b8d7d32d184bffcf8e30ff2637259b61ff..6721f1111bc49b8ee5efc0b39d74321c1393cdfb:/tools/mkfontinfo

diff --git a/tools/mkfontinfo b/tools/mkfontinfo
index fe7059f..0f0857d 100755
--- a/tools/mkfontinfo
+++ b/tools/mkfontinfo
@@ -23,34 +23,54 @@ for my $fontfile (glob 'ttfsupport/*'.$incsuffix) {
 	};
 }
 
-my @chargroups = qw(
-	N Z Math
-	Assigned
-	Latin Greek Cyrillic Georgian Arabic Thai Hangul Han
-);
+	when (qr{^[a-z]+(?:/|\z)}) {
+	}
+
+my %charlist;
+
+my $chartables = do 'unicode-table.inc.pl' or warn $@ || $!;
+if ($chartables) {
+	while (my ($tablegroup, $grouprow) = each %{$chartables}) {
+		while (my ($tablename, $chars) = each %{$grouprow}) {
+			next if $tablename =~ /^-/;
+			my $includerows;  # ignore rows before body row
+			for (@{$chars}) {
+				$includerows ||= m/^[.]/ or next;
+				next if /^[.-]/;
+				next if $_ eq '>' or $_ eq '=';
+				push @{ $charlist{table}->{"$tablegroup/$tablename"} }, $_;
+				push @{ $charlist{table}->{$tablegroup} }, $_;
+			}
+		}
+#		if ($tablegroup eq 'ipa') {
+#			@chars = grep { !m/[a-zA-Z]/ } @chars;
+#		}
+	}
+}
 
-say 'use utf8;';
-say '+{';
-for my $name (@chargroups) {
-	my $match = qr/\A\p{$name}\z/;
-	my @chars = eval {
-		grep { m/$match/ } map { chr $_ }
-		0..0xD7FF, 0xE000..0xFDCF, 0xFDF0..0xFFFD,
-	} or do {
-		warn $@;
-		next;
-	};
+use Unicode::UCD 'charinfo';
+for my $code (0 .. 256**2) {
+	my $charinfo = charinfo($code) or next;
+	next if $charinfo->{category} =~ /^[MC]/;  # ignore Marks and "other" Control chars
+	push @{ $charlist{$_}->{ $charinfo->{$_} } }, chr $code
+		for qw( script category block );
+}
 
-	my %cover = map {
+for (values %charlist) {
+for my $chars (values %{$_}) {
+	my %row = map {
 		my $fontcover = $font{$_};
-		($_ => scalar grep { $fontcover->{$_} } @chars);
+		($_ => scalar grep { $fontcover->{$_} } @{$chars});
 	} keys %font;
-	$cover{-count} = scalar @chars;
-	$cover{-chars} = [ map { ord } sort @chars ];
+	$row{-count} = scalar @{$chars};
+#	$row{-chars} = [ map { ord } sort @{$chars} ];
 
-	say $name.' => '.pp(\%cover).',';
+	$chars = \%row;
 }
-say '}';
+}
+
+say 'use utf8;';
+say '+'.pp(\%charlist);
 
 __END__