charset: encode wingdings font
authorMischa POSLAWSKY <perl@shiar.org>
Fri, 21 Apr 2017 20:03:50 +0000 (22:03 +0200)
committerMischa POSLAWSKY <perl@shiar.org>
Thu, 25 May 2017 20:10:23 +0000 (22:10 +0200)
Custom Encode module to map Windows font to equivalent Unicode.

Reference: <http://www.alanwood.net/demos/wingdings.html>

Encode/Wingdings.pm [new file with mode: 0644]
charset.plp

diff --git a/Encode/Wingdings.pm b/Encode/Wingdings.pm
new file mode 100644 (file)
index 0000000..df06b86
--- /dev/null
@@ -0,0 +1,31 @@
+package Encode::Wingdings;
+
+use 5.014;
+use warnings;
+use utf8;
+
+our $VERSION = '1.00';
+
+use parent 'Encode::Encoding';
+__PACKAGE__->Define('wingdings');
+
+our @MAP = (qw[
+         ๐Ÿ–‰ โœ‚ โœ ๐Ÿ‘“ ๐Ÿ•ญ ๐Ÿ•ฎ ๐Ÿ•ฏ ๐Ÿ•ฟ โœ† ๐Ÿ–‚ ๐Ÿ–ƒ ๐Ÿ“ช ๐Ÿ“ซ ๐Ÿ“ฌ ๐Ÿ“ญ ๐Ÿ“ ๐Ÿ“‚ ๐Ÿ“„ ๐Ÿ— ๐Ÿ— ๐Ÿ—„ โŒ› ๐Ÿ–ฎ ๐Ÿ–ฐ ๐Ÿ–ฒ ๐Ÿ–ณ ๐Ÿ–ด ๐Ÿ–ซ ๐Ÿ–ฌ โœ‡ โœ
+       ๐Ÿ–Ž โœŒ ๐Ÿ‘Œ ๐Ÿ‘ ๐Ÿ‘Ž โ˜œ โ˜ž โ˜ โ˜Ÿ ๐Ÿ– โ˜บ ๐Ÿ˜ โ˜น ๐Ÿ’ฃ โ˜  ๐Ÿณ ๐Ÿฑ โœˆ โ˜ผ ๐Ÿ’ง โ„ ๐Ÿ•† โœž ๐Ÿ•ˆ โœ  โœก โ˜ช โ˜ฏ เฅ โ˜ธ โ™ˆ โ™‰
+       โ™Š โ™‹ โ™Œ โ™ โ™Ž โ™ โ™ โ™‘ โ™’ โ™“ ๐Ÿ™ฐ ๐Ÿ™ต โ— ๐Ÿ”พ โ–  โ–ก ๐Ÿž โ‘ โ’ โฌง โงซ โ—† โ– โฌฅ โŒง โฎน โŒ˜ ๐Ÿต ๐Ÿถ ๐Ÿ™ถ ๐Ÿ™ท \7f
+       โ“ช โ‘  โ‘ก โ‘ข โ‘ฃ โ‘ค โ‘ฅ โ‘ฆ โ‘ง โ‘จ โ‘ฉ โ“ฟ โถ โท โธ โน โบ โป โผ โฝ โพ โฟ ๐Ÿ™ข ๐Ÿ™  ๐Ÿ™ก ๐Ÿ™ฃ ๐Ÿ™ž ๐Ÿ™œ ๐Ÿ™ ๐Ÿ™Ÿ ยท โ€ข
+       โ–ช โšช ๐Ÿž† ๐Ÿžˆ โ—‰ โ—Ž ๐Ÿ”ฟ โ–ช โ—ป ๐ŸŸ‚ โœฆ โ˜… โœถ โœด โœน โœต โฏ โŒ– โŸก โŒ‘ โฏ‘ โœช โœฐ ๐Ÿ• ๐Ÿ•‘ ๐Ÿ•’ ๐Ÿ•“ ๐Ÿ•” ๐Ÿ•• ๐Ÿ•– ๐Ÿ•— ๐Ÿ•˜
+       ๐Ÿ•™ ๐Ÿ•š ๐Ÿ•› โฎฐ โฎฑ โฎฒ โฎณ โฎด โฎต โฎถ โฎท ๐Ÿ™ช ๐Ÿ™ซ ๐Ÿ™• ๐Ÿ™” ๐Ÿ™— ๐Ÿ™– ๐Ÿ™ ๐Ÿ™‘ ๐Ÿ™’ ๐Ÿ™“ โŒซ โŒฆ โฎ˜ โฎš โฎ™ โฎ› โฎˆ โฎŠ โฎ‰ โฎ‹ ๐Ÿกจ
+       ๐Ÿกช ๐Ÿกฉ ๐Ÿกซ ๐Ÿกฌ ๐Ÿกญ ๐Ÿกฏ ๐Ÿกฎ ๐Ÿกธ ๐Ÿกบ ๐Ÿกน ๐Ÿกป ๐Ÿกผ ๐Ÿกฝ ๐Ÿกฟ ๐Ÿกพ โ‡ฆ โ‡จ โ‡ง โ‡ฉ โฌ„ โ‡ณ โฌ€ โฌ โฌƒ โฌ‚ ๐Ÿขฌ ๐Ÿขญ ๐Ÿ—ถ โœ” ๐Ÿ—ท ๐Ÿ—น ๏ฃฟ
+]);
+
+sub decode ($$;$) {
+       my ($self, $input, $check) = @_;
+       my $output = '';
+       for (unpack 'C*', $input) {
+               $output .= $_ < 33 ? chr : $MAP[$_ - 33];
+       }
+       return $output;
+}
+
+1;
index d25f23cb67dde519774f01dc5858af7f6de407f4..25bc44b6e14ac26f77b98ff3a08be0da33e91fd3 100644 (file)
@@ -105,7 +105,7 @@ sub tabinput {
                hebrew     => [qw( iso-8859-8 cp1255 MacHebrew cp862  U59-5F )],
                thai       => [qw( iso-8859-11 cp874 MacThai )],
                vietnamese => [qw( viscii cp1258 MacVietnamese )],
                hebrew     => [qw( iso-8859-8 cp1255 MacHebrew cp862  U59-5F )],
                thai       => [qw( iso-8859-11 cp874 MacThai )],
                vietnamese => [qw( viscii cp1258 MacVietnamese )],
-               symbols    => [qw( symbol dingbats MacDingbats )],
+               symbols    => [qw( symbol dingbats MacDingbats wingdings )],
 
                # iso-code shorthand
                1 => 'westeur',
 
                # iso-code shorthand
                1 => 'westeur',
@@ -138,6 +138,7 @@ sub tabinput {
                        'AdobeZdingbat'=> ['MacDingbats' => '128-159'], # should be identical but maps to private use
                        'symbol'      => ['' => '32-127+160'],
                        'AdobeSymbol' => ['symbol' => '32-127+160', '' => '32-127+160'], # minor differences, irrelevant except for different 'โ‚ฌ'
                        'AdobeZdingbat'=> ['MacDingbats' => '128-159'], # should be identical but maps to private use
                        'symbol'      => ['' => '32-127+160'],
                        'AdobeSymbol' => ['symbol' => '32-127+160', '' => '32-127+160'], # minor differences, irrelevant except for different 'โ‚ฌ'
+                       'wingdings'   => ['' => '32'],
 
                        'iso-8859-2'  => ['iso-8859-1' => '160'],
                        'iso-8859-3'  => ['iso-8859-1' => '160'], #TODO: also apply to iso-8859-9
 
                        'iso-8859-2'  => ['iso-8859-1' => '160'],
                        'iso-8859-3'  => ['iso-8859-1' => '160'], #TODO: also apply to iso-8859-9
@@ -252,6 +253,10 @@ sub tabinput {
                }
        }
 
                }
        }
 
+       if (lc $input eq 'wingdings') {
+               require Encode::Wingdings;
+       }
+
        if ($input =~ m{ \A u ([0-9a-f]+) (?:-([0-9a-f]+))? \z }ix) {
                my $start = hex($1) << ($2 ? 4 : 8);
                my $end = $2 ? (hex($2) << 4) + $row{cols} - 1 : $start + 255;
        if ($input =~ m{ \A u ([0-9a-f]+) (?:-([0-9a-f]+))? \z }ix) {
                my $start = hex($1) << ($2 ? 4 : 8);
                my $end = $2 ? (hex($2) << 4) + $row{cols} - 1 : $start + 255;