+
+# return list of unicode values of the input string
+#Allow input of intervals (e.g. 'a-z')
+sub decimalUnicode($)
+{
+ my ($a) = @_;
+ my @res = ();
+ # Convert to unicode chars first
+ while ($a =~ /^(.*)u\+(0?x[\da-f]+|\d+)(.*)$/i) {
+ my ($prev, $d, $post) = ($1, $2, $3);
+ if ($d =~ /^0?x(.+)$/) {
+ $d = hex($1);
+ }
+ my $chr = encode('utf-8', chr($d));
+ $a = $prev . $chr . $post;
+ }
+ # $a is now a string of unicode chars
+ my $u = decode('utf-8', $a);
+ my @a = split(//, $u);
+ my $interval = 0;
+ my $start = undef;
+ for my $x (@a) {
+ if ($x eq '-') { # Interval
+ $interval = 1;
+ next;
+ }
+ if ($interval && defined($start)) {
+ if (ord($x) < $start) {
+ for (my $i = $start - 1; $i >= ord($x); $i--) {
+ push(@res, $i);
+ }
+ }
+ else {
+ for (my $i = $start + 1; $i <= ord($x); $i++) {
+ push(@res, $i);
+ }
+ }
+ $start = undef;
+ }
+ else {
+ $start = ord($x);
+ push(@res, $start);
+ }
+ $interval = 0;
+ }
+ return(@res);
+}
+
+
+# check if the glyph-values in interval @{$ri} are contained
+# in one of the (sorted) intervals
+sub contains($$)
+{
+ # ok if
+ # ...re0..........re1...
+ # ......start..end......
+ my ($ri, $rList) = @_;
+ my $start = $ri->[0];
+ my $end = $ri->[1];
+
+ for my $re (@{$rList}) {
+ next if ($re->[1] < $start);
+ # now we found a possible matching interval
+ return 1 if (($start >= $re->[0]) && ($end <= $re->[1]));
+ return 0;
+ }
+ return 0;
+}
+
+sub sprintIntervalls($)
+{
+ my ($rList) = @_;
+ my @out = ();
+ for my $rE (@{$rList}) {
+ if ($rE->[0] != $rE->[1]) {
+ push(@out, $rE->[0] . '-' . $rE->[1]);
+ }
+ else {
+ push(@out, $rE->[0]);
+ }
+ }
+ return join(',', @out);
+}
+
+sub buildFontName($$)
+{
+ my ($family, $style) = @_;
+
+ my $result = "";
+ $style =~ s/\\040//;
+ $family =~ s/\\040/\-/;
+ $family =~ s/\bcond\b/Condensed/i;
+ $family =~ s/\bblk\b/Black/i;
+ $family =~ s/\bsembd\b/SemiBold/i;
+ $family =~ s/\bsemcond\b/SemiCondensed/i;
+ $family =~ s/\bextcond\b/ExtraCondensed/i;
+ $family =~ s/\bextbd\b/ExtraBold/i;
+ $family =~ s/\bextlt\b/ExtraLight/i;
+ $family =~ s/\bmed\b/Medium/i;
+ if ($family =~ /^([A-Z]*[a-z]+)([A-Z]\w+)\b(.*)$/) {
+ $family = $1 . splitatlU($2) . $3;
+ }
+ $family =~ s/^Ant Polt\b/Antykwa Poltawskiego/;
+ $family =~ s/\b(Semi|Extra) (Bold|Condensed|Expanded|Light)\b/$1$2/;
+ my @style = &splitStyle($style);
+ for my $st (@style) {
+ $st = ucfirst($st);
+ if ($family !~ s/$st/$st/i) {
+ $family .= " $st";
+ }
+ else {
+ # check if $st in $family starts with ' '
+ $family =~ s/(\w)$st/$1 $st/i;
+ }
+ }
+ $result = $family;
+ return($result, join(' ', @style));
+}
+
+# split text at change from lower case to upper case
+sub splitatlU($)
+{
+ my ($txt) = @_;
+ if ($txt =~ /^([A-Z]+[a-z]*)(.*)$/) {
+ if (defined($mapShortcuts{$1})) {
+ return(" " . $mapShortcuts{$1} . splitatlU($2));
+ }
+ else {
+ return(" $1" . splitatlU($2));
+ }
+ }
+ return($txt);
+}
+
+sub splitStyle($)
+{
+ my @in = split(/[- ]/, $_[0]);
+ my @result = ();
+ my $prefix = "";
+ for my $en (@in) {
+ while ($en =~ s/^([A-Z][a-z]+)//) {
+ my $found = $1;
+ if ($found =~ /^(Semi|Extra)$/) {
+ $prefix = $found;
+ next;
+ }
+ elsif (defined($mapShortcuts{$found})) {
+ $found = $mapShortcuts{$found};
+ }
+ push(@result, "$prefix$found");
+ $prefix = "";
+ }
+ if ($en ne "") {
+ push(@result, "$prefix$en");
+ $prefix = "";
+ }
+ }
+ return(@result);
+}