From ac0397330986e4d7360f746be8cf10d1ecb1c8a2 Mon Sep 17 00:00:00 2001 From: Kornel Benko Date: Mon, 18 May 2020 18:21:25 +0200 Subject: [PATCH] Tools(listFontWithLang.pl): Select fonts containig specified glyphs MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit Comma separated glyphs can be specifies as characters or as unicode-values example: -c A,z,ß or -c u+65,z,u+xdf --- development/tools/GetOptions.pm | 22 +++++++++-- development/tools/listFontWithLang.pl | 57 ++++++++++++++++++++++++++- 2 files changed, 74 insertions(+), 5 deletions(-) diff --git a/development/tools/GetOptions.pm b/development/tools/GetOptions.pm index 0da0992f17..0b69f79460 100644 --- a/development/tools/GetOptions.pm +++ b/development/tools/GetOptions.pm @@ -55,7 +55,7 @@ sub handleOptions($) for (my $i = 0; defined($_[0]->[$i]); $i++) { my $rO = $_[0]->[$i]; $optionsDef{$rO->[0]} = $rO->[1]; - $optionsDef{$rO->[0]}->{Sort} = $i+1; + $optionsDef{$rO->[0]}->{Sort} = $i+2; } } else { @@ -66,7 +66,7 @@ sub handleOptions($) $optionsDef{h}->{Sort} = 0; $optionsDef{v}->{fieldname} = "verbose"; $optionsDef{v}->{alias} = ["verbose"]; - $optionsDef{v}->{Sort} = 0; + $optionsDef{v}->{Sort} = 1; my %options = ("help" => 0); my $opts = &makeOpts(); @@ -142,6 +142,22 @@ sub makeOpts() return($opts); } +sub sortHelp +{ + if (defined($optionsDef{$a}->{Sort})) { + if (defined($optionsDef{$b}->{Sort})) { + return $optionsDef{$a}->{Sort} <=> $optionsDef{$b}->{Sort}; + } + return -1; + } + if (defined($optionsDef{$b}->{Sort})) { + return 1; + } + else { + return $a cmp $b; + } +} + # Create help-string to describe options sub makeHelp() { @@ -153,7 +169,7 @@ sub makeHelp() "i" => "integer", "f" => "float", ); - for my $ex (sort {$optionsDef{$a}->{Sort} <=> $optionsDef{$b}->{Sort};} keys %optionsDef) { + for my $ex (sort sortHelp keys %optionsDef) { my $e = $optionsDef{$ex}; my $type = ""; my $needed = ""; diff --git a/development/tools/listFontWithLang.pl b/development/tools/listFontWithLang.pl index 88fed6bdda..4cd9f0843f 100644 --- a/development/tools/listFontWithLang.pl +++ b/development/tools/listFontWithLang.pl @@ -32,6 +32,7 @@ BEGIN { use strict; use warnings; +use Encode; use GetOptions; sub convertlang($); @@ -41,6 +42,8 @@ sub getVal($$$); # my ($l, $txtval, $txtlang) = @_; sub getproperties($$$$); sub ismathfont($$); sub correctstyle($); +sub decimalUnicode($); +sub contains($$); # Following fields for a parameter can be defined: # fieldname: Name of entry in %options @@ -77,6 +80,10 @@ my @optionsDef = ( ["math", {fieldname => "Math", comment => "Select fonts probably containing math glyphs"},], + ["c", + {fieldname => "Contains", + type => "=s", listsep => ',', + comment => "Select fonts containing all comma separated glyphs",}], ["l", {fieldname => "Lang", type => "=s", alias=>["lang"], @@ -108,6 +115,13 @@ for my $lg (@langs) { $lg = &convertlang($lg); } +my @glyphs = (); +if (defined($options{Contains})) { + for my $a (@{$options{Contains}}) { + push(@glyphs, decimalUnicode($a)); + } +} + my $cmd = "fc-list"; if (defined($langs[0])) { $cmd .= " :lang=" . join(',', @langs); @@ -128,6 +142,9 @@ if (exists($options{PrintLangs}) || defined($langs[0])) { if (exists($options{PrintProperties}) || defined($options{Property})) { $format .= " weight=%{weight} slant=%{slant} width=%{width} spacing=%{spacing}"; } +if (defined($options{Contains})) { + $format .= " charset=\"%{charset}\""; +} $format .= " file=\"%{file}\" abcd\\n"; $cmd .= " -f '$format'"; #print "$cmd\n"; @@ -287,6 +304,7 @@ my %symbolFonts = ( "o" => qr/^(octicons)/i, "q" => qr/^(qtdingbits)/i, "t" => qr/^(typicons|twemoji)/i, + "w" => qr/^(webdings)/i, ); if (open(FI, "$cmd |")) { @@ -312,7 +330,6 @@ if (open(FI, "$cmd |")) { $nexttype++; } } - my $nfound = 0; my %usedlangs = (); if ($l =~ / lang=\"([^\"]+)\"/) { my @ll = split(/\|/, $1); @@ -324,7 +341,20 @@ if (open(FI, "$cmd |")) { for my $lang (@langs) { next NXTLINE if (! defined($usedlangs{$lang})); } - next if ($nfound); + if (defined($options{Contains})) { + my @charlist = (); + if ($l =~ / charset=\"([^\"]+)\"/) { + my @list = split(/\s+/, $1); + for my $e (@list) { + my ($l, $h) = split('-', $e); + $h = $l if (! defined($h)); + push(@charlist, [hex($l), hex($h)]); + } + } + for my $g (@glyphs) { + next NXTLINE if (! contains($g, \@charlist)); + } + } my $style = &getVal($l, "style", "stylelang"); $style =~ s/^\\040//; my $fullname = &getVal($l, "fn", "fnl"); @@ -799,3 +829,26 @@ sub correctstyle($) $style =~ s/ +/ /g; return($style); } + +sub decimalUnicode($) +{ + my ($a) = @_; + if ($a =~ /^u\+(.+)$/i) { + $a = $1; + if ($a =~ /^0?x(.+)$/) { + $a = hex($1); + } + return($a); + } + return(ord(decode('utf-8', $a))); +} + +sub contains($$) +{ + my ($d, $rList) = @_; + for my $re (@{$rList}) { + return 0 if ($re->[0] > $d); + return 1 if ($re->[1] >= $d); + } + return 0; +} -- 2.39.2