use English;

@ABBR = ("m",   "u",   "n",   "p",   "f",   "k",   "M",   "G",   "T");
@REPL = ("e-3",  "e-6",  "e-9",  "e-12", "e-15", "e3",    "e6",    "e9",    "e12");
@SUBROUTINES = ();
$REPL = 1; 


printf << "~~~~~~~~~~";
-------------------------------------------------------------------------------
--
--                 ADVANCED PERL STYLE EXPRESSION CALCULATOR. 
--                   Design by Jan Uhrin (inspired by book)
--
~~~~~~~~~~

$logfile = $0 . ".log";
###############################################################################
# Definition of constants
$EDITOR  = 'D:\Apps\EditPlus\editplus.exe'; ### CONSTANT
$PI      = 4 * atan2(1,1);                  ### CONSTANT
$pi      = $PI;                             ### CONSTANT
$E       = exp(1);                          ### CONSTANT
$e       = $E;                              ### CONSTANT
########################################### ### CONSTANT

&help();
system("color E0");

open(LOGFILE, ">>$logfile") or printf("\nERROR: Could not open $logfile for writing\n");

$prompt = 'ucalc.pl % > ';
$now_string = gmtime;
$ACC=0;
$counter = 0;
$prompt1 = $prompt; $prompt1 =~ s/%/$counter/gi;
printf $prompt1;
printf LOGFILE "\n-------------------  " . $now_string . "\n> ";


LINE: while (<>) {
  chop;
  # if someone writes e.g. 4x4 consider it as multiplication
  if ($_ =~ /\dx\d/) { s/x/*/gi; }
  # If replacement is ON then replace abbreviations e.g. k for 1e3, M for 1e6
  if ($REPL) { $_ = &replace_abbr($_); }
  # Execute (evaluate) the expression; accumulate the result
  if ($_ =~ /each_line/) {
	s/each_line\s+//gi;
	&each_line($_);
  } else {
    $r = eval($_);
  }
  # Update accumulator
  $ACC += $r;
  # Execute system command if it starts with !
  if ($_ =~ /\!/) {
   $cmd = $_; $cmd =~ s/\!//gi; $r = system($cmd);
  }
  #
  s/\n//gi;
  $len=length($prompt1);
  push(@C, $_); # History of Commands
  push(@R, $r); # History of Results
  $counter++;
  $prompt1 = $prompt; $prompt1 =~ s/%/$counter/gi;
  if (length($_)<1) { 
      $_ = '$r'; 
      $r = $r_last;
      $this_result = ' ' x $len . $_ . ' = ' . $r . "\t\t\$ACC = $ACC\n" . $prompt1;
  } else {
      $this_result = ' ' x $len . $_ . ' = ' . $r . "\n" . $prompt1;
  }
  
  print $this_result;
  $r_last = $r;
  print LOGFILE $_;
  print LOGFILE "\t\t= " . $this_result;

}
close(LOGFILE);

###############################################################################
sub repl {      ### Toggles replacement mode (i.e. m=2e-3, u=2e-6, ... k=2e3, M=2e9)
  if ($REPL eq 0) { 
    $REPL = 1; 
	printf("Info: Replacement of abbreviations (e.g. m, u, n, s) is now ON.\n");
	return 1;
  } else {
    $REPL = 0; 
	printf("Info: Replacement of abbreviations (e.g. m, u, n, s) is now OFF.\n");
    return 0;
  }
}
###############################################################################
sub abbr {      ### Prints out abbreviations
  my($i)=0;
  my($abbr);
  foreach $abbr (@ABBR) {
    printf("--\t%s\t%s\n", $ABBR[$i], $REPL[$i]);
    $i++;
  }
	return 1;
}
###############################################################################
sub replace_abbr {	#-- Replaces abbreviations, eg. MHz->e6 (see @ABBR array)
  my($in) = (@_);
  my($i)=0;
  my($abbr);
  foreach $abbr (@SUBROUTINES) {
	  #printf("-- " . $abbr . "\n");
	  if ($in =~ /$abbr/) { return $in; }
  }
  foreach $abbr (@ABBR) {
	if ($in =~ /\d$ABBR[$i]/) {
	  printf("Info: Replacing string $& ... To turn off/on replacements enter command \"repl\".\n");
      $in =~ s/$ABBR[$i]/$REPL[$i]/g;
	}
	$i++;
  }
  return($in);
}
###############################################################################
sub help {      ### Writes out help about Constants and Functions
 printf "-" x 79 . "\n";
 printf("-- LOGFILE = $logfile\t(commands, results are logged here)\n--\n");
 printf("-- CONSTANT AND FUNCTION DEFINITIONS:\n");
 printf("--   \$r      = last result\n");
 printf("--   \$R[n]   = n-th result\n");
 printf("--   \$ACC    = accumulated result (can be reset by assigning 0 to it)\n");
 printf("--   !command = execute system (DOS/Windows) command\n");
 if (open(SCRIPT, $0)) {
  @SUBROUTINES = ();
  while (<SCRIPT>) {
    if ( ($_ =~ /\s###\s/) && ($_ !~ /^#/)) {
	  ($junk, $sub) = split;
	  if (length($sub) >= 1) { push(@SUBROUTINES, $sub) };
	  s/\sCONSTANT//gi;
	  s/\{/ /gi;
      printf "--   " . $_;
    }
  }
    printf "-" x 79 . "\n";
 }
	return 1;
}
###############################################################################
sub edit {      ### Opens the ucalc.pl in editor for editing
 my($cmd) = $EDITOR . " " . $0;
 my($ret);
 $ret = system($cmd);
 if ($ret ne 0) {
   system("notepad.exe " . $0);
 }
 return 1;
}
###############################################################################
sub each_line { ### each_line filename hex2bin("%")  --> input from file
                ### each_line -        hex2bin("%")  --> input form STDIN
 my($args) = (@_);
 my($file, @cmds) = split(/\s+/, qq($args));
 my($command) = join(' ', @cmds);
 printf("-- File    = '%s'\n", $file);
 printf("-- Command = '%s'\n", $command);
 if (($file ne "-") && (! (-f $file))) {
   printf("Error: File %s not found...\n", $file);
   return;
 } else {
   if ($file ne "-") { open(INP, $file) or die("Error opening $file for reading...\n"); }
   else { open(INP,'-') or die("Error opening STDIN...\n"); }
   while (<INP>) {
     chop;
	 if (($_ eq "-") || ($_ eq "exit")) { last; }
	 my($cmd) = $command;
	 $cmd =~ s/%/$_/gi;
     #printf("-- Executing:  '%s'\n",  $cmd);
	 my($r) = eval( $cmd );
     printf("%s\n", $r);
   }
   close(INP);
 }
}
###############################################################################
sub bye {       ### Exits the UCALC (exit works also)
  exit;
}
###############################################################################
sub hi {        ### Prints out last N commands and results
  my($in) = (@_);
  hist($in);
}
###############################################################################
sub hist {      ### Prints out last N commands and results
  my($in) = (@_);
  my($i);
  if (!($in > 0)) { $in = 20; }
  if ($in > scalar(@C)) { $in = scalar(@C); }
  for ($i=$in;$i>0;$i--) {
    printf("   > %s\t%s\n", $C[scalar(@C)-$i], $R[scalar(@R)-$i]);
  }
}
###############################################################################
sub reload {    ### Reloads the UCALC from disc
  printf("Terminating the current UCALC and reloading new UCALC from the disc...\n");
  system("start ucalc.pl");
  exit;
}
###############################################################################
sub logview {   ### Opens the logfile in editor
 my($cmd) = $EDITOR . " " . $logfile;
 my($ret);
 $ret = system($cmd);
 if ($ret ne 0) {
   system("notepad.exe " . $logfile);
 }
}

###############################################################################
###############################################################################
###############################################################################
###############################################################################
# Functions on real numbers
###############################################################################
sub ln {        ### Natural Logarithm
my($in) = (@_);
my($result);
$result = log($in) / log(exp(1)); 
}
###############################################################################
sub log2 {      ### Logarithm base 2
my($in) = (@_);
my($result);
$result = log($in) / log(2); 
}
###############################################################################
sub log10 {     ### Logarithm base 10
my($in) = (@_);
my($result);
$result = log($in) / log(10); 
}
###############################################################################
sub tg {        ### Tangens
my($in) = (@_);
my($result);
$result = sin($in) / cos($in); 
}
###############################################################################
sub cotg {      ### Cotangens
my($in) = (@_);
my($result);
$result = cos($in) / sin($in); 
}
###############################################################################
sub sinh {      ### Sinus-hyperbolic
my($in) = (@_);
my($result);
$result = ( exp($in) - exp(- $in) ) / 2; 
}
###############################################################################
sub cosh {      ### Cosinus-hyperbolic
my($in) = (@_);
my($result);
$result = ( exp($in) + exp(- $in) ) / 2; 
}
###############################################################################
sub arcsinh {   ### Inverse Sinus-hyperbolic (Arcus-sinh)
my($in) = (@_);
my($result);
$result = ln( $in + sqrt($in**2 + 1) ); 
}
###############################################################################
sub arccosh {   ### Inverse Cosinus-hyperbolic (Arc-cosh)
my($in) = (@_);
my($result);
$result = 2 * ln(sqrt($in-1) + sqrt($in+1)) - ln(2); 
}
###############################################################################
###############################################################################
###############################################################################
###############################################################################
###############################################################################
# Number format conversion, functions, etc...
###############################################################################
sub hex2bin {   ### Conv. from HEX to BINARY hex2bin(value,separator)
my($in,$sep) = (@_);
my($i);
my($h);
my($result) = "";
$in = lc($in);
if (length($sep)>0) { $sep="_";}
for ($i=0;$i<length($in);$i++) {
  $h = substr($in, $i, 1);
  if    ($h eq 'f') { $result .= "1111"; }
  elsif ($h eq 'e') { $result .= "1110"; }
  elsif ($h eq 'd') { $result .= "1101"; }
  elsif ($h eq 'c') { $result .= "1100"; }
  elsif ($h eq 'b') { $result .= "1011"; }
  elsif ($h eq 'a') { $result .= "1010"; }
  elsif ($h eq '9') { $result .= "1001"; }
  elsif ($h eq '8') { $result .= "1000"; }
  elsif ($h eq '7') { $result .= "0111"; }
  elsif ($h eq '6') { $result .= "0110"; }
  elsif ($h eq '5') { $result .= "0101"; }
  elsif ($h eq '4') { $result .= "0100"; }
  elsif ($h eq '3') { $result .= "0011"; }
  elsif ($h eq '2') { $result .= "0010"; }
  elsif ($h eq '1') { $result .= "0001"; }
  elsif ($h eq '0') { $result .= "0000"; }
  else { $result .= "????"; }
  $result .= $sep;
}
return $result;
}
###############################################################################
sub bin2hex {   ### Conv. from BINARY to HEX
my($in) = (@_);
my($i);
my($h);
my($result) = "";
my($hex_chars);
$in =~ s/_//gi;    # Remove separators if present
$in =~ s/-//gi;    # Remove separators if present
# Get number of resulting hex-chars
if (  (length($in) % 4) == 0.0 ) {
  $hex_chars = int(length($in) / 4);
} else {
  $hex_chars = int(length($in) / 4) + 1;
}
#printf("-- Hex-chars = %d\n", $hex_chars);

# Prepend input with with 0's
$in = "0000" . $in;
for ($i=1;$i<=$hex_chars;$i++) {
  $h = substr($in, -($i*4), 4);
  if    ($h eq "1111") { $result = 'F' . $result; }
  elsif ($h eq "1110") { $result = 'E' . $result; }
  elsif ($h eq "1101") { $result = 'D' . $result; }
  elsif ($h eq "1100") { $result = 'C' . $result; }
  elsif ($h eq "1011") { $result = 'B' . $result; }
  elsif ($h eq "1010") { $result = 'A' . $result; }
  elsif ($h eq "1001") { $result = '9' . $result; }
  elsif ($h eq "1000") { $result = '8' . $result; }
  elsif ($h eq "0111") { $result = '7' . $result; }
  elsif ($h eq "0110") { $result = '6' . $result; }
  elsif ($h eq "0101") { $result = '5' . $result; }
  elsif ($h eq "0100") { $result = '4' . $result; }
  elsif ($h eq "0011") { $result = '3' . $result; }
  elsif ($h eq "0010") { $result = '2' . $result; }
  elsif ($h eq "0001") { $result = '1' . $result; }
  elsif ($h eq "0000") { $result = '0' . $result; }
  else { $result = "?" . $result; }
}
return $result;
}
###############################################################################
# floa2bin subroutine
sub f2bin {     ### Conv. from float or real to binary f2b(value)
 local($value, $word_length) = @_ ;
 local($binpoint) = 0;
 local($printbin) = 0;
 local($i);
 if ($word_length <= 0) { $word_length = int(log(abs($value))/log(2))+2; }
 if ( ($word_length - $binpoint) > 0) {
   $magnitude = 1 << ($word_length - $binpoint - 1);
 }
 elsif ( ($word_length - $binpoint) < 0 ) {
   $magnitude = 1 >> ($word_length - $binpoint + 1);
 }
 else {
   $magnitude  = 1;
 }

 $magn = $magnitude;
 $value_orig = $value ;
 if ( $value < 0 ) {
   $sign = 1;
   $value = -$value;
 }
 else {
  $sign = 0;
 }

 $warning_msg =  "" ;
 if ($value > $magnitude) {
  $warning_msg = "  (overflow for number " . $value . ")" ;
 }
 for ( $i = 0; $i <= $word_length; $i++) {
   if ( $value >= $magn ) {
    $array[$i] = 1;
    $value -= $magn;
   }
   else {
    $array[$i] = 0;
   }
   $magn /= 2;
 }

  if ( $sign ) {
   for( $j = 0; $j <= $word_length;$j++) {
    $array[$j] ^= 1;
   }
   $carry = 1;
   $j = $word_length;
   while ( $carry && ($j >= 0)) {
    if ( $carry && $array[$j] ) { $array[$j] = 0; }
    elsif ( $carry ) {
      $array[$j] = 1;
      $carry = 0;
    }
    else { $carry = 0;
    }
    $j--;
   }
   }

  $carry = $array[$word_length];
  $j = $word_length;
  while ( $carry && ($j >= 0)) {
    if ( $carry && $array[$j] ) { $array[$j] = 0; }
    elsif ( $carry ) {
      $array[$j] = 1;
      $carry = 0;
    }
    else { $carry = 0; }
    $j--;
  }

  $bin = "" ;
  for( $j = 0; $j < $word_length;$j++)   {
  if ($printbin && ($j == ($word_length-$binpoint)) ) {
   $bin = $bin . "." ;
  }
  $bin = $bin . $array[$j] ;
  }
  $bin = $bin . $warning_msg ;
  return $bin ;
}
###############################################################################
# bin2u subroutine
sub bin2u {     ### Conv. from binary to unsigned bin2u(value)
 local($bin)  = (@_) ;
 local($base) = 1;
 local($sum)  = 0;
 local($i);
 local($bit);
 local($err) = 0;
 $bin = lc($bin);
 for($i=length($bin)-1;$i>=0;$i--) {
   $bit = substr($bin,$i,1);
   if ($bit !~ /[0-1]/) { $err++; next; }
   $bit == "1" ? $sum = $sum + $base : $nop;
   $base = $base * 2;
 }
 if ($err > 0) { printf("Info: Invalid characters were skipped.\n"); }
 return $sum;

}
################################################################################
sub f2hex {     ### Conv. from float to 32-bit hexa. Inp. range: <-1,1)
  my($in) = (@_);
  my($hex);
  my($i);
  if ($in >  1) { printf STDERR "-- Overflow (positive) for number $in.\tSaturating to 7FFFFFFF.\n"; return "7FFFFFFF"; }
  if ($in < -1) { printf STDERR "-- Overflow (negative) for number $in.\tSaturating to 10000000.\n"; return "10000000"; }
  $hex = sprintf("%X", $in*(2**31));
  if (($hex eq "80000000") && ($in > 0)) { $hex = "7FFFFFFF"; }  # Taking care of +1.0 value
  if (length($hex) < 8) { for ($i=length($hex);$i<8;$i++) { $hex = "0" . $hex; } }
  return $hex;
}
################################################################################
sub inv {       ### Inversion of binary number.
  my($in) = (@_);
  my($tmp);
  $tmp = $in;
  $tmp =~ s/1/X/gi;
  $tmp =~ s/0/1/gi;
  $tmp =~ s/X/0/gi;
  return $tmp;
}
################################################################################
sub bitrev {    ### Bit-reverse of binary number.
  my($in) = (@_);
  my($rev) = "";
  for($i=length($in)-1;$i>=0;$i--) {
    $rev .= substr($in,$i,1);
  }
  return $rev;
}
################################################################################
#sub b127 {    ### b127
#  for($aa=0;$aa<128;$aa++) { $b = f2bin($aa, 8); $a = bitrev($b); $c = bin2u($a); print("$c\n"); }
#}
################################################################################
sub dev {       ### Deviation in percent from reference dev(val,ref) 
  my($in1,$ref) = (@_);
  return 100*(($in1 - $ref) / $ref) ;
}