#!/usr/bin/perl
use strict;
use forks;
use Thread::Queue;
use warnings;
use Encode;
use IO::Select;
use constant BLOCK_SIZE => 1024;
use utf8;

#my $spch :shared;
my $spch_q = Thread::Queue->new;

binmode STDOUT, ':utf8';
STDOUT->autoflush(1);
`stty raw -echo`;
my ($rd, $rr) = (`xset q` =~ /auto repeat delay:\s+(\d+)\s+repeat rate:\s+(\d+)\s*/);
#`xset r rate $rd 1`;
my ($screenHeight, $screenWidth) = split ' ', `stty size`;
print "\e[?45h\e[2J\e[H\e[1;7m" . (' 'x$screenWidth) . "\e[27m\r\n\r\n";
my $loop = IO::Select->new;
STDIN->blocking(0);
$loop->add(\*STDIN);

my $espeak_cmd = '|espeak --pho -q -s 100 -v mb-de7 | mbrola -v 2 /usr/share/mbrola/de7/de7 - -.au | paplay&';
my $exit;
my $keybuf = '';
my $word = '';
my $curcolor = 30;
sub setcolor {
    my ($c, $id) = @_;
    return if $id eq $curcolor;
    speak($c);
    print "\e7\e[H\e[$id;7m" . (' 'x$screenWidth) . "\e[27m\r\n\r\n\e8\e[${id}m";
    $curcolor = $id;
}
my $xpos = 0;
my $ypos = 2;
my $tts_on = 1;
my %funkeys = (
"\eOP"	 => sub { setcolor("schwarz", 30); },
"\eOQ"	 => sub { setcolor("braun", 31); },
"\eOR"	 => sub { setcolor("grün", 32); },
"\eOS"	 => sub { setcolor("orangsch", 33); },
"\e[15~" => sub { setcolor("blau", 34); },
"\e[17~" => sub { setcolor("lila", 35); },
"\e[18~" => sub { setcolor("türkieies", 96); },
"\e[19~" => sub { setcolor("grau", 90); },
"\e[20~" => sub { setcolor("rot", 91); },
"\e[21~" => sub { setcolor("gelb", 93); },
"\e[23~" => sub { setcolor("pink", 95); },
"\e[24~" => sub {},
"\e[A" => sub {
    $word = '';
    --$ypos;
    if ($ypos < 2) {
	print "\e[${screenHeight}d";
	$ypos = $screenHeight - 1;
    }
    else {
	print "\e[A";
    }
},
"\e[D" => sub {
    $word = '';
    --$xpos;
    if ($xpos < 0) {
	$xpos += $screenWidth;
	--$ypos;
    }
    if ($ypos < 2) {
	print "\e[@{[ $screenHeight ]};@{[ $screenWidth ]}H";
	$ypos = $screenHeight - 1;
    }
    else {
	print "\b";
    }
},
"\e[C" => sub {
    $word = '';
    if (1 + $xpos >= $screenWidth) {
	nextline();
    }
    else {
	print "\e[C";
	++$xpos;
    }
},
"\e[B" => sub {
    $word = '';
    ++$ypos;
    if ($ypos >= $screenHeight) {
	$ypos = 2;
	print "\e[3d";
    }
    else {
	print "\e[B";
    }
},
"\cM"    => sub {
    speak(prepword()) if length $word > 1;
    nextline();
    $word = '';
},
" "    => sub {
    speak(prepword()) if length $word > 1;
    printchr(' ');
    $word = '';
},
"\e[5~" => sub{},
"\e[6~" => sub{},
"\e[H"  => sub{},
"\e[F"  => sub{},
"\e[1~" => sub{},
"\e[2~" => sub{},
"\e[3~" => sub {
    unless ($tts_on) {
	$tts_on = 1;
	speak("hallo!");
    }
    else {
	speak("tschüs!");
	$tts_on = 0;
    }
},

);

our $chldopen;

my $funkeys = join '|', map { quotemeta } sort { length $b <=> length $a } keys %funkeys;
my $spkr = async {
    open my($es), $espeak_cmd;
    $es->autoflush(1);
    while (my $item = $spch_q->dequeue) {
	return unless defined $item;
	next if $spch_q->pending;
	$item =~ s/^://;
	print $es $item;
	close $es;
	open $es, $espeak_cmd;
	$es->autoflush(1);
	sleep .2 + .1 * length $item;
    }
};
sub speak {
    my $spch = shift;
    $spch =~ s/emely/ämäly/gi;
    return unless $tts_on;
    $spch_q->enqueue(":$spch");
}

sub nextline {
    $xpos = 0;
    ++$ypos;
    if ($ypos >= $screenHeight) {
	$ypos = 2;
	print "\e[3;1H";
    }
    else {
	print "\r\n";
    }
}

sub printchr {
    my $chr = shift;
    my $width = length $chr;
    if ($width + $xpos > $screenWidth) {
	nextline;
    }
    print $chr;
    $xpos += $width;
}

sub delchr {
    --$xpos;
    if ($xpos < 0) {
	$xpos += $screenWidth;
	--$ypos;
    }
    if ($ypos < 2) {
	#print "\e[@{[ $screenHeight ]};@{[ $screenWidth ]}H\e[X";
	#$ypos = $screenHeight - 1;
	$xpos = 0;
	$ypos = 2;
    }
    else {
	print "\b \b";
    }
}

sub prepword {
    my $tword = $word;
    $tword =~ s/(.)\1\K\1*//gi;
    substr $tword, -20;
}

sub printsl {
    my $pos = "$xpos|$ypos";
    my $tword = prepword();
    my $nword = substr $tword, -($screenWidth - 1 - length $pos);
    print "\e7\e[2;1H\e[37;22m\e[K$nword\e[2;@{[ $screenWidth - length $pos ]}H$pos@{[ $tts_on ? '*' : ' ' ]}\e[1;${curcolor}m\e8";
}

until ($exit) {
    my $pos = "$xpos|$ypos";
    printsl();
    while (my @read = $loop->can_read) {
	if (read STDIN, my $buf, BLOCK_SIZE) {
	    $keybuf .= $buf;
	}
	Encode::_utf8_on($keybuf);
	if ($keybuf =~ s/\cX\cC\cQ$//) {
	    $exit = 1;
	    last;
	}
	elsif ($keybuf =~ s/($funkeys)$//) {
	    $funkeys{$1}->();
	    $keybuf = '';
	}
	elsif ($keybuf =~ s/([[:print:]])$//) {
	    my $chr = $1;
	    $chr = "\L$chr" unless $chr eq 'ß';
	    printchr($chr);
	    $word .= $chr;
	    $chr = 'minus' if $chr eq '-';
	    speak($chr);
	    $keybuf = '';
	}
	elsif ($keybuf =~ s/\177$//) {
	    delchr;
	    chop $word;
	    $keybuf = '';
	}
	Encode::_utf8_off($keybuf);
	printsl();
    }
}
$spch_q->enqueue(undef);
$spkr->join;
print "\e[r\e[?45l";
#`xset r rate $rd $rr`;
`stty sane`;
