#!/usr/bin/perl -w ################## # * __________ __ ___. # * Open \______ \ ____ ____ | | _\_ |__ _______ ___ # * Source | _// _ \_/ ___\| |/ /| __ \ / _ \ \/ / # * Jukebox | | ( <_> ) \___| < | \_\ ( <_> > < < # * Firmware |____|_ /\____/ \___ >__|_ \|___ /\____/__/\_ \ # * \/ \/ \/ \/ \/ # * Copyright (C) 2020 Solomon Peachy # * # * This program is free software; you can redistribute it and/or # * modify it under the terms of the GNU General Public License # * as published by the Free Software Foundation; either version 2 # * of the License, or (at your option) any later version. # * # * This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY # * KIND, either express or implied. # * ################################## use strict; use feature 'unicode_strings'; binmode(STDOUT, ":utf8"); my @langs; my @fonts; my %fontchars; my %langchars; my %missing; sub fontcoverage($) { my ($font) = @_; open(FILE, ") { if (/^ENCODING\s+(\d+)\s*/) { $fontchars{$font}{chr($1)} = $1; } } close(FILE); } sub langcoverage($) { my ($lang) = @_; open(FILE, ") { if (/^\s*\s*$/) { $indest = 1; } elsif (/^\s*<\/dest>\s*$/) { $indest = 0; } elsif ($indest) { if (/\s*\S*\s*:\s*"(\S*)"\s*/u) { next if ($1 eq "none"); foreach my $char (split(//, $1)) { if (!defined($langchars{$lang}{$char})) { $langchars{$lang}{$char} = 0; } $langchars{$lang}{$char}++; } } } } close(FILE); } sub calccoverage($$) { my ($lang, $font) = @_; my $total = 0; my $covered = 0; my $str = ""; foreach my $l (sort(keys(%{$langchars{$lang}}))) { next if ($l eq " "); $str .= $l; $total++; #$total += $langchars{$lang}{$l}; if (defined($fontchars{$font}{$l})) { $covered++; #$covered += $langchars{$lang}{$l}; } else { $missing{$font}{$lang}{$l} = 1; } } # return "$covered/$total - '$str'"; return $covered/$total; } ################### # Populate font and language lists opendir(DIR, "rockbox/apps/lang"); @langs = grep(/\.lang$/,readdir(DIR)); closedir(DIR); opendir(DIR, "rockbox/fonts"); @fonts = grep(/\.bdf$/,readdir(DIR)); closedir(DIR); # Generate coverage maps foreach my $x (@fonts) { fontcoverage($x); } foreach my $x (@langs) { langcoverage($x); } # Geneate INI files # (standard summary) foreach my $lang (sort(@langs)) { $lang =~ /(.*)\.lang/; print "[$1]\n"; foreach my $font (sort(@fonts)) { my $coverage = calccoverage($lang, $font); $font =~/(.*).bdf/; printf " $1 = %1.6f\n", $coverage; } } # (missing) #foreach my $lang (sort(@langs)) { # print "[missing|$lang]\n"; # foreach my $font (sort(@fonts)) { # my $str = ""; # foreach my $missing (keys(%{$missing{$font}{$lang}})) { # $str .= "'$missing' (u+".ord($missing).") "; # } # print " $font = $str\n" if ($str); # } #}