#!/usr/bin/perl -w

use strict;
binmode STDOUT, ":utf8";

if(!$ARGV[0]){
    print "Usage: $0 layout|compose\n";
    exit 1;
}

# key to use to end a dead key
my $enddead =  'q'; # 'BKSL';

# key map for the keyboard layout
#  default value is cyrillic, see below
#  other ascii characters have to have a leading "!"
my %keys = ('a' , ['a','A'],
	    'b' , ['be', 'BE'],
	    'v' , ['ve', 'VE'],
	    'g' , ['ghe', 'GHE'],
	    'd' , ['de', 'DE'],
	    'e' , ['ie', 'IE'],
	    'AC10' , ['io', 'IO', '!semicolon', '!colon'],
	    'z' , ['ze', 'ZE'],
	    'i' , ['i', 'I'],
	    'j' , ['shorti','SHORTI'],
	    'k' , ['ka', 'KA'],
	    'l' , ['el', 'EL'],
	    'm' , ['em', 'EM'],
	    'n' , ['en', 'EN'],
	    'o' , ['o','O'],
	    'p' , ['pe', 'PE'],
	    'r' , ['er', 'ER'],
	    's' , ['es', 'ES'],
	    't' , ['te', 'TE'],
	    'u' , ['u', 'U'],
	    'f' , ['ef', 'EF'],
	    'h' , ['ha', 'HA'],
	    'x' , ['ha', 'HA'],
	    'c' , ['tse', 'TSE'],
	    'w' , ['shcha', 'SHCHA'],
	    'y' , ['yeru', 'YERU'],
	    'AC11' , ['softsign', '!quotedbl', '!apostrophe', '!quotedbl'],
        'AE03', ['!3', 'hardsign'],
        # Some extra keys, which we want to work in combination with the dead keys
        'AE01', ['!1', '!exclam'],
        'AE02', ['!2', '!at'],
        'AB08' , ['!comma',	'!less'	],
        'AB09' , ['!period','!greater'],
 	    'AB10' , ['!slash',	'!question'],
        'AE11' , ['!minus',	'!underscore'],
        'AE12' , ['!equal',	'!plus' ],
	    );

# special key combinations (only 2 are possible)
my %special = ( 'jo' , 'io',
		'JO' , 'IO',
		'je' , 'e',
		'JE' , 'E',
		'ju' , 'yu',
		'JU' , 'YU',
		'ja' , 'ya',
		'JA' , 'YA',
		'zh' , 'zhe',
		'ZH' , 'ZHE',
		'ch' , 'che',
		'CH' , 'CHE',
		'sh' , 'sha',
		'SH' , 'SHA'
		);

# for all all ascii keys that are used above we need the character for the compose file
my %asciikeys = ('semicolon', ';',
                 'colon', ':',
                 '1', '1',
                 '2', '2',
                 '3', '3',
                 'at', '@',
                 'exclam', '!',
                 'quotedbl', '\"',
                 'apostrophe', '\'',
                 'comma', ',',
                 'less', '<',
                 'period', '.',
                 'greater', '>',
                 'slash', '/',
                 'question', '?',
                 'minus', '-',
                 'underscore', '_',
                 'equal', '=',
                 'plus','+');

# mapping from the cryrilic short name to the unicode number and the description
my %cyr = ( 'IO', [1025, "IO "],
	    'A', [1040, "A "],
	    'BE', [1041, "BE "],
	    'VE', [1042, "VE "],
	    'GHE', [1043, "GHE "],
	    'DE', [1044, "DE "],
	    'IE', [1045, "IE "],
	    'ZHE', [1046, "ZHE "],
	    'ZE', [1047, "ZE "],
	    'I', [1048, "I "],
	    'SHORTI', [1049, "SHORT I "],
	    'KA', [1050, "KA "],
	    'EL', [1051, "EL "],
	    'EM', [1052, "EM "],
	    'EN', [1053, "EN "],
	    'O', [1054, "O "],
	    'PE', [1055, "PE "],
	    'ER', [1056, "ER "],
	    'ES', [1057, "ES "],
	    'TE', [1058, "TE "],
	    'U', [1059, "U "],
	    'EF', [1060, "EF "],
	    'HA', [1061, "HA "],
	    'TSE', [1062, "TSE "],
	    'CHE', [1063, "CHE "],
	    'SHA', [1064, "SHA "],
	    'SHCHA', [1065, "SHCHA "],
	    'HARDSIGN', [1066, "HARD SIGN "],
	    'YERU', [1067, "YERU "],
	    'SOFTSIGN', [1068, "SOFT SIGN "],
	    'E', [1069, "E "],
	    'YU', [1070, "YU "],
	    'YA', [1071, "YA "],
	    'a' , [1072, "A" ],
	    'be', [1073, "BE"],
	    've', [1074, "VE"],
	    'ghe', [1075, "GHE"],
	    'de', [1076, "DE"],
	    'ie', [1077, "IE"],
	    'zhe', [1078, "ZHE"],
	    'ze', [1079, "ZE"],
	    'i', [1080, "I"],
	    'shorti', [1081, "SHORT I"],
	    'ka', [1082, "KA"],
	    'el', [1083, "EL"],
	    'em', [1084, "EM"],
	    'en', [1085, "EN"],
	    'o', [1086, "O"],
	    'pe', [1087, "PE"],
	    'er', [1088, "ER"],
	    'es', [1089, "ES"],
	    'te', [1090, "TE"],
	    'u', [1091, "U"],
	    'ef', [1092, "EF"],
	    'ha', [1093, "HA"],
	    'tse', [1094, "TSE"],
	    'che', [1095, "CHE"],
	    'sha', [1096, "SHA"],
	    'shcha', [1097, "SHCHA"],
	    'hardsign', [1098, "HARD SIGN"],
	    'yeru', [1099, "YERU"],
	    'softsign', [1100, "SOFT SIGN"],
	    'e', [1101, "E"],
	    'yu', [1102, "YU"],
	    'ya', [1103, "YA"],
	    'io', [1105, "IO"]
	    );
#'DJE', [1026, "DJE "],
#'GJE', [1027, "GJE "],
#'UKRAINIAN IE', [1028, "UKRAINIAN IE "],
#'DZE', [1029, "DZE "],
#'BYELORUSSIAN-UKRAINIAN I', [1030, "BYELORUSSIAN-UKRAINIAN I "],
#'YI', [1031, "YI "],
#'JE', [1032, "JE "],
#'LJE', [1033, "LJE "],
#'NJE', [1034, "NJE "],
#'TSHE', [1035, "TSHE "],
#'KJE', [1036, "KJE "],
#'I WITH GRAVE', [1037, "I WITH GRAVE "],
#'SHORT U', [1038, "SHORT U "],
#'DZHE', [1039, "DZHE "],

# dead keys we use for the combined characters. 
# must be 4 digit unicode number i.e. 0x100XXXX
#  we use here an unused block of Unicode
my @deadkey = ('1D80','1D81','1D82','1D83','1D84','1D85','1D86','1D87','1D88','1D89',
    	       '1D8A','1D8B','1D8C','1D8D','1D8E','1D8F');

my %deadkeymap = ();
my $i=0;
foreach my $k (keys %special) {    
    if(! exists $deadkeymap{substr($k,0,1)}){
	$deadkeymap{substr($k,0,1)} = $deadkey[$i];
	$i++;
    }
}
#printarrayhash(\%cyr);
#printhash(\%deadkeymap);


# print entry for layout file 
if(lc $ARGV[0] eq 'layout'){
    foreach my $k (keys %keys){
	my @ks = @{ $keys{$k} };
	if(length($k)==1){	
	    if(exists $deadkeymap{$k}){ # use dead key instead of real key	    
		$ks[0] = '!' . dead4layout($deadkeymap{$k});
	    }
	    if(exists $deadkeymap{uc $k}){
		$ks[1] = '!' . dead4layout($deadkeymap{uc $k});
	    }
	    print "\t key \t<Lat" . (uc $k) . '> {	[ ' . getKeyName($ks[0]);
	    print ', ' . getKeyName($ks[1]);
	}else{
	    print "\t key \t<" . $k . '> {	[ ' . getKeyName($ks[0]);
	    print ', ' . getKeyName($ks[1]);
	}
	print ', ' . getKeyName($ks[2]) if(exists $ks[2]);
	print ', ' . getKeyName($ks[3]) if(exists $ks[3]);
	print " ]\t };\n"	
    }
    exit 0;
}

#create compose entries
# create all compose entries to allow combinations with deadkeys and all other
#  keys to work
foreach my $d (keys %deadkeymap) {
    my $dead = $deadkeymap{$d};
    # get normal character
    my $ckey;           # what russian key is this (lower and upper case!)
    my $sc;
    if(lc $d eq $d){
	$ckey= $keys{lc $d}[0]; # lower case
        $sc = "SMALL";
    }else{
	$ckey= $keys{lc $d}[1]; # upper case
        $sc = "CAPITAL";
    }   
    my @cy = @{ $cyr{$ckey} };  # normal value of this dead key    
    print "# Combinations for " . $d . "\n";
    # first space
    printcompose2(dead4compose($dead), 'space', $cy[0], 32 ,$sc ,"" , $cy[1], "space");
    # if we press deadkey and enddead then just the original letter
    printcompose( dead4compose($dead), $enddead, $cy[0], $sc, $cy[1]);
    # combinations with other keys (this is a lot ;-)
    foreach my $k (keys %keys) {
	my @secondkey = @{ $keys{$k} };
	if($k eq lc $d){ # if we press deadkey twice nothing happens ( would not work)
	}else{
	    foreach my $rkey (@secondkey){
	    	if(!(substr($rkey,0,1) eq '!')){
			die 'unknown CYR "' . $rkey . '"' if(!exists $cyr{$rkey}); 
			my @secondcyr = @{ $cyr{$rkey} };	    
			printcompose2( dead4compose($dead), 'Cyrillic_'. $rkey, $cy[0], $secondcyr[0], 
				       $sc, "", $cy[1], $secondcyr[1]);	
	    	}else{
			printcompose2a( dead4compose($dead), getKeyName($rkey), $cy[0], getAsciiKey(getKeyName($rkey)),
				       $sc, $cy[1], getKeyName($rkey));	
		}
	    }
	}

    }
}

# create real deadkey combinations
print "# special dead key combinations\n";
foreach my $k (keys %special) {
    my $dead = $deadkeymap{substr($k,0,1)}; # dead key 
    my $second = substr($k,1);            # following letter
    my $ckey;           # what russian key is this (lower and upper case!)
    my $sc;
    if(lc $second eq $second){
	$ckey= $keys{lc $second}[0]; # lower case
	$sc    = "SMALL";
    }else{
	$ckey= $keys{lc $second}[1]; # upper case
	$sc    = "CAPITAL";
    }    
    my @cy    = @{ $cyr{$special{$k}} };       # result in cyrillic  
    printcompose( dead4compose($dead) , 'Cyrillic_'. $ckey, $cy[0], $sc, $cy[1]); 
}


sub dead4compose {  
    return 'U' . shift;
}
sub dead4layout {  
    return '0x100' . shift;
}

sub printcompose {
    my $dead = shift;
    my $key = shift;
    my $uni = shift;
    my $sc  = shift;
    my $name = shift;
    print '<' . $dead . '> <'. $key .'> : "' . chr($uni);
    print('" U' . $uni . ' # CYRILLIC '. $sc .' LETTER ' . $name . "\n");
}

sub printcompose2 {
    my $dead = shift;
    my $key = shift;
    my $uni1 = shift;
    my $uni2 = shift;
    my $sc1  = shift;
    my $sc2  = shift;
    my $name1 = shift;
    my $name2 = shift;
    print '<' . $dead . '> <'. $key .'> : "' . chr($uni1) . chr($uni2);
    print('" U' . $uni1 . ' # CYRILLIC '. $sc1 .' LETTER ' . $name1 );
    print(' and '. $sc2 . ' ' . $name2 . "\n");
}

sub printcompose2a {
    my $dead = shift;
    my $key = shift;
    my $uni1 = shift;
    my $ascii = shift;
    my $sc1  = shift;
    my $name1 = shift;
    my $name2 = shift;
    print '<' . $dead . '> <'. $key .'> : "' . chr($uni1) . $ascii;
    print('" U' . $uni1 . ' # CYRILLIC '. $sc1 .' LETTER ' . $name1 );
    print(' and ' . $name2 . "\n");
}


sub getAsciiKey {
   my $n = shift;
   if(exists($asciikeys{$n})) {
    return $asciikeys{$n};
   }
   die "ascii key $n not in map";
}

sub getKeyName {
    my $name = shift;
    if(substr($name,0,1) eq '!'){
	return substr($name,1);
    }else{
	return 'Cyrillic_' . $name;
    }
}

################### UTILITY ######################################
sub printhash {
    my $ha = shift;
    my %hash = %{ $ha };
    foreach my $h (keys %hash){
	print $h . " " . $hash{$h} . "\n";
    }
}
sub printarrayhash {
    my $ha = shift;
    my %hash = %{ $ha };
    foreach my $h (keys %hash){
	print $h . " ";
	printarray($hash{$h});
    }
}

sub printarray {
    my $ha = shift;
    my @array = @{ $ha };
    print '[';
    foreach my $h (@array){
	print $h . ",";
    }
    print "]\n";
}