#!/usr/local/bin/perl  -w
#
# vim:set ts=4 sw=4:
#
# (c) by Stefan `Sec` Zehl <sec@42.org> 2009
#
# code is under the 2-clause BSD licence, 

use strict;
use Data::Dumper;
use Curses;
use constant c_off => 2;
use constant p_off => 5;
use constant t_off => 8;
use constant t_yoff => 25;
use constant WIDTH => 80;

our ($crypt,%mmap,@haeuf);
our $sort=0;

my @alpha=(qw(a b c d e f g h i j k l m n o p q r s t u v w x y z));

@mmap{@alpha}=("_")x26;

my $cachename=$ARGV[0].".cache";

do {
	local $/=undef;
	$crypt=<>;
};

loadcache();
my @langs=(undef);
gethaeuf();

initscr;
our $w_=subwin(2,WIDTH,0,0);
our $wc=subwin(3,WIDTH,c_off,0);
our $wp=subwin(3,WIDTH,p_off,0);
our $w1=subwin(26,t_yoff,t_off,0);
our $w2=subwin(26,WIDTH-(t_yoff),t_off,t_yoff);
noecho;

$w_->addstr(0,0,"Cryptobench 0.2 by <sec\@42.org>");
$w_->addstr(1,0,"---------------");
$w_->refresh;

$wc->addstr(0,0,$crypt);

my @pos=(0,0);
my @oldpos;
my $c=""; # Input character
my $lang=0; # Current language no.

my $tabledirty=1; # Repaint table?
help();

while($c ne "q"){
	$wp->addstr(0,0,decrypt($crypt));
	$wp->refresh;
	if($tabledirty){
		printtable($haeuf[$lang]);
		$tabledirty=0;
	};
	standout;
	addstr($pos[0]+p_off,$pos[1],getchr(1));
	standend;
	move($pos[0]+c_off,$pos[1]);
	#refresh;

	$c=getch;

	if($c eq ""){ refresh;};

	if($c eq ""){ $c=getch; }; # For cursor keys
	if($c eq "[") { $c=getch; }; # For cursor keys

	@oldpos=@pos;
	MOVE: {
		if($c eq "A"){ $pos[0]-- };
		if($c eq "B"){ $pos[0]++ };
		if($c eq "C"){ $pos[1]++ };
		if($c eq "D"){ $pos[1]-- };

		if($c eq "k"){ $pos[0]-- };
		if($c eq "j"){ $pos[0]++ };
		if($c eq "l"){ $pos[1]++ };
		if($c eq "h"){ $pos[1]-- };

		do {@pos=@oldpos;last MOVE} if ! defined getchr();
		redo MOVE if getchr() !~ /[a-zA-Z]/;
	};

	if($c eq "r"){ my $cc=getchr();$mmap{lc $cc}=lc getch; $tabledirty++;};
	if($c eq "w"){ my $cc=getword();search($cc)};
	if($c eq "s"){ $sort++;$sort=0 if $sort >2;$tabledirty++;};
	if($c eq "L"){ $lang++;$lang=0 if(!defined$langs[$lang]);
	    addstr(t_off-1,0,"[".$langs[$lang]."]     ");
	    $tabledirty++};
	if($c eq "H" ||
	   $c eq "?"){ help();};

};

endwin;
savecache();

sub decrypt{
	return join("", map { mapchr($_) } split(//,shift));
};

sub mapchr{
	my $x=shift;
	if($x eq lc $x){
		return $mmap{$x} if($mmap{$x});
		return $x;
	};
	return uc $mmap{lc $x};
};

sub printtable{
    	my $fq=shift;
	my $x=0;

	# -- count
	my @x=split(//,$crypt);
	my %cnt;
	@cnt{@alpha}=(0)x scalar @alpha;
	for(@x){
		$cnt{lc $_}++;
	};
	# -- endcount

	$w1->clear;
	my @alpha_sort=@alpha;
	if($sort==0){
		@alpha_sort=sort {$cnt{$b} <=> $cnt{$a}} @alpha;
	}elsif($sort==2){
		@alpha_sort=sort {$mmap{$a} cmp $mmap{$b}} @alpha;
	};
	my %hh;
	for my $a (@alpha_sort){
		$hh{$mmap{$a}}=$a if($mmap{$a} ne "_");
		next unless $cnt{$a};
		$w1->addstr($x++,0,"$a: $mmap{$a} (".sprintf("%2s",$cnt{$a}).") ");
		$b++;
	};

	$x=0;my $y=0; my $z=0;
	if($sort==0){
		for my $a (sort {$fq->{$b} <=> $fq->{$a}} keys %{$fq}) {
#				addstr(t_off+$z++,40,"$x/$y -> $a: $alpha_sort[$x] $mmap{$alpha_sort[$x]} (ex: $hh{$a})");
			if (!defined($mmap{$alpha_sort[$x]})){
					warn "Error in mapping!\n";
					last;
			};
			if($mmap{$alpha_sort[$x]} ne "_"){
				$w1->addstr($y++,10,"<".sprintf("%2.1f",$fq->{$mmap{$alpha_sort[$x]}}).">");
				$x++;
				redo;
			};
			if(defined $hh{$a}){
				next;
			};

			$w1->addstr($y++,10,"[$a: ".sprintf("%2.1f",$fq->{$a})."]");
			$x++;
		};
	};
	$w1->refresh;
};

sub search {
	my $w=shift;
	$w2->clear;
	$w2->addstr(0,0,$w);
	my @r=split(//,$w);
	$w=decrypt($w);
	my %r=();my $z=0;
	for(@r){
		if($r{$_}){
			$_=$r{$_};
		}else{
			$r{$_}=$z;
			$_=$z;
		};
		$z++;
	};
	$w2->addstr(1,0,join("",@r));
	my $excl="";
	for (@alpha){
		$excl.= $mmap{$_} if ($mmap{$_} ne "_");
	};
	$w=~s/_/[^${excl}]/g;
	$w2->addstr(2,0,"$w");
	my $x=3;
	my $filename="dict.".$langs[$lang];
	if (! -f $filename){
	    $w2->addstr($x++,0,"<missing file $filename, sorry.>");
	    $filename="/usr/share/dict/words";
	    if( -f $filename && $lang==0){
		$w2->addstr($x++,0,"<using $filename instead.>");
	    }else{
		return;
	    };
	};
	open(W,"<",$filename);
	my (%da,$out,@n);
	while(<W>){
		chomp;
		if($_ =~ /^${w}$/){
			@n=split(//,$_);
			%da=();$out="";
			for(0..$#n){
			  if($r[$_] != $_){
				  if($n[$_] ne $n[$r[$_]]){
					  $out.="($_: needdup)";
				  };
				  $da{$n[$_]}++;
			  }else{
				  if($da{$n[$_]}){
					  $out.="($_: needuniq)";
				  };
			  };
			};
			$w2->addstr($x++,0,"$_  $out ") unless ($out);
		};
		$w2->refresh;
	};
	$w2->addstr(t_off+$x++,t_yoff,"---");
	close(W);
};

sub getchr{
	return undef if ($pos[0]<0 || $pos[1]<0);
	my $ct=$crypt;
	$ct=decrypt($ct)if(shift);
    my $line=$pos[0];
	while($line-->0){
		$ct=~ s/^.*?\n//;
	};
	$ct=~/^.{$pos[1]}(.)/;
	return $1;
};

sub getword{
	my $ct=$crypt;
    my $line=$pos[0];
	while($line-->0){
		$ct=~ s/^.*?\n//;
	};
	$ct=~/^.{$pos[1]}([a-zA-Z]+)/;
	return $1;
};

sub loadcache{
	if (-f $cachename){
		my $x;
		open(F,"<",${cachename});
		for(@alpha){
			$x=<F>;chomp $x;
			$mmap{$_}=$x;
		};
		close(F);
	};
};

sub savecache{
	open(F,">",${cachename});
	for (@alpha){
		print F "$mmap{$_}\n";
	};
	close(F);
};

sub gethaeuf{
	my($l,$p);
	my(@freq);
	my $t=<DATA>;
	chomp($t);
	(undef,@langs)=split(/\t/,$t);
	while(<DATA>){
	    	chomp;
		($l,@freq)=split(/\t/,$_);
		warn if ($l !~ /[a-zA-Z]/);

		my $letters=()=($crypt =~ /[a-zA-Z]/g);

		for my $i (0..$#langs){
		    $haeuf[$i]{lc $l}=$freq[$i] *$letters/100;
		};
	};
	close(DATA);
};

sub help{
    	my $x=0;
	$w2->clear;
	$w2->addstr($x++,0,"Quick Help:");
	$w2->addstr($x++,0,"");
	$w2->addstr($x++,0,"hjkl to move");
	$w2->addstr($x++,0,"r <letter> to substutute");
	$w2->addstr($x++,0,"s to change sorting letter table");
	$w2->addstr($x++,0,"L to change language for frequency table");
	$w2->addstr($x++,0,"w to grep in dictionary for current word");
	$w2->addstr($x++,0,"  (crsr must be at the start of the word)");
	$w2->addstr($x++,0,"");
	$w2->refresh;
}

__DATA__
Letter 	English	French	German	Spanish	E7o	Italian	Turkish	Swedish
a	8.167 	7.636 	6.51 	12.53 	12.12 	11.74 	11.68 	9.3
b	1.492 	0.901 	1.89 	1.42 	0.98 	0.92 	2.95 	1.3
c	2.782 	3.260 	3.06 	4.68 	0.78 	4.5 	0.97 	1.3
d	4.253 	3.669 	5.08 	5.86 	3.04 	3.73 	4.87 	4.5
e	12.702 	14.715 	17.40 	13.68 	8.99 	11.79 	9.01 	9.9
f	2.228 	1.066 	1.66 	0.69 	1.03 	0.95 	0.44 	2.0
g	2.015 	0.866 	3.01 	1.01 	1.17 	1.64 	1.34 	3.3
h	6.094 	0.737 	4.76 	0.70 	0.38 	1.54 	1.14 	2.1
i	6.966 	7.529 	7.55 	6.25 	10.01 	11.28 	8.27 	5.1
j	0.153 	0.545 	0.27 	0.44 	3.50 	0.00 	0.01 	0.7
k	0.772 	0.049 	1.21 	0.00 	4.16 	0.00 	4.71 	3.2
l	4.025 	5.456 	3.44 	4.97 	6.14 	6.51 	5.75 	5.2
m	2.406 	2.968 	2.53 	3.15 	2.99 	2.51 	3.74 	3.5
n	6.749 	7.095 	9.78 	6.71 	7.96 	6.88 	7.23 	8.8
o	7.507 	5.378 	2.51 	8.68 	8.78 	9.83 	2.45 	4.1
p	1.929 	3.021 	0.79 	2.51 	2.74 	3.05 	0.79 	1.7
q	0.095 	1.362 	0.02 	0.88 	0.00 	0.51 	0 	0.007
r	5.987 	6.553 	7.00 	6.87 	5.91 	6.37 	6.95 	8.3
s	6.327 	7.948 	7.27 	7.98 	6.09 	4.98 	2.95 	6.3
t	9.056 	7.244 	6.15 	4.63 	5.27 	5.62 	3.09 	8.7
u	2.758 	6.311 	4.35 	3.93 	3.18 	3.01 	3.43 	1.8
v	0.978 	1.628 	0.67 	0.90 	1.90 	2.10 	0.98 	2.4
w	2.360 	0.114 	1.89 	0.02 	0.00 	0.00 	0 	0.03
x	0.150 	0.387 	0.03 	0.22 	0.00 	0.00 	0 	0.1
y	1.974 	0.308 	0.04 	0.90 	0.00 	0.00 	3.37 	0.6
z	0.074 	0.136 	1.13 	0.52 	0.50 	0.49 	1.50 	0.02