#!/usr/bin/perl use strict; my %deadkeys = ( 0x0300 => [ 'dgra', 0x0060 ], # dead_grave 0x0301 => [ 'dacu', 0x00b4 ], # dead_acute 0x0302 => [ 'dcir', 0x005e ], # dead_circumflex 0x0303 => [ 'dtil', 0x007e ], # dead_tilde 0x0304 => [ 'dmac', 0x00AF ], # dead_macron 0x0306 => [ 'dbre', 0x02D8 ], # dead_breve 0x0307 => [ 'ddot', 0x02D9 ], # dead_abovedot 0x0308 => [ 'ddia', 0x00A8 ], # dead_diaeresis 0x0309 => [ 'dsla', 0x0000 ], # dead_hook 0x030a => [ 'drin', 0x00B0 ], # dead_abovering 0x0327 => [ 'dced', 0x00B8 ], # dead_cedilla 0x030b => [ 'ddac', 0x02DD ], # dead_doubleacute 0x0328 => [ 'dogo', 0x02DB ], # dead_ogonek 0x030c => [ 'dcar', 0x02C7 ], # dead_caron ); my %acmtable; my $acm = $ARGV[0]; my $deadsequences = $ARGV[1]; sub printsym { my $c = $_[0]; if (defined $c) { if ($c >= 0x20 && $c <= 0x7e) { return sprintf "\'%c\'", $c; } else { return sprintf "%i", $c; } } else { return undef; } } for my $i (0..127) { $acmtable{$i} = $i; } (-f $acm) or die "$0: ${acm} does not exist\n"; if ($acm =~ /gz$/) { open (ACM, '-|:utf8', "zcat $acm") or die "$0: $acm: $!\n"; } else { open (ACM, '<:utf8', $acm) or die "$0: $acm: $!\n"; } while () { s/\#.*//; chomp; next unless (/[^\s]/); if (/^\s*0x([0-9a-fA-F]{1,2})\s+\'([^\']+)\'\s*$/) { my $uni = ord ($2); my $c = hex ($1); $acmtable{$uni} = $c; } else { die "$0: Syntax error in ACM file: $_\n"; } } close ACM; my $deadkey = ''; my @sequences; sub print_deadkey { if (defined $deadkeys{$deadkey} && @sequences) { my $name = $deadkeys{$deadkey}[0]; my $abort = printsym($acmtable{$deadkeys{$deadkey}[1]}); $abort = 0 if (! defined $abort); printf " %-5s %-4s", $name, $abort; for my $i (0 .. $#sequences) { print "\n " if ($i > 0 && $i % 4 == 0); print $sequences[$i]; } print "\n"; } } open(DEADSEQ, $deadsequences) or die "$0: $deadsequences: $!\n"; while () { s/\#.*//; chomp; next unless (/[^\s]/); if (/^Deadkey[[:space:]]+U\+([0-9a-fA-F]{4})[[:space:]]*$/) { print_deadkey(); $deadkey=hex($1); @sequences = (); } elsif (/^U\+([0-9a-fA-F]{4})[[:space:]]+U\+([0-9a-fA-F]{4})[[:space:]]*$/){ my $a = printsym($acmtable{hex($1)}); my $b = printsym($acmtable{hex($2)}); if ((defined $a) && (defined $b)) { push @sequences, " ( $a $b )"; } } } print_deadkey(); close DEADSEQ;