123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349 |
- use strict;
- use warnings;
- my @langs = ("en","cz","it","es","pl","de");
- sub parselang
- {
- my ($filename) = @_;
- open(my $fh, '<:encoding(UTF-8)', $filename)
- or die "Could not open file '$filename' $!";
-
- my $out = {};
- while (my $line = <$fh>) {
- chomp $line;
- next if (index($line, 'define') == -1 || index($line, 'MSG') == -1);
- my $modifiers = {};
- my $symbol = '';
- my $value = '';
- if (index($line, 'define(') == -1) {
-
- $line =~ /(?is)define\s*(\S*)\s*(.*)/;
- $symbol = "$1";
- $value = $2;
- } else {
- $line =~ /(?is)define\((.*)\)\s*(\S*)\s*(.*)/;
- my $options = $1;
- foreach my $key_value (split /,/, $options) {
- if ($key_value =~ /\s*(\S*)\s*=\s*(\S*)\s*/) {
- ${$modifiers}{$1} = $2;
- }
- }
- $symbol = "$2";
- $value = $3;
- }
- next if (! defined $symbol or length($symbol) == 0);
-
- $value =~ s/^\s+|\s+$//g;
-
- $value =~ s/" FIRMWARE_URL "/https:\/\/github.com\/prusa3d\/Prusa-i3-Plus\//;
- $value =~ s/" PROTOCOL_VERSION "/1.0/;
- $value =~ s/" STRINGIFY\(EXTRUDERS\) "/1/;
- $value =~ s/" MACHINE_UUID "/00000000-0000-0000-0000-000000000000/;
- ${$out}{$symbol} = { value=>$value, %$modifiers };
- }
- return $out;
- }
- sub pgm_is_whitespace
- {
- my ($c) = @_;
- if (! defined($c)) {
- print "pgm_is_whitespace: undefined\n";
- exit(1);
- }
- return $c == ord(' ') || $c == ord('\t') || $c == ord('\r') || $c == ord('\n');
- }
- sub pgm_is_interpunction
- {
- my ($c) = @_;
- return $c == ord('.') || $c == ord(',') || $c == ord(':') || $c == ord(';') || $c == ord('?') || $c == ord('!') || $c == ord('/');
- }
- sub break_text_fullscreen
- {
- my $lines = [];
- my ($text_str, $max_linelen) = @_;
- if (! defined($text_str) || length($text_str) < 2) {
- return $lines;
- }
- $text_str =~ s/^"//;
- $text_str =~ s/([^\\])"/$1/;
- $text_str =~ s/\\"/"/;
- my @msg = unpack("W*", $text_str);
-
- my $len = $#msg + 1;
- my $i = 0;
- LINE:
- while ($i < $len) {
- while ($i < $len && pgm_is_whitespace($msg[$i])) {
- $i += 1;
- }
- if ($i == $len) {
-
- last LINE;
- }
- my $msgend2 = $i + (($max_linelen > $len) ? $len : $max_linelen);
- my $msgend = $msgend2;
- if ($msgend < $len && ! pgm_is_whitespace($msg[$msgend]) && ! pgm_is_interpunction($msg[$msgend])) {
-
- while ($msgend > $i && ! pgm_is_whitespace($msg[$msgend - 1])) {
- $msgend -= 1;
- }
- if ($msgend == $i) {
-
- $msgend = $msgend2;
- }
- }
- my $outstr = substr($text_str, $i, $msgend - $i);
- $i = $msgend;
- $outstr =~ s/~/ /g;
-
- push @$lines, $outstr;
- }
- return $lines;
- }
- my %texts;
- my %attributes;
- my $num_languages = 0;
- if (1)
- {
-
- my $symbols = parselang("language_common.h");
- foreach my $key (keys %{$symbols}) {
- if (! (exists $texts{$key})) {
- my $symbol_value = ${$symbols}{$key};
-
- $texts{$key} = [ (${$symbol_value}{value}) x ($#langs+1) ];
-
- delete ${$symbol_value}{value};
-
- ${$symbol_value}{common} = 1;
-
- ${$symbol_value}{length} = 320;
- ${$symbol_value}{lines} = 1;
- $attributes{$key} = $symbol_value;
- } else {
- print "Duplicate key in language_common.h: $key\n";
- }
- }
- }
- foreach my $lang (@langs) {
- my $symbols = parselang("language_$lang.h");
- foreach my $key (keys %{$symbols}) {
- if (! (exists $texts{$key})) {
- $texts{$key} = [];
- }
- my $symbol_value = ${$symbols}{$key};
- my $strings = $texts{$key};
- if (defined $attributes{$key} && defined ${$attributes{$key}}{common} && ${$attributes{$key}}{common} == 1) {
-
- } else {
- die "Symbol $key defined first in $lang, undefined in the preceding language files."
- if (scalar(@$strings) != $num_languages);
- push @$strings, ${$symbol_value}{value};
- if ($lang eq 'en') {
-
- delete ${$symbol_value}{value};
- $attributes{$key} = $symbol_value;
- }
- }
- }
- $num_languages += 1;
- foreach my $key (keys %texts) {
- my $strings = $texts{$key};
- if (scalar(@$strings) < $num_languages) {
-
- print "Symbol $key undefined in language \"$lang\". Using the english variant:\n";
- print "\t", ${$strings}[0], "\n";
- push @$strings, ${$strings}[0];
- }
- }
- }
- my $filename = 'language_all.h';
- open(my $fh, '>', $filename) or die "Could not open file '$filename' $!";
- print $fh <<END
- // Language indices into their particular symbol tables.
- END
- ;
- for my $i (0 .. $#langs) {
- my $lang = uc $langs[$i];
- print $fh "#define LANG_ID_$lang $i\n";
- }
- print $fh <<END
- // Language is not defined and it shall be selected from the menu.
- // Language is not defined on a virgin RAMBo board.
- // Default language ID, if no language is selected.
- // Number of languages available in the language table.
- // Currectly active language selection.
- extern unsigned char lang_selected;
- END
- ;
- foreach my $key (sort(keys %texts)) {
- my $strings = $texts{$key};
- if (@{$strings} == grep { $_ eq ${$strings}[0] } @{$strings}) {
-
- print $fh "extern const char* const ${key}_LANG_TABLE[1];\n";
- print $fh "#define $key LANG_TABLE_SELECT_EXPLICIT(${key}_LANG_TABLE, 0)\n";
- } else {
- print $fh "extern const char* const ${key}_LANG_TABLE[LANG_NUM];\n";
- print $fh "#define $key LANG_TABLE_SELECT(${key}_LANG_TABLE)\n";
- print $fh "#define ${key}_EXPLICIT(LANG) LANG_TABLE_SELECT_EXPLICIT(${key}_LANG_TABLE, LANG)\n"
- if ($key eq "MSG_LANGUAGE_NAME" || $key eq "MSG_LANGUAGE_SELECT");
- }
- }
- print $fh <<END
- extern char* CAT2(const char *s1,const char *s2);
- extern char* CAT4(const char *s1,const char *s2,const char *s3,const char *s4);
- END
- ;
- close $fh;
- print ".h created\n";
- $filename = 'language_all.cpp';
- open($fh, '>', $filename) or die "Could not open file '$filename' $!";
- print $fh <<'END'
- extern unsigned char lang_selected;
- END
- ;
- my @keys = sort(keys %texts);
- foreach my $key (@keys) {
- my $strings = $texts{$key};
- if (@{$strings} == grep { $_ eq ${$strings}[0] } @{$strings}) {
-
- $strings = [${$strings}[0]];
- }
- for (my $i = 0; $i <= $#{$strings}; $i ++) {
- my $suffix = uc($langs[$i]);
- if ($i == 0 || ${$strings}[$i] ne ${$strings}[0]) {
- print $fh "const char ${key}_${suffix}[] PROGMEM = ${$strings}[$i];\n";
- }
- }
- my $langnum = $#{$strings}+1;
- if ($langnum == $#langs+1) {
- $langnum = "LANG_NUM";
- }
- print $fh "const char * const ${key}_LANG_TABLE[$langnum] PROGMEM = {\n";
- for (my $i = 0; $i <= $#{$strings}; $i ++) {
- my $suffix = uc($langs[$i]);
- if ($i == 0 || ${$strings}[$i] ne ${$strings}[0]) {
- print $fh "\t${key}_${suffix}";
- } else {
- print $fh "\t${key}_EN";
- }
- print $fh ',' if $i < $#{$strings};
- print $fh "\n";
- }
- print $fh "};\n\n";
- }
- print $fh <<'END'
- char langbuffer[LCD_WIDTH+1];
- char* CAT2(const char *s1,const char *s2) {
- unsigned char len=0;
- strncpy_P(langbuffer+len,s1,LCD_WIDTH-len);
- len+=strlen_P(s1);
- strncpy_P(langbuffer+len,s2,LCD_WIDTH-len);
- return langbuffer;
- }
- char* CAT4(const char *s1,const char *s2,const char *s3,const char *s4) {
- unsigned char len=0;
- strncpy_P(langbuffer+len,s1,LCD_WIDTH-len);
- len+=strlen_P(s1);
- strncpy_P(langbuffer+len,s2,LCD_WIDTH-len);
- len+=strlen_P(s2);
- strncpy_P(langbuffer+len,s3,LCD_WIDTH-len);
- len+=strlen_P(s3);
- strncpy_P(langbuffer+len,s4,LCD_WIDTH-len);
- return langbuffer;
- }
- END
- ;
- print ".cpp created.\nDone!\n";
- my $verify_only = 1;
- for my $lang (0 .. $#langs) {
- print "Language: $langs[$lang]\n";
- foreach my $key (@keys) {
- my $strings = $texts{$key};
- my %attrib = %{$attributes{$key}};
- my $message = ${$strings}[$lang];
- $message =~ /\S*"(.*)"\S*/;
- $message = $1;
- if ($lang == 0 || ${$strings}[0] ne $message) {
-
- my $max_nlines = $attrib{lines} // 1;
- my $max_linelen = $attrib{length} // (($max_nlines > 1) ? 20 : 17);
- if ($max_nlines <= 1) {
- my $linelen = length($message);
- if ($linelen > $max_linelen) {
- print "Key $key, language $langs[$lang], line length: $linelen, max length: $max_linelen\n";
- print "\t$message\n";
- }
- } else {
- my $lines = break_text_fullscreen($message, $max_linelen);
- my $nlines = @{$lines};
- if ($nlines > $max_nlines) {
- print "Key $key, language $langs[$lang], lines: $nlines, max lines: $max_nlines\n";
- print "\t$_\n" foreach (@{$lines});
- }
- }
- }
- }
- }
|