Shiar_Sheet/KeyboardChars.pm

   1 package Shiar_Sheet::KeyboardChars;
   2
   3 use 5.020;
   4 use warnings;
   5 use utf8;
   6 use experimental 'signatures';
   7 use parent 'Exporter';
   8 use Unicode::Normalize qw( NFKD );
   9 use Text::Unidecode ();
  10 use Shiar_Sheet::FormatChar;
  11
  12 our $VERSION = '1.04';
  13 our @EXPORT = qw( kbchars kbmodes );
  14
  15 my $uc = Shiar_Sheet::FormatChar->new;
  16
  17 our %unaccent = qw(
  18         ⍺ a  ⍵ w  ∊ E  ⍷ E  ⍴ r  ⍳ i  ⍸ i  ○ O  ⍥ O  ⌿ /  ⍟ (*) ⊕ (+)
  19         Ʊ U  ǝ e  Ǝ E  ʌ vA Ʌ VA ɥ h  ʘ O  ɰ mw ɯ mw Ɯ MW ə @ae Ə @AE
  20         ɸ PF ʎ yl ɔ co Ɔ CO ɛ 3E ƣ q  Ƣ Q  ∀ A  ∃ E  ∪ u  ∩ n   ≠ !=
  21         ≈ =~ ∅ /0 ∘ o  ⋅ .  ∫ s  ≝ =d ″ "  ≤ <  ≥ >  √ rV ∛ 3V  ∜ 4V
  22         Α A  Β B  Γ G  Δ D  Ε E  Ζ Z  Η H  Θ CQ Ι I  Κ K  Λ L  Μ M
  23         Ν N  Ξ X  Ο O  Π P  Ρ R  Σ S  Τ T  Υ YU Φ F  Χ CX Ψ Y  Ω W
  24         α a  β b  γ g  δ d  ε e  ζ z  η h  θ cq ι i  κ k  λ l  μ m
  25         ν n  ξ x  ο o  π p  ρ r  σ s  τ t  υ yu φ f  χ cx ψ y  ω w
  26                                  ς sc      ϑ cq                µ mu
  27 );
  28
  29 sub unidecode {
  30         return $unaccent{$_[0]} // Text::Unidecode::unidecode($_[0]);
  31 }
  32
  33 sub kbchars ($rows) {
  34         return kbmodes({'' => $rows});
  35 }
  36
  37 sub kbmodes ($modes) {
  38         my %g; # present group classes
  39         my %info = (
  40                 tableclass => 'keys big',
  41                 rows => [1, 0],
  42         );
  43         for my $lead (keys %{$modes}) {
  44                 if ($lead ne '') {
  45                         $info{def}->{''}->{$lead} = "g1 mode$lead";
  46                         $g{g1} = 1;
  47                         $info{mode}->{$lead} //= "mode $lead";
  48                         $info{def}->{$lead}{$lead} = 'g1 mode'; # back
  49                 }
  50                 while (my ($k, $v) = each %{ $modes->{$lead} }) {
  51                         my ($glyph, $title) = $uc->glyph_html($v);
  52                         $info{key}{$lead.$k} = join "\n", $glyph, $title;
  53                         my $c = $k =~ s/\A[+^](?=.)//r;  # trim modifier indicator
  54
  55                         my $class = (
  56                                   !defined $v || $c eq $v ? 'no' # identical
  57                                 : $v =~ /\A\p{Mn}+\z/ ? 'g9' # combining accent
  58                                 : NFKD($v) =~ /\A\Q$c\E\p{Mn}*\z/ ? 'g2' # decomposed equivalent
  59                                 : unidecode($v) =~ /\Q$c\E+/i ? 'g4' # transliterated
  60                                 : $v =~ /\A[\p{Sk}\p{Lm}]+\z/ ? 'g8' # modifier symbol
  61                                 : $v =~ /\A[\pM\pP]+\z/ ? 'g7' # mark
  62                                 : $v =~ /^\p{Latin}/ ? 'g5' # latin script
  63                                 : 'g6'
  64                         );
  65                         $g{$class} = 1 unless $class eq 'no';
  66                         $info{def}{$lead}{$k} //= $class;
  67                 }
  68         }
  69         $info{flag} = {%{{
  70                 g1 => ['mode' => "switch to an alternate set of keys"],
  71                 g2 => ['accented', "decomposes to the original letter with a combining accent"],
  72                 g4 => ['similar', "transliterates (mostly) into the unmodified letter"],
  73                 g5 => ['latin', "a different (accented) latin letter"],
  74                 g6 => ['symbol', "other character not directly deducible from key"],
  75                 g7 => ['punctuation', "(punctuation) mark"],
  76                 g8 => ['mark', "modifier letter or mark (spacing diacritic)"],
  77                 g9 => ['combining', "diacritical mark to be combined with a following character"],
  78         }}{keys %g}};
  79         return \%info;
  80 }
  81
  82 1;