Tools(listFontWithLang.pl): Amend ac039733, Select fonts containig specified glyphs

Allow also values like
	-c Azß
or
	-c u+65zu+xdf
(Comma as a separator not needed, if the input is unambiguous)
This commit is contained in:
Kornel Benko 2020-05-19 08:55:41 +02:00
parent dfb33eb569
commit 58dfb1d825

View File

@ -83,11 +83,14 @@ my @optionsDef = (
["c", ["c",
{fieldname => "Contains", {fieldname => "Contains",
type => "=s", listsep => ',', type => "=s", listsep => ',',
comment => "Select fonts containing all comma separated glyphs",}], comment => "Select fonts containing all these (possibly comma separated) glyphs",}],
["l", ["l",
{fieldname => "Lang", {fieldname => "Lang",
type => "=s", alias=>["lang"], type => "=s", alias=>["lang"],
comment => "Comma separated list of desired languages"},], comment => "Comma separated list of desired languages"},],
["pc",
{fieldname => "PrintCharset", alias => ["printcharset"],
comment => "Print intervals of supported unicode character values"},],
["pl", ["pl",
{fieldname => "PrintLangs", alias => ["printlangs"], {fieldname => "PrintLangs", alias => ["printlangs"],
comment => "Print supported languages"},], comment => "Print supported languages"},],
@ -120,6 +123,7 @@ if (defined($options{Contains})) {
for my $a (@{$options{Contains}}) { for my $a (@{$options{Contains}}) {
push(@glyphs, decimalUnicode($a)); push(@glyphs, decimalUnicode($a));
} }
@glyphs = sort {$a <=> $b;} @glyphs;
} }
my $cmd = "fc-list"; my $cmd = "fc-list";
@ -139,10 +143,10 @@ if (exists($options{PrintScripts}) || defined($options{Scripts}) || defined($opt
if (exists($options{PrintLangs}) || defined($langs[0])) { if (exists($options{PrintLangs}) || defined($langs[0])) {
$format .= " lang=\"%{lang}\""; $format .= " lang=\"%{lang}\"";
} }
if (exists($options{PrintProperties}) || defined($options{Property})) { if (exists($options{PrintProperties}) || defined($options{Property}) || defined($options{NProperty})) {
$format .= " weight=%{weight} slant=%{slant} width=%{width} spacing=%{spacing}"; $format .= " weight=%{weight} slant=%{slant} width=%{width} spacing=%{spacing}";
} }
if (defined($options{Contains})) { if (defined($options{Contains}) || exists($options{PrintCharset})) {
$format .= " charset=\"%{charset}\""; $format .= " charset=\"%{charset}\"";
} }
$format .= " file=\"%{file}\" abcd\\n"; $format .= " file=\"%{file}\" abcd\\n";
@ -341,8 +345,8 @@ if (open(FI, "$cmd |")) {
for my $lang (@langs) { for my $lang (@langs) {
next NXTLINE if (! defined($usedlangs{$lang})); next NXTLINE if (! defined($usedlangs{$lang}));
} }
if (defined($options{Contains})) { my @charlist = ();
my @charlist = (); if (defined($options{Contains}) || exists($options{PrintCharset})) {
if ($l =~ / charset=\"([^\"]+)\"/) { if ($l =~ / charset=\"([^\"]+)\"/) {
my @list = split(/\s+/, $1); my @list = split(/\s+/, $1);
for my $e (@list) { for my $e (@list) {
@ -351,8 +355,10 @@ if (open(FI, "$cmd |")) {
push(@charlist, [hex($l), hex($h)]); push(@charlist, [hex($l), hex($h)]);
} }
} }
for my $g (@glyphs) { if (defined($options{Contains})) {
next NXTLINE if (! contains($g, \@charlist)); for my $g (@glyphs) {
next NXTLINE if (! contains($g, \@charlist));
}
} }
} }
my $style = &getVal($l, "style", "stylelang"); my $style = &getVal($l, "style", "stylelang");
@ -408,6 +414,18 @@ if (open(FI, "$cmd |")) {
if (exists($options{PrintLangs})) { if (exists($options{PrintLangs})) {
$props .= '(' . join(',', sort keys %usedlangs) . ')'; $props .= '(' . join(',', sort keys %usedlangs) . ')';
} }
if (exists($options{PrintCharset})) {
my @out = ();
for my $rE (@charlist) {
if ($rE->[0] != $rE->[1]) {
push(@out, $rE->[0] . '-' . $rE->[1]);
}
else {
push(@out, $rE->[0]);
}
}
$props .= '(' . join(',', @out) . ')';
}
if (exists($options{PrintScripts}) || defined($options{Scripts}) || defined($options{NScripts}) || exists($options{Math})) { if (exists($options{PrintScripts}) || defined($options{Scripts}) || defined($options{NScripts}) || exists($options{Math})) {
my @scripts = (); my @scripts = ();
my $scripts = ""; my $scripts = "";
@ -830,25 +848,35 @@ sub correctstyle($)
return($style); return($style);
} }
# return list of unicode values of the input string
sub decimalUnicode($) sub decimalUnicode($)
{ {
my ($a) = @_; my ($a) = @_;
if ($a =~ /^u\+(.+)$/i) { my @res = ();
$a = $1; while ($a =~ s/u\+(0?x[\da-f]+|\d+)//i) {
if ($a =~ /^0?x(.+)$/) { my $d = $1;
$a = hex($1); if ($d =~ /^0?x(.+)$/) {
$d = hex($1);
} }
return($a); push(@res, $d);
} }
return(ord(decode('utf-8', $a))); # maybe $a is a string of unicode chars?
my $u = decode('utf-8', $a);
my @a = split(//, $u);
for my $x (@a) {
push(@res, ord($x));
}
return(@res);
} }
# check if the glyph-value $d is contained
# in one of the (sorted) intervals
sub contains($$) sub contains($$)
{ {
my ($d, $rList) = @_; my ($d, $rList) = @_;
for my $re (@{$rList}) { for my $re (@{$rList}) {
return 0 if ($re->[0] > $d); next if ($re->[1] < $d);
return 1 if ($re->[1] >= $d); return 1 if ($re->[0] <= $d);
} }
return 0; return 0;
} }