use strict; use warnings;
use 5.010;

use List::Util qw(reduce min);
use Storable qw(dclone);

my @protmap;
my @lines;
my (@hdr, @ftr);


sub red { my @copy=@_; for (@copy) { s/([CH])/\033[01;31m$1\033[m/g } @copy }
sub process {
	say "x,$ARGV";
	my @maxmap = map { (sort { $_->{$b} <=> $_->{$a} } keys %$_)[0] } @protmap;

	say red @maxmap;
	#say red map { /[CH-]/ ? $_ : '.' } @maxmap;

	my @al=('a'..'z','A'..'Z',0..9,qw(! @ # $ % ^ & * ( ) - _ = + [ { ] } \ | ; : ' " , < . > / ? ` ~ á ² ³ ¹ °));
	my (@goal, @numcodes);
	#say '^', (join '', grep /[CH]/, @maxmap), '$';
	if ('CCHH' eq join '', grep /[CH]/, @maxmap) {
		(@goal) = grep { $maxmap[$_] =~ /[CH]/ } 0..$#maxmap;
	}
	else {
		my $i=-1;
		my @maxmap2 = map { (sort { $_->{$b} <=> $_->{$a} } keys %$_)[1]||' ' } @protmap;
		say red @maxmap2;
		#say red map { /[CH-]/ ? $_ : '.' } @maxmap2;
		say map { (grep{/[CH]/}$maxmap[$_],$maxmap2[$_])?@al>$_?$al[$_]:'¯':' ' } 0..$#protmap;
		$i=0;
		map {
			my $l=$_;
			my @keys=sort { $_->{$b} <=> $_->{$a} } keys %$_;
			say join "\t", ((grep{/[CH]/}@keys[0..min($#keys,5)])?@al>$i?$al[$i]:$i:''), red (map { $_ . ':' . $l->{$_} } @keys[0..min($#keys,5)]), (($#keys-5)>0?'...'. ($#keys-5):());
			++$i;
		} @protmap;
		print 'not uniq, ur suggestion? ';
		do {
			print 'nack! ' if @goal;
			$_=<STDIN>; return unless defined; chomp;
			@numcodes=(); ($_, @numcodes) = split;
			@goal = sort { $a <=> $b } ((map { my $l=$_; grep { $l eq $al[$_] } 0..$#al } split ''), @numcodes);
			$i=0; say map { @goal > $i && $goal[$i] eq $_ ? (scalar( ++$i,'v' )) : ' ' } 0..$#protmap;
			say red @maxmap;
			say red @maxmap2;
			say map { (grep{/[CH]/}$maxmap[$_],$maxmap2[$_])?@al>$_?$al[$_]:'¯':' ' } 0..$#protmap;
		} until (@goal && exists $protmap[$goal[0]]{C} && exists $protmap[$goal[1]]{C}
				 && exists $protmap[$goal[2]]{H} && exists $protmap[$goal[3]]{H});
		
		#return;
	}
	
	open my $Yc2h2, '>', do { my @p=split /[.]/, $ARGV; splice @p, -1, 0, 'Yc2h2', (join '-', (join '', @al[@goal]), @numcodes); join '.', @p };
	open my $Nc2h2, '>', do { my @p=split /[.]/, $ARGV; splice @p, -1, 0, 'Nc2h2', (join '-', (join '', @al[@goal]), @numcodes); join '.', @p };
	
	say $Yc2h2 $_ for @hdr;
	say $Nc2h2 $_ for @hdr;

	for (@lines) {
		if (grep { !defined } @{$_->[-1]}[@goal]) {
			use Data::Dumper; print Dumper $_;
		}
		if ('CCHH' eq join '', @{$_->[-1]}[@goal]) {
			say $Yc2h2 $_->[0];
		}
		else {
			say $Nc2h2 $_->[0];
		}
	}

	say $Yc2h2 $_ for @ftr;
	say $Nc2h2 $_ for @ftr;

}

my $join_mode=0;
my $join_line=0;
while (<>) {
	chomp;
	if ($. <= 3) {
		push @hdr, $_;
		next;
	}
	my ($id, $prot) = split ' ';
	unless ($prot && $prot ne '*') {
		push @ftr, $_;
		say "^$_\$ $join_mode";
		++$join_mode if ((($join_mode % 2) && $_ eq '') || (!($join_mode % 2) && /^[*\s]+$/));
		$join_line = 0 unless $join_mode % 2;
		next;
	}
	my @seq = split '', $prot;
	if ($join_mode > 1 && !($join_mode % 2)) {
		unless ($join_line) {
			pop @ftr for 1..2;
		}
		$lines[$join_line][0] .= $_;
		++$protmap[$_+@{$lines[$join_line][-1]}]{$seq[$_]} for 0..$#seq;
		push @{$lines[$join_line][-1]}, @seq;
		++$join_line;
	}
	else {
		++$protmap[$_]{$seq[$_]} for 0..$#seq;
		push @lines, [$_, \@seq];
	}
}
continue {
	if (eof) {
		#use Data::Dumper; print Dumper \(@lines, @protmap, @hdr, @ftr);
		process;
		@protmap=(); @lines=();
		@hdr=(); @ftr=();
		$join_mode=0; $join_line=0;
		close ARGV;
	}
}
