unicode: dedicated include with character details

[sheet.git] / tools / convert-unicode.pl

diff --git a/tools/convert-unicode.pl b/tools/convert-unicode.pl
new file mode 100755 (executable)
index 0000000..731210b
--- /dev/null
+++ b/tools/convert-unicode.pl
@@ -0,0 +1,116 @@
+#!/usr/bin/env perl
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use open OUT => ':utf8', ':std';
+use Data::Dump 'pp';
+
+our $VERSION = '1.00';
+
+my %info = (
+       "\xAD"     => {string => '-'},
+       "\x{200E}" => {string => '→'},
+       "\x{200F}" => {string => '←'},
+);
+$info{chr $_} //= {} for 32 .. 126;
+
+my %diinc = (
+       'digraphs.inc.pl' => 'u-di',
+);
+for (keys %diinc) {
+       -e $_ or next;
+       my $di = do $_ or die "Error reading digraphs file $_: ", $@ || $!;
+       while (my ($mnem, $cp) = each %$di) {
+               length $mnem == 2 or next;  # limit to digraphs
+               $cp = chr $cp->[0] if ref $cp;  # old style array
+               $info{$cp}->{di} //= $mnem;
+               $info{$cp}->{class}->{$_}++ for $diinc{$_};
+       }
+}
+
+for my $chr (keys %info) {
+       my $cp = ord $chr;
+       # attempt to get unicode character information
+       my $info = eval {
+               require Unicode::UCD;
+               Unicode::UCD::charinfo($cp)
+                       || { block => '?', category => 'Xn', name => '', script => '' }
+       } or next;
+
+       $info->{$_} = $info{$chr}->{$_} for qw(di class string);
+
+       # categorise by unicode types and writing script
+       $info->{class}->{$_}++ for $info->{category};
+       $info->{class}->{"u-$_"}++ for $info->{script} || ();
+
+       # add custom categories for certain blocks
+       $info->{class}->{Xa}++ if $info->{block} eq 'Basic Latin';
+       $info->{class}->{Xl}++ if $info->{block} eq 'Latin-1 Supplement';
+
+       given ($cp) {
+               when ($info->{string}) {
+                       # keep predefined presentational string
+               }
+               when ($info->{combining}) {
+                       # overlay combining accents
+                       $info->{string} = chr(9676) . $chr;
+               }
+               when (($cp & ~0b1001_1111) == 0 or $cp == 127) {
+                       # control characters (first 32 chars from 0 and 128)
+                       # rename to something more descriptive
+                       $info->{name} = $info->{unicode10}
+                               ? '<'.$info->{unicode10}.'>'  # the old name was much more useful
+                               : sprintf('<control U+%04X>', $cp);  # at least identify by value
+                       # show descriptive symbols instead of control chars themselves
+                       $info->{string} = $cp < 32 ? chr($cp + 0x2400) : chr(0xFFFD);
+               }
+       }
+
+       $info{$chr} = $info;
+}
+
+# output perl code of hash
+say '+{';
+for my $cp (sort keys %info) {
+       $info{$cp}->{classstr} = join(' ', sort keys %{ $info{$cp}->{class} });
+       # convert info hashes into arrays of strings to output in display order
+       my $row = [ map { $info{$cp}->{$_} } qw/classstr name di string/ ];
+       # strip off trailing missing values (especially string may be unknown)
+       defined $row->[-1] ? last : pop @$row for 1 .. @$row;
+       # final line (assume safe within single quotes)
+       say sprintf '"\x{%X}" => [%s],',
+               ord $cp, join(',', map { escapeq($_) } @$row);
+}
+say '}';
+
+sub escapeq {
+       my $_ = shift;
+       return 'undef' if not defined;
+       s/(['\\])/\\$1/g;
+       return "'$_'";
+}
+
+__END__
+
+=head1 NAME
+
+convert-unicode.pl - Gather Unicode character details in Perl array
+
+=head1 SYNOPSIS
+
+    convert-unicode > unicode-char.inc.pl
+
+Test by printing the description of U+0041 (latin A):
+
+    perl -e'$u = do "unicode-char.inc.pl"; print $u->{A}->[1]'
+
+=head1 AUTHOR
+
+Mischa POSLAWSKY <perl@shiar.org>
+
+=head1 LICENSE
+
+Licensed under the GNU Affero General Public License version 3.
+