wesnoth/utils/codecomp
2006-01-17 14:52:24 +00:00

47 lines
2.1 KiB
Perl
Executable File

#!/usr/bin/perl
# codecomp
# compare list of codepoints with a baseline list
while (<>) {
# next unless /codepoints=\"(.*)\"/;
# push @cs, [ split /,/, $1 ];
push @cs, [ split /,/ ];
push @fs, $ARGV;
}
# hardcode DejaVu codepoint list for now, as baseline
# use codeextract to update, this list is from DejaVu 2.2
@c = split /,/, '32-126,160-387,390-411,413-414,420-421,423-425,427-430,433,437-438,443,448-468,470,477,479,482-483,490-493,497-499,536-539,555,557-559,561-563,567-569,592-696,699-700,702-705,710-712,716,720-723,726,728-734,736-745,768-819,825-831,865,884-885,890,894,900-906,908,910-929,931-974,976-993,1008-1119,1168-1175,1178-1179,1184-1191,1196-1199,1202-1207,1210-1211,1217-1218,1221-1224,1227-1228,1232-1241,1244-1245,1254-1259,7426,7432-7433,7444,7455,7543,7692-7693,7698-7699,7716-7717,7734-7737,7740-7741,7745-7751,7754-7755,7767,7770-7773,7777-7779,7788-7789,7792-7793,7806-7813,7864-7865,7882-7885,7908-7909,7922-7923,8208-8213,8216-8218,8220-8230,8240-8241,8249-8250,8252-8253,8263-8265,8304,8308-8313,8319,8364,8373,8451,8482,8486-8487,8490-8491,8498,8523,8704,8706-8707,8710-8711,8719-8723,8725,8727-8730,8733-8735,8743-8749,8776,8800-8801,8803-8805,8962,8976-8977,8984-8985,8997,9085,9251,9472-9631,9674,9688,9702,9784,10731,10764-10766,64256-64260,65533';
#foreach $d ( @cs ) {
# print join(',', @$d), "\n";
#}
foreach $d ( @cs ) {
$i = 0; $j = 0;
my @e;
# compare @{$d} and @c, want to find all intersections
while ( $c[$i] and $d->[$j] ) {
($a,$b) = split /-/, $c[$i];
$b = $a unless $b;
($x,$y) = split /-/, $d->[$j];
$y = $x unless $y;
if ( $x <= $b and $a <= $y ) { # intersection
my $min = ($a > $x) ? $a : $x;
my $max = ($b < $y) ? $b : $y;
push @e, $min . (($min != $max) ? "-$max" : '');
}
++$i if $b <= $y;
++$j if $b >= $y;
# if $b == $y advance both
}
push @es, [ @e ];
}
$i = 0;
while ( $es[$i] ) {
# if *equal* is flagged, then this codepoint list is covered by DejaVu
print "*equal* " if join(',', @{$es[$i]}) eq join(',', @{$cs[$i]});
print $fs[$i], ' = ', join(',', @{$es[$i]}), "\n";
++$i;
}