view release on metacpan or  search on metacpan

lib/UI/KeyboardLayout.pm  view on Meta::CPAN

⊥	uptack
â—‹	circle
⌈	upstile
∪	downshoe
⊃	rightshoe
⊂	leftshoe
⊣	lefttack
⊢	righttack

≤	lessthanequal
≠	notequal
≥	greaterthanequal
∫	integral
∴	therefore
∝	variation
∞	infinity
∇	nabla
∼	approximate
≃	similarequal
⇔	ifonlyif
⇒	implies
≡	identical
√	radical
⊂	includedin
⊃	includes
∩	intersection
∪	union
∧	logicaland
∨	logicalor
∂	partialderivative
Æ’	function
←	leftarrow
↑	uparrow
→	rightarrow
↓	downarrow
â—†	soliddiamond
â–’	checkerboard

		  CP Multi_key

+# KP_Add
-# KP_Subtract
*# KP_Multiply
/# KP_Divide
.# KP_Decimal
=# KP_Equal
SPC#	KP_Space

		  ← Left → Right ↑ Up ↓ Down
	     !, map {("$_#", "KP_$_")} 0..9);
} # `

my %dec_dotcompose = reverse @enc_dotcompose;
# perl -C31 -wne "/^(.)\tCyrillic_(\w+)/ and print qq($2 $1 )" oooo3 >oooo-cyr
# perl -C31 -wne "/^(.)\thebrew_(\w+)/ and print qq($2 $1 )" oooo3 >oooo-heb
my %cyr = qw( GHE_bar Ғ ghe_bar ғ ZHE_descender Җ zhe_descender җ KA_descender Қ ka_descender қ KA_vertstroke Ҝ ka_vertstroke ҝ
	      EN_descender Ò¢ en_descender Ò£ U_straight Ò® u_straight Ò¯ U_straight_bar Ò° u_straight_bar Ò± HA_descender Ò²
	      ha_descender Ò³ CHE_descender Ò¶ che_descender Ò· CHE_vertstroke Ò¸ che_vertstroke Ò¹ SHHA Òº shha Ò» SCHWA Ó˜ schwa Ó™
	      I_macron Ӣ i_macron ӣ O_bar Ө o_bar ө U_macron Ӯ u_macron ӯ io ё je ј lje љ nje њ dzhe џ IO Ё JE Ј LJE Љ NJE Њ
	      DZHE Џ yu ю a а be б tse ц de д ie е ef ф ghe г ha х i и shorti й ka к el л em м en н o о pe п ya я er р es с te т
	      u у zhe ж ve в softsign ь yeru ы ze з sha ш e э shcha щ che ч hardsign ъ YU Ю A А BE Б TSE Ц DE Д IE Е EF Ф GHE Г
	      HA Х I И SHORTI Й KA К EL Л EM М EN Н O О PE П YA Я ER Р ES С TE Т U У ZHE Ж VE В SOFTSIGN Ь YERU Ы ZE З SHA Ш E Э
	      SHCHA Щ CHE Ч HARDSIGN Ъ );
my %heb = qw( doublelowline ‗ aleph א bet ב gimel ג dalet ד he ה waw ו zain ז chet ח tet ט yod י finalkaph ך kaph כ lamed ל 
	      finalmem ם mem מ finalnun ן nun נ samech ס ayin ע finalpe ף pe פ finalzade ץ zade צ qoph ק resh ר shin ש taw ת 
	      beth ב gimmel ג daleth ד samekh ס zayin ז het ח teth ט zadi צ kuf ק taf ת );
my %grk = qw( ALPHAaccent Ά EPSILONaccent Έ ETAaccent Ή IOTAaccent Ί IOTAdieresis Ϊ OMICRONaccent Ό UPSILONaccent Ύ
	      UPSILONdieresis Ϋ OMEGAaccent Ώ accentdieresis ΅ horizbar ― alphaaccent ά epsilonaccent έ etaaccent ή iotaaccent ί
	      iotadieresis ϊ iotaaccentdieresis ΐ omicronaccent ό upsilonaccent ύ upsilondieresis ϋ upsilonaccentdieresis ΰ
	      omegaaccent ώ ALPHA Α BETA Β GAMMA Γ DELTA Δ EPSILON Ε ZETA Ζ ETA Η THETA Θ IOTA Ι KAPPA Κ LAMDA Λ LAMBDA Λ MU Μ
	      NU Ν XI Ξ OMICRON Ο PI Π RHO Ρ SIGMA Σ TAU Τ UPSILON Υ PHI Φ CHI Χ PSI Ψ OMEGA Ω alpha α beta β gamma γ delta δ
	      epsilon ε zeta ζ eta η theta θ iota ι kappa κ lamda λ lambda λ mu μ nu ν xi ξ omicron ο pi π rho ρ sigma σ 
	      finalsmallsigma ς tau τ upsilon υ phi φ chi χ psi ψ omega ω );
$dec_dotcompose{"Cyrillic_$_"} = "Cyr_$cyr{$_}" for keys %cyr;
$dec_dotcompose{"hebrew_$_"}   = "heb_$heb{$_}" for keys %heb;
$dec_dotcompose{"Greek_$_"}    =  "Gr_$grk{$_}" for keys %grk;

sub shorten_dotcompose ($$;$) {		# Shorten but leave readable disambiguous (to allow more concise printout)
  shift;				# self		[Later we massage out Cyr_ Gr_ uni_ prefixes
  (my $in = shift) =~ s/\b(Cyr|Ukr|Gr|heb|Ar)[a-z]+(?=_)/$1/;
  $in =~ s/\b(dead)(?=_)/d/;
  $in =~ s/\b(Gr_\w+dier|d_diaer)esis/$1/;
  $in =~ s/^U([a-fA-F\d]{4,6})$/ 'uni_' . chr hex $1 /e if shift;
  $in
}

sub dec_dotcompose ($$;$) {
  my($self, $in, $dec_U) = (shift, shift, shift);
  my($pre, $post) = split /:/, $in, 2;
  $post or warn("Can't parse <<$in>>"), return;
  my @pre = ($pre =~ /<(\w+)>/g) or warn("Unknown format of IN in <<$in>>"), return;
  my($p) = ($post =~ /"(.+?)"/) or warn("Unknown format of OUT in <<$in>>"), return;
  @pre = map { exists $KeySyms{$_}
  		? $KeySyms{$_}
  		: ( exists $dec_dotcompose{$_} ? $dec_dotcompose{$_} : $self->shorten_dotcompose($_, $dec_U) ) } @pre;
  (@pre, $p)
}

# Stats: about 250 in: egrep "CP.*d_|d_.*CP" o-std
sub process_dotcompose ($$$;$) {
  my($self, $fh, $sub, $dec_U) = (shift, shift, shift, shift);
  while (<$fh>) {
    next if /^\s*(#|include\b)/;
    next unless /\S/;
    next unless my @in = $self->dec_dotcompose($_, $dec_U);
    $sub->($self, $in[-1], @in[0..$#in-1]);
  }
}

sub filter_dotcompose ($;$) {
  my ($self, $fh) = (shift, shift || \*ARGV);
  $self->process_dotcompose($fh, sub ($$@) {
    my($self, $out) = (shift, shift);
    print "@_  $out\n"; # Two spaces to allow for combining marks
  });
}

sub put_val_deep ($$$$@) {
  my($self, $h, $term, $val, $k) = (shift, shift, shift, shift, shift);
#  die "No key(s) in put_val_deep()" unless @_;		# It is OK to have an empty list
  while (@_) {