charset: legacy map ansel (and extensions)
authorMischa POSLAWSKY <perl@shiar.org>
Sat, 8 Jan 2022 04:00:39 +0000 (05:00 +0100)
committerMischa POSLAWSKY <perl@shiar.org>
Mon, 7 Feb 2022 17:42:33 +0000 (18:42 +0100)
Reference: Wikipedia, <https://www.gedsite.com/en/character-encoding.htm>

charset-encoding.inc.pl
charset.plp

index b5345101f966b750c167a8690f9fa5d5f85d481f..f4a9f26d1f9007a8153d320f467b40665a2a44ff 100644 (file)
@@ -218,7 +218,7 @@ use utf8;
        'cp1026'       => {inherit => ['cp37' => '40']},
        'cp875'        => {inherit => ['cp37' => '30']},
 
        'cp1026'       => {inherit => ['cp37' => '40']},
        'cp875'        => {inherit => ['cp37' => '30']},
 
-       legacy     => [qw( cp437 ATASCII PETSCII MSX ZX-Spectrum )],
+       legacy     => [qw( cp437 ATASCII PETSCII MSX ZX-Spectrum ANSEL )],
        'petscii'      => {inherit => ['' => '40-7F+A0-BF'], setup => sub {
                $_[0]->{table} = [(map {chr} 0 .. 0x3F), qw(
                        @ a b c d e f g h i j k l m n o p q r s t u v w x y z [ £ ] ↑ ←
        'petscii'      => {inherit => ['' => '40-7F+A0-BF'], setup => sub {
                $_[0]->{table} = [(map {chr} 0 .. 0x3F), qw(
                        @ a b c d e f g h i j k l m n o p q r s t u v w x y z [ £ ] ↑ ←
@@ -262,6 +262,36 @@ use utf8;
                        0xF7 => 'œ',
                },
        },
                        0xF7 => 'œ',
                },
        },
+       'ansel'        => {
+               note => '+GEDCOM',
+               inherit => ['' => 'A0-CF+E0-FE'],
+               setup => sub {
+                       $_[0]->{table} = [
+                               (undef) x 0xA0,
+                               undef, qw( Ł Ø Đ Þ Æ Œ ʹ · ♭ ®    ±          Ơ Ư ʾ ), undef,
+                               qw( ʿ      ł ø đ þ æ œ ʺ ı £ ð ), undef, qw( ơ ư ), undef, undef,
+                               qw( °      ℓ ℗ © ♯ ¿ ¡ ), (undef) x 0x19,
+                               (map {$_ && chr}
+                                       0x309, 0x300, 0x0301, 0x0302, 0x0303, 0x304, 0x306, 0x307,
+                                       0x308, 0x30C, 0x030A, 0xFE20, 0xFE21, 0x315, 0x30B, 0x310,
+                                       0x327, 0x328, 0x0323, 0x0324, 0x0325, 0x333, 0x332, 0x326,
+                                       0x31C, 0x32E, 0xFE22, 0xFE23, undef,  undef, 0x313, undef,
+                               ),
+                       ];
+               },
+               replace => {
+                       # GEDCOM extensions
+                       0xBE => '□',
+                       0xBF => '■',
+                       0xCD => 'e', # endowment?
+                       0xCE => 'o', # ordinance?
+                       0xCF => 'ß',
+                       0xFC => "\x{338}",
+                       # MARC21 extensions
+                       0xC7 => 'ß',
+                       0xC8 => '€',
+               },
+       },
 
        ''             => {setup => sub {
                my $row = shift;
 
        ''             => {setup => sub {
                my $row = shift;
index 2257fb8bbaf2987d6055f69a1c8ed12e82e9b915..9ab15f1a20764ac55bc1994a01abcf6a1249d266 100644 (file)
@@ -98,6 +98,7 @@ sub tabinput {
 
        state $visible = {'' => 1};  # all present tables
        my %row = (offset => 0, cols => 16);
 
        state $visible = {'' => 1};  # all present tables
        my %row = (offset => 0, cols => 16);
+       $row{$_} = $charset->{$_} for qw( note );  # copy metadata
 
        if (not defined $params) {
                my @parents = @{ $charset->{inherit} || [] };
 
        if (not defined $params) {
                my @parents = @{ $charset->{inherit} || [] };
@@ -291,8 +292,8 @@ for my $row (@request) {
 
        printf '<div class="section"><table class="glyphs%s">', !$row->{cell} && ' charmap';
        my $title = $row->{set};
 
        printf '<div class="section"><table class="glyphs%s">', !$row->{cell} && ' charmap';
        my $title = $row->{set};
-       $title .= " <aside>(over $_)</aside>"
-               for $row->{parent} || ();
+       $title .= " <aside>(over $_)</aside>" for $row->{parent} || ();
+       $title .= " <aside>($_)</aside>" for $row->{note} || ();
        printf '<caption>%s</caption>', $title;
        print '<col>' x ($cols + 1);
        for my $section (qw{thead}) {
        printf '<caption>%s</caption>', $title;
        print '<col>' x ($cols + 1);
        for my $section (qw{thead}) {