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

Comma separated glyphs can be specifies as characters or as unicode-values
example:
	-c A,z,ß
or
	-c u+65,z,u+xdf

diff --git a/development/tools/GetOptions.pm b/development/tools/GetOptions.pm
index 0da0992f175be82d4c6ac1787483fc8322a7de37..0b69f79460f6c0cc216200a9b4ff2045edc66cac 100644 (file)
--- 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];
     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 {
     }
   }
   else {


@@ -66,7 +66,7 @@ sub handleOptions($)
   $optionsDef{h}->{Sort} = 0;
   $optionsDef{v}->{fieldname} = "verbose";
   $optionsDef{v}->{alias} = ["verbose"];
   $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();
 
   my %options = ("help" => 0);
   my $opts = &makeOpts();


@@ -142,6 +142,22 @@ sub makeOpts()
   return($opts);
 }
 
   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()
 {
 # Create help-string to describe options
 sub makeHelp()
 {


@@ -153,7 +169,7 @@ sub makeHelp()
     "i" => "integer",
     "f" => "float",
       );
     "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 = "";
     my $e = $optionsDef{$ex};
     my $type = "";
     my $needed = "";

diff --git a/development/tools/listFontWithLang.pl b/development/tools/listFontWithLang.pl
index 88fed6bddae2e34f53dc67e866f080c48c102bf1..4cd9f0843f3f2e3368f624550cb004a8a658361a 100644 (file)
--- a/development/tools/listFontWithLang.pl
+++ b/development/tools/listFontWithLang.pl
@@ -32,6 +32,7 @@ BEGIN {
 
 use strict;
 use warnings;
 
 use strict;
 use warnings;

+use Encode;

 use GetOptions;
 
 sub convertlang($);
 use GetOptions;
 
 sub convertlang($);


@@ -41,6 +42,8 @@ sub getVal($$$);      # my ($l, $txtval, $txtlang) = @_;
 sub getproperties($$$$);
 sub ismathfont($$);
 sub correctstyle($);
 sub getproperties($$$$);
 sub ismathfont($$);
 sub correctstyle($);

+sub decimalUnicode($);
+sub contains($$);

 
 # Following fields for a parameter can be defined:
 # fieldname:         Name of entry in %options
 
 # 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"},],
   ["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"],
   ["l",
    {fieldname => "Lang",
     type => "=s", alias=>["lang"],


@@ -108,6 +115,13 @@ for my $lg (@langs) {
   $lg = &convertlang($lg);
 }
 
   $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);
 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 (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";
 $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,
   "o" => qr/^(octicons)/i,
   "q" => qr/^(qtdingbits)/i,
   "t" => qr/^(typicons|twemoji)/i,

+  "w" => qr/^(webdings)/i,

 );
 
 if (open(FI,  "$cmd |")) {
 );
 
 if (open(FI,  "$cmd |")) {


@@ -312,7 +330,6 @@ if (open(FI,  "$cmd |")) {
         $nexttype++;
       }
     }
         $nexttype++;
       }
     }

-    my $nfound = 0;

     my %usedlangs = ();
     if ($l =~ / lang=\"([^\"]+)\"/) {
       my @ll = split(/\|/, $1);
     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}));
     }
     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");
     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);
 }
   $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;
+}