unicode: table improvements
authorMischa POSLAWSKY <perl@shiar.org>
Tue, 16 Sep 2008 02:43:17 +0000 (02:43 +0000)
committerMischa POSLAWSKY <perl@shiar.org>
Thu, 9 Oct 2008 20:59:20 +0000 (20:59 +0000)
Updated glyph table rendering code, notably featuring:
- cells spanning multiple columns for the IPA table;
- showing Unicode value if there's no digraph known.

unicode.plp

index 4d48bb4..7c05183 100644 (file)
@@ -48,14 +48,20 @@ td {
        vertical-align: top;
        margin: 0;
        padding: 0;
+       width: 1.6em;
 }
 small {
        font-size: 50%;
        display: block;
-       width: 3.2em;
+}
+small.digraph {
        background: #888;
        color: #FFF;
 }
+small.value {
+       background: #CCC;
+       color: #666;
+}
 
 td.empty {
        background: #DDD;
@@ -88,79 +94,100 @@ sub quote {
 sub table {
        my ($width, $digraphs, $rowheads, $colheads) = @_;
 
-       my @cells;
-       push @cells, sprintf '<td title="%s"%s>%s%s',
-               $di{ord $_} && $diinfo->{$di{ord $_}}->[1],
-               $_ eq '-' ? ' class="empty"' : $_ eq '=' ? ' class="reserved"' : '',
-               $_ eq '-' || $_ eq '=' ? '&nbsp;' : quote($_),
-               $di{ord $_} && sprintf(' <small>%s</small>', $di{ord $_})
-                       for @$digraphs;
-
-       if ($rowheads) {
-               splice @cells, $_ * $width, 0, '<th>'.($rowheads->[$_] || '&nbsp;')
-                       for reverse 0 .. $#cells / $width;
-               $width++;
-       }
-
        my @rows;
-       push @rows, sprintf '<tr>%s', join '', splice @cells, 0, $width, ()
-               while @cells;
+
+       my $colspan = 1;
+       for my $cell (@$digraphs) {
+               my $class;
+               if ($cell eq '.') {
+                       push @rows, '';
+                       $rows[-1] .= '<th>'.(shift @$rowheads || '&nbsp;') if $rowheads;
+                       next;
+               }
+               elsif ($cell eq '>') {
+                       $colspan++;
+                       next;
+               }
+               elsif ($cell =~ s/^-//) {
+                       $class = 'empty';
+               }
+               elsif ($cell eq '=') {
+                       $class = 'reserved';
+                       $cell = '';
+               }
+
+               my $code = join '', map { $di{ord $_} || '' } split //, $cell;
+               my $name = $diinfo->{$code}->[1];
+
+               $rows[-1] .= sprintf('<td%s%s%s>%s%s',
+                       defined $name  ? qq{ title="$name"}  : '',
+                       defined $class ? qq{ class="$class"} : '',
+                       $colspan > 1 && qq{ colspan="$colspan"},
+                       $cell eq '' ? '&nbsp;' : quote($cell),
+                       $code ne '' ? sprintf(' <small class="digraph">%s</small>', quote($code))
+                               : length($cell) == 1 && $cell !~ /[a-z]/
+                                       ? sprintf(' <small class="%s">%04X</small>', 'value', ord $cell)
+                                       : '',
+               );
+
+               $colspan = 1;
+       }
 
        if ($colheads) {
                unshift @rows, sprintf '<thead><tr><td>%s<tbody>', join '',
-                       map { sprintf '<th title="%2$s">%s', split(/:/, $colheads->[$_], 2) }
-                       0 .. $width-2;
+                       map { sprintf '<th title="%2$s">%s', split(/:/, $_, 2) }
+                       @$colheads
        }
 
-       return sprintf "<table>%s</table>\n", join '', @rows;
+       return sprintf "<table>\n%s</table>\n", join '', map {"<tr>$_\n"} @rows;
 }
 
 print "<h2>Arrows</h2>\n\n";
 print table(@$_) for (
-       [ 4 => [qw{↖ ↑ ↗ ↔  ← - → ↕  ↙ ↓ ↘ -}]],
-       [ 4 => [qw{⇖ ⇑ ⇗ ⇔  ⇐ - ⇒ ⇕  ⇘ ⇓ ⇙ -}]],
-       [ 3 => [qw{◤ ▲ ◥  ◀ ◆ ▶  ◣ ▼ ◢}]],
-       [ 3 => [qw{◸ △ ◹  ◁ ◇ ▷  ◺ ▽ ◿}]],
+       [ 4 => [qw{. ↖ ↑ ↗ ↔ . ← - → ↕ . ↙ ↓ ↘ -}]],
+       [ 4 => [qw{. ⇖ ⇑ ⇗ ⇔ . ⇐ - ⇒ ⇕ . ⇘ ⇓ ⇙ -}]],
+       [ 3 => [qw{. ◤ ▲ ◥ . ◀ ◆ ▶ . ◣ ▼ ◢}]],
+       [ 3 => [qw{. ◸ △ ◹ . ◁ ◇ ▷ . ◺ ▽ ◿}]],
 );
 
 print "<h2>Line drawing</h2>\n\n";
 print table(@$_) for (
-       [ 4 => [qw{┌ ┬ ┐ ─  ├ ┼ ┤ │  └ ┴ ┘ -}]],
-       [ 4 => [qw{┏ ┳ ┓ ━  ┣ ╋ ┫ ┃  ┗ ┻ ┛ -}]],
-       [ 3 => [qw{┍ ┯ ┑  ┝ ┿ ┥  ┕ ┷ ┙}]],
-       [ 3 => [qw{┎ ┰ ┒  ┠ ╂ ┨  ┖ ┸ ┚}]],
-#      [ 4 => [qw{╔ ╦ ╗ ═  ╠ ╬ ╣ ║  ╚ ╩ ╝ -}]],
-#      [ 3 => [qw{╒ ╤ ╕  ╞ ╪ ╡  ╘ ╧ ╛}]],
-#      [ 3 => [qw{╓ ╥ ╖  ╟ ╫ ╢  ╙ ╨ ╜}]],
+       [ 4 => [qw{. ┌ ┬ ┐ ─ . ├ ┼ ┤ │ . └ ┴ ┘ -}]],
+       [ 4 => [qw{. ┏ ┳ ┓ ━ . ┣ ╋ ┫ ┃ . ┗ ┻ ┛ -}]],
+       [ 3 => [qw{. ┍ ┯ ┑ . ┝ ┿ ┥ . ┕ ┷ ┙}]],
+       [ 3 => [qw{. ┎ ┰ ┒ . ┠ ╂ ┨ . ┖ ┸ ┚}]],
+#      [ 4 => [qw{. ╔ ╦ ╗ ═ . ╠ ╬ ╣ ║ . ╚ ╩ ╝ -}]],
+#      [ 3 => [qw{. ╒ ╤ ╕ . ╞ ╪ ╡ . ╘ ╧ ╛}]],
+#      [ 3 => [qw{. ╓ ╥ ╖ . ╟ ╫ ╢ . ╙ ╨ ╜}]],
 );
 
 print "<h2>Signs</h2>\n\n";
 print table(@$_) for (
-       [ 3 => [qw{▘ ▀ ▝  ▌ █ ▐  ▖ ▄ ▗  ░ ▒ ▓}]],
-       [ 3 => [qw{□ ▣ ■  ▤ ▦ ▥  ▧ ▩ ▨}]],
-       [ 4 => [qw{♠ ♡ ♢ ♣  ♤ ♥ ♦ ♧}]],
-       [10 => [qw{☼ ☿ ♀ ♁ ♂ ♃ ♄ ♅ ♆ ♇}]],  # solar
-#      [12 => [qw{♈ ♉ ♊ ♋ ♌ ♍ ♎ ♏ ♐ ♑ ♒ ♓}]],  # zodiac
-       [ 8 => [qw{¤ ¢ ₥ € £ ₨ $ ¥  ₫ ₭ ₦ ₱ ₧ ₮ ₩ ₪}]],
+       [ 3 => [qw{. ▘ ▀ ▝ . ▌ █ ▐ . ▖ ▄ ▗ . ░ ▒ ▓}]],
+       [ 3 => [qw{. □ ▣ ■ . ▤ ▦ ▥ . ▧ ▩ ▨}]],
+       [ 4 => [qw{. ♠ ♡ ♢ ♣ . ♤ ♥ ♦ ♧}]],
+       [ 5 => [qw{. ☼ ☿ ♀ ♁ ♂ ♃ ♄ ♅ ♆ ♇}]],  # solar
+#      [12 => [qw{♈ ♉ ♊ ♋ ♌ ♍ ♎ ♏ ♐ ♑ ♒ ♓}]],  # zodiac
+       [ 8 => [qw{. ¤ ¢ ₥ € £ ₨ $ ¥ . ₫ ₭ ₦ ₱ ₧ ₮ ₩ ₪}]],
 );
 
 print "<h2>IPA</h2>\n\n";
 print table(@$_) for (
        [
                12 => [qw{
-                       p t - ʈ - c k q - = ʡ ʔ
-                       b d - ɖ - ɟ ɡ ɢ - = - =
-                       m ɱ - n - ɳ ɲ ŋ ɴ = = =
-                       ʙ - - r - - - = ʀ = я =
-                       - ⱱ - ɾ - ɽ - = ɢ̆ = - =
-                       ɸ f θ s ʃ ʂ ç x χ ħ ʜ h
-                       β v ð z ʒ ʐ ʝ ɣ ʁ ʕ ʢ ɦ
-                       = = - ɬ - - - - - = = =
-                       = = - ɮ - - - - - = = =
-                       - ʋ - ɹ - ɻ j ɰ - - - =
-                       = = - l - ɭ ʎ ʟ - = = =
-                       ʘ - ǀ ǁ ǃ - ǂ - - = = =
-                       ɓ - ɗ - - - ʄ ɠ ʛ - - -
+                       . p  p̪  >  >  t  ʈ  c  k  q  =  ʡ  ʔ
+                       . b  b̪  >  >  d  ɖ  ɟ  ɡ  ɢ  =  -  =
+                       . m  ɱ  >  >  n  ɳ  ɲ  ŋ  ɴ  =  =  =
+                       . ʙ  -  >  >  r  -  -  =  ʀ  =  -я =
+                       . -  ⱱ  >  >  ɾ  ɽ  -  =  ɢ̆  =  -  =
+                       . ɸ  f  θ  s  ʃ  ʂ  ç  x  χ  ħ  ʜ  h
+                       . β  v  ð  z  ʒ  ʐ  ʝ  ɣ  ʁ  ʕ  ʢ  ɦ
+                       . =  =  >  >  ɬ  -  -  -  -  =  =  =
+                       . =  =  >  >  ɮ  -  -  -  -  =  =  =
+                       . -  ʋ  >  >  ɹ  ɻ  j  ɰ  -  -  -  =
+                       . =  =  >  >  l  ɭ  ʎ  ʟ  -  =  =  =
+                       . ʘ  -  ǀ  ǁ  ǃ  -‼ ǂ  -  -  =  =  =
+                       . ɓ  ɗ̪  >  >  ɗ  -ᶑ ʄ  ɠ  ʛ  =  =  =
                }],
                [
                        'Plosive',
@@ -183,13 +210,13 @@ print table(@$_) for (
        ],
        [
                6 => [qw{
-                       i y  ɨ ʉ  ɯ u
-                       - ɪ  ʏ -  ʊ -
-                       e ø  ɘ ɵ  ɤ o
-                       - -  ə -  - -
-                       ɛ œ  ɜ ɞ  ʌ ɔ
-                       æ -  ɐ -  - -
-                       a ɶ  - -  ɑ ɒ
+                       i y  ɨ ʉ  ɯ u
+                       - ɪ  ʏ -  ʊ -
+                       e ø  ɘ ɵ  ɤ o
+                       - -  ə -  - -
+                       ɛ œ  ɜ ɞ  ʌ ɔ
+                       æ -  ɐ -  - -
+                       a ɶ  - -  ɑ ɒ
                }],
                [qw{Close Near-close Close-mid Mid Open-mid Near-open Open}],
                [map {substr($_, 0, 1).':'.$_, substr($_, 0, 1)." r:$_ rounded"} qw{Front Central Back}]