package Calc;

use strict;
use vars qw'$british $answ';
use Roman;

my $parens = qr{
    \(
        (?:
            (?> [^()]+ )    # Non-parens without backtracking
        |
            (??{ $parens })     # Group with matching parens
        )*
    \)
}x;

my %bin2hex = qw(0000 0 0001 1 0010 2 0011 3
                 0100 4 0101 5 0110 6 0111 7
                 1000 8 1001 9 1010 A 1011 B
                 1100 C 1101 D 1110 E 1111 F);
my %hex2bin = reverse %bin2hex;

my %parts = qw(nul 0 een 1 eer 1 twee 2 twin 2 drie 3 der 3 vier 4
               veer 4 vijf 5 zes 6 zeven 7 acht 8 tach 8 negen 9
               tien +10 elf 11 twaalf 12 dozijn *12 tig *10
               honderd *100 gros *144 duizend *1e3 miljoen *1e6
               miljard *1e9 biljoen *1e12 biljard *1e15 triljoen *1e18
               triljard *1e21 quadriljoen *1e24 quadriljard *1e27
               quantiljoen *1e30 quantiljard *1e33 sexiljoen *1e36
               sexiljard *1e39 septiljoen *1e42 septiljard *1e45
               octiljoen *1e48 octiljard *1e51 noniljoen *1e54
               noniljard *1e57 deciljoen *1e60 deciljard *1e63
               undeciljoen *1e66 undeciljard *1e69 dodeciljoen *1e72
               dodeciljard *1e75 quindeciljoen *1e90
               quindeciljard *1e93 isosiljoen *1e120 isosiljard *1e123

               zero 0 ough 0 one 1 (?:fir)st 1 two 2 twen 2
               (?:seco)nd 2 three 3 third? 3 fou?r 4 five 5 fif 5
               six 6 seven 7 eight? 8 nine? 9 ten 10 teen +10
               eleven 11 twelve 12 t?y *10b dozens? *12b hundred *100b
               hunderd *100b thousand *1e3b million *1e6b
               milliard *1e9b billion *1e12B billiard *1e15b
               trillion *1e18B quandrillion *1e24B quintillion *1e30
               sextillion *1e36B septillion *1e42B octillion *1e48B
               nonillion *1e54B decillion *1e60B undecillion *1e66B
               duodecillion *1e72B tredecillion *1e78B
               quattuordecillion *1e82B quindecillion *1e88B
               sexdecillion *1e94B septendecillion *1e100B
               octodecillion *1e106B novemdecillion *1e112B
               vigintillion *1e118B centillion *1e600B google *1e100b
               googol *1e100b zillion *42b);

my (%triNL, %triUK);
{
    no warnings; # puhleaase :)
    my %revgetal = reverse %parts;
    %triNL =
        (0 =>
            '' =>
                map { $_ => $revgetal{"*1e$_"} }
                    grep { s/^\*1e//g and not /\D/ and $_ <= 22 }
                        my @dummy = values %parts
                            );
    %triUK =
        (0 =>
            '' =>
                map { (my $foo) = /(\d+)/; $foo => $revgetal{"*1e$_"} 
+}
                    grep { s/^\*1e//g and /[bB]/ and $_ <= 22 }
                        @dummy = values %parts
                            );
    $triNL{''} = '';
    $triUK{''} = '';
}

sub bin2hex($){
    my ($bin) = @_;
    $bin =~ tr/01//cd;
    $bin = '0' x (4 - length($bin)%4) . $bin;
    $bin =~ s/^(?:0000)+//g;
    $bin =~ s/([01]{4})/$bin2hex{$1}/g;
    return $bin;
}
sub fac($){
    die "I refuse to do so\n" if $_[0] > 1000;
    die "Erhm?\n" if $_[0] < 0;
    my $ret = 1;
    $ret *= $_ for 2..$_[0];
    return $ret;
}
sub som(@){
    my $ret;
    $ret += $_ for @_;
    return $ret;
}
sub merge(@){
    my $vgl = pop @_;
    my @l = @_;
    FOO: {
        BAR: for (0..$#l){
            last BAR if not defined $l[$_+1];
            if (($l[$_] + $l[$_+1]) < $vgl and length($l[$_]) != lengt
+h($l[$_+1])){
                $l[$_] += splice @l, ($_+1), 1;
                redo FOO;
            }
        }
    }
    return @l;
}

sub text2number($){
    (my $getal = $_[0]) =~ tr/A-Z/a-z/;
    my $ogetal = $getal;
    $getal =~ tr/a-z0-9 -//cd;
    $getal =~ tr/a-z0-9//cd;
    $getal =~ s/(?:d|st)e$//;
    my $nullen = 0;
    $nullen++ while $getal =~ s/^\s*(?:null?|zero|ough|oh?\b)\s*//;
    $getal =~ tr/a-z0-9//cd;
    my @teller;
    my $ster;
    my $nuster;
    my $vorigester;
    my $vorigevalue;
    my $olen = length ($getal);
    my $nlen = 0;
    ZOEK: {
        my $abort = 1;
        last ZOEK if $getal !~ /[a-z0-9]/;
        $getal =~ s/^(?:en|and)//;
        $nlen += length($1);
        if ($getal =~ s/^(\d+)//){
            push @teller, $1;
            $nlen += length($1);
        }
        for (keys %parts){
            if ($getal =~ /^($_)/){
                $nlen += length($1);
                $getal =~ s///;
                $abort = 0;
                my ($pre, $value) = $parts{$_} =~ /([+*]?)(.*)/;
                $british = 1 if $value =~ s/B//;
                $value =~ s/b//;
                $value =~ s/(\d+e\d+)/$1/ee;
                @teller = (som(@teller)) if $vorigester and (sort @tel
+ler == @teller); #nuster and $value < $vorigevalue;
                $vorigester = 0;
                $vorigevalue = $value;
                if ($pre eq '*'){
                    if (@teller){
                        @teller = merge(@teller, $value);
                        eval {
                                $teller[$#teller] *= $value;
                        };
                        $vorigester = 1;
                    }else{
                        @teller = ($value);
                    }
                }elsif ($pre eq '+'){
                    $ster = 0;
                    if (@teller){
                        $teller[$#teller] += $value;
                    }else{
                        @teller = ($value);
                    }
                }else{
                    $ster = 0;
                    push @teller, $value;
                }
            }
        }
        redo ZOEK unless $abort;
    }
    if ($nlen > 9){
        return @teller ? som(@teller) : '';
    }elsif ($nlen > length($getal)){
        return ('0'x$nullen) . (@teller ? som(@teller) : '') # . $geta
+l;
    }else{
        return $ogetal;
    }
}

sub number2text_nl($);
sub number2text_nl($){
    my $tri = 0;
    my $getal = $_[0];
    my $trug = '';
    my %cijf = (0 => '',
      qw(1 een 2 twee 3 drie 4 vier 5 vijf 6 zes 7 zeven 8 acht 9 nege
+n));

    my %tig = (0 => '',
      qw(1 EEN 2 twin 3 der 4 veer 5 vijf 6 zes 7 zeven 8 tach 9 negen
+));

    my %tien = qw(een elf twee twaalf drie dertien vier veertien);
    return "heleboel" if $getal > 1e15; #eigenlijk 22
    $getal = sprintf("%f", $getal);
    $getal =~ s/\.0*$//;
    my $nullen;
    if (my ($een, $twee) = $getal =~ /^(\d*)\.(\d*)$/){
        $twee =~ s/0+$//;
        $nullen++ while $twee =~ s/^0//;
        return number2text_nl($een) . ' komma ' . ('nul ' x $nullen) .
+ number2text_nl($twee);
    }
    $getal = reverse $getal;
    for ($getal =~ /(\d{1,3})/g){
        /(\d)(\d?)(\d?)/;
        my $rev = '';
        if ($3){
            $rev .= $cijf{$3}       if $3 > 1;
            $rev .= 'honderd'       if $3;
            $rev .= 'en'            if $1 xor $2; # (!!$1 <=> !!$2 is 
+mooier :)
        }
        $rev .=  $cijf{$1}          if $1;
        $rev .= "en"                if $1 and $2;
        $rev .= "$tig{$2}tig"       if $2;
        $rev .= $triNL{$tri}          if $_ + 0;
        $tri += length;
        $trug = "$rev$trug";
    }
    if ($trug){
        for (keys %tien){
            $trug =~ s/${_}enEENtig/$tien{$_}/g;
        }
        $trug =~ s/(?:en)?EENtig/tien/g;
    }else{
        $trug = 'nul';
    }
    $trug = "min $trug" if $getal =~ /-/;
    return $trug;
}

sub number2text_uk($);
sub number2text_uk($){
    my $tri = 0;
    my $getal = $_[0];
    my $trug = '';
    my %cijf = (0 => '',
      qw(1 one 2 two 3 three 4 four 5 five 6 six 7 seven 8 eight 9 nin
+e));

    my %tig = (0 => '',
      qw(1 ONE 2 twen 3 thir 4 for 5 fif 6 six 7 seven 8 eigh 9 nine))
+;

    my %tien = qw(one eleven two twelve three thirteen four fourteen f
+ive fifteen);
    return "lots" if $getal > 1e15; #eigenlijk 22
    $getal = sprintf("%f", $getal);
    $getal =~ s/\.0*$//;
    my $nullen;
    if (my ($een, $twee) = $getal =~ /^(\d*)\.(\d*)$/){
        $twee =~ s/0+$//;
        $nullen++ while $twee =~ s/^0//;
        return number2text_uk($een) . ' point ' . ('ough ' x $nullen) 
+. number2text_uk($twee);
    }
    $getal = reverse $getal;
    for ($getal =~ /(\d{1,3})/g){
        /(\d)(\d?)(\d?)/;
        my $rev = '';
        if ($3){
            $rev .= $cijf{$3}       if $3 > 1;
            $rev .= 'hundred'       if $3;
            $rev .= 'and'            if $1 or $2;
        }
        $rev .= "$tig{$2}ty"        if $2;
        $rev .= $cijf{$1}           if $1;
        $rev .= $triUK{$tri}          if $_ + 0;
        $tri += length;
        $trug = "$rev$trug";
    }
    if ($trug){
        for (keys %tien){
            $trug =~ s/ONEty${_}/$tien{$_}/g;
        }
        $trug =~ s/ONEty/ten/g;
    }else{
        $trug = 'zero';
    }
    $trug = "minus $trug" if $getal =~ /-/;
    return $trug;
}
sub ip($){
    my $r = 0;
    my $i = 0;
    for (reverse split //, $_[0]){
        $r += 256**($i++) * ord;
    }
    return $r;
}
sub calc{
    my @func = qw(abs atan2 cos log sin sqrt tan asin acos atan pi int
+ rand ip fac xor);
    my ($gulden, $euro) = (qr/guldens?|NLG|[HDN]?FL|piek/i,
                           qr/euro\'?s?|EUR/i);
    my $g2e = qr/(?:van )?(?<!naar )$gulden(?: naar $euro)?/i;
    my $e2g = qr/(?:van )?(?<!naar )$euro(?: naar $gulden)?/i;
    my $a = join ' ', @_;
    my $output = (
        $a =~ /-o:(?:nl|ned)/ ? 'nl'
      : $a =~ /-o:(?:uk|eng?)/ ? 'uk'
      : $a =~ /-o:rom/ ? 'rom'
      : $a =~ /-o:(?:he)?x/ ? 'hex'
      : $a =~ /-o:b(?:in)?/ ? 'bin'
      : $a =~ /-o:oct/ ? 'oct'
      : ''
    );
    $a =~ s/-o:\S*//g;
    $a =~ s/\s+/ /;
    if ($a =~ /\xB1/){
            return "Forget it"
    }
    $a =~ s/#.*//;
    my %func;
    my $func;
    for (@func){
        $func{$_} = ++$func;
    }
    my %exp = qw(   M   10^6    k       1_000   g       10^9
                    T   10^12   MB      2^20    kB      2^10
                    gB  2^30    TB      2^40    m       0.001
                    mb  10^6    K       2^10    KB      2^10
                    kb  2^10    GB      2^30    gb      2^30
                    tb  2^40    Mb      1_000   kb      1_000
                    PB  2^50);
    my %words = (qw(
                e       2.718281828
                (?:gedeeld|delen)\s*door        /       hex     0x
                (?:procent|%)\s*van             /100*

                plus    +       and     &&      keer    *
                o[rf]   ||      en      &&      maal    *
                [kc]omma        .               times   *
                not     !       is      =       bin     b
                niet    !       equals? =       oct     0
                lt      <       eq      =       punt    . point .
                gt      >       kwadraat        ^2
                sqr     sqrt    graad   *(pi/180) graden  *(pi/180)
                                degrees? *(pi/180)

                min(?:us)?      -       mod(?:ul(?:o|us))?      %
                less\s*than     <       kleiner\s*dan           <
                greater\s*than  >       groter\*dan             >
                gelijk\*aan     =       divide(?:d\s*by)?       /
                tot(?:\s*de)?                           ^
                (?:to\s*the\s*)?pow(?:er)?(?:\s*of)     ^
                (?:de\s*)?(?:\s*vierkants)?wortel(?:\s*van)?          
+  sqrt
                (?:the\s*)?(?:square\s*)?root(?:\s*of)? sqrt
                (?:de\s*)?sin(?:us)?(?:\s*van)?         sin
                (?:de\s*)?tang?(?:[ue]s)?(?:\s*van)?    tan
                (?:de\s*)?cosin(?:us)?(?:\s*van)?       cos
                true    1       heleboel        ~0
                false   0       lots            ~0
            ),
                $g2e => '/2.20371', $e2g => '*2.20371',
    );
    my %chars = qw(<B9> ^1 <B2> ^2 <B3> ^3 <AB> << <BB> >>);
    for (keys %chars){
        $a =~ s/$_/$chars{$_}/g;
    }
    $a =~ s/(?:d|st)?e\s+macht//gi;
    for (keys %words){
        $a =~ s/(?<![A-Za-z0-9_-])$_(?![A-Za-z_-])/$words{$_}/g;
    }
    for (keys %func){
        $a =~ s/(?<![A-Za-z0-9_])$_(?![A-Za-z_])/*%*%$func{$_}%*%/g;
    }
    $a =~ tr|,÷:·[]{}ë|.//*()()e|;
    $a =~ s/\b([IVXLCDM]+)(?=[mkgTPMKG]?\b)/isroman($1)?arabic($1):$1/
+eg;
    $a =~ s/(?<![a-z_A-Z0-9])([\d\.]+)([tmkg]b?)\b/($1*$exp{$2})/ig;

    $a =~ s/([\w.]+)!/*%*%$func{fac}%*%($1)/g;
    $a =~ s/($parens)!/*%*%$func{fac}%*%$1/g;

    $a =~ s/\ban[ts]w?\b/$answ/g;
    $a =~ s/\bb([\s01]+)/"0x" . bin2hex($1)/eg;

    $a =~ s/(\d*)\xBC/($1+.25)/g;
    $a =~ s/(\d*)\xBD/($1+.5)/g;
    $a =~ s/(\d*)\xBE/($1+.75)/g;

    # Eerste
    $a =~ s/[^\s\d~x!<>=A-Za-z%e*\.+\-&|\)\(x\/\^]//g;

    if ($a =~ /[A-Fx]/){
        $a = reverse $a;
        $a =~ s/x(?!0\b|[a-z-]+\b|\s+\b|$)/*/g;
        $a =~ s{
            (\d*)              # cijfertjes aan het eind
            ([ABCDEF]+)        # minstens 1 hoofdletter A-F
            (?![0-9A-F]*x0)    # niet 0x ervoor
            (\d*[0-9A-F]*)     # cijfertjes+lettertjes ervoor
        }{
            my ($pre, $hex, $post) = ($1, $2, $3);
            ($hex eq 'E' and $pre =~ m!\d! and $post !~ m!\d+[A-F]!) ?
                "$pre$hex$post" # 3E3 == 3000
            :
                "$pre$hex${post}x0" # hexify! :)
            }gex;
        $a = reverse $a;
    }
    $a =~ s/0x([0-9A-Fe]*)/'0x' . uc $1/ge;

    $brittish = 0;
    my $eerste = qq/[a-z0-9_]/;
    my $daarna = qq/[a-z0-9_-]/;
    my $woord  = qq/$eerste$daarna*/;
    $a =~ s/($woord(?:\s+$woord)*)/my $foo = $1; $foo =~ m!^[\dA-Fxei_
+-]+$! ? $foo : text2number($foo)/eg;
#   $a =~ s/($woord(?:\s+$woord)*)/my $foo = $1; $foo =~ m!^[\dA-Fxei_
+-]+$! ? $foo : ($qwe = $karma->get($foo)) < 0 ? "($qwe)" : ($qwe || 0
+)/eg;

    # Tweede
    $a =~ s/[^\d~x!<>=A-F%ei*\.+\-&|\)\(x\/\^]//g;
    $a =~ s/<>/!=/g;

    $a =~ s/></*/g;
    $a =~ s/=([<>!])/$1=/g;

    $a =~ s/\*\*/^/g;
    $a =~ s/([+\-])(\1+)/join ' ', ($1) x length($1 . $2)/eg;
    $a =~ s/([~e=x*+%\\.\-\/^])(\1*)/$1/eg;
    $a =~ s/([a-z]{2,})/$1 /g;
    $a =~ s/\^/**/g;

    $a =~ s/([<>])\1\1+/$1$1/g;
    $a =~ s/(?<![!<>])=/==/g;

    $a =~ s/(?<=[\dA-F])i/*i/g;

    %func = reverse %func;
    $a =~ s/\*%\*%(\d+)%\*%/$func{$1} /g;

    my $tempansw = '';

    unless ($a =~ /^[*\/]/){
        if ($a eq '1+1'){
            my @randomzut = qw(3 666 42 3.1415926536 0 -1 ~0 DUH);
            $tempansw = $randomzut[rand @randomzut];
        }else{
            {   use Math::Complex; use Math::Trig;
                Math::Complex::display_format('cartesian');
                eval("\$tempansw = ($a) || 0");
            }
            $tempansw .= '';
            $tempansw =~ s/ \(/\(/g;
            if ($tempansw =~ /i/){
                $tempansw =~ s/\[(.*?),pi\]/-$1/g;
                $tempansw =~ s/(?<=\d)i/*i/g;
                if ($output){
                    $output = '';
#                    privmsg('De uitkomst is een complex getal. Comple
+xe getallen zijn niet compatible met -o.');
                }
            }
            if ($output eq 'nl'){
                $tempansw = number2text_nl($tempansw);
            }elsif ($output eq 'uk'){
                $tempansw = number2text_uk($tempansw);
            }elsif ($output eq 'rom'){
                $tempansw = $tempansw < 4000 ? uc roman(int ($tempansw
+ + .5))
                : 'Zoveel geld hadden de romeinen niet...'
            }elsif ($output eq 'hex'){
                $tempansw = $tempansw <= (~0) ? sprintf("0x%X", int($t
+empansw + .5)) : '> ~0';
            }elsif ($output eq 'bin'){
                $tempansw = $tempansw <= (~0) ? 'b' . join '', map {" 
+$hex2bin{$_}"} split //, sprintf("%X", int($tempansw + .5)) : '> ~0';
            }elsif ($output eq 'oct'){
                $tempansw = $tempansw <= (~0) ? sprintf("0%o", int($te
+mpansw + .5)) : '> ~0';
            }
        }
    }

    $a =~ s/\*\*/^/g;
    $a =~ s/ (?![\da-z])//g;

    if ($tempansw ne ''){
        $answ = $tempansw;
        $answ =~ tr/\0-\x1F//d;
        $answ =~ tr/\x80-\xFF//d;
        return "$a = $answ";
#       privmsg('Note: De Britse interpretatie van billion t/m centill
+ion is gebruikt, niet de Amerikaanse.')
#           if $british;
    }else{
        my $lastcalcerr =~ tr/\n//d;
        return "$a = ??" . ($lastcalcerr ? " ($lastcalcerr)" : '');
    }

}
1;