calc.pl: added (calculator for a bot)

1 files changed, 415 insertions, 0 deletions

diff --git a/calc.pl b/calc.pl
new file mode 100644
index 0000000..47f82c0
--- /dev/null
+++ b/calc.pl
@@ -0,0 +1,415 @@
+#!/usr/bin/perl
+
+# Calculator for an irssi-based bot.
+
+no strict;
+
+use utf8;
+
+# N.B. this is *not* the standard module from CPAN, it's a local
+# modified version. I really should rename it.
+use Math::Calc::Parser;
+
+use Math::Complex qw/pi/;
+use Irssi qw/signal_add/;
+
+$helpmsg = "Usage: !calc <expression> | !hex <expression> | !bin <expression>. Syntax is perl-like. !hex, !bin print results in hex or binary, otherwise identical to !calc. Hex constants can be given with 0x or \$ prefix, or h suffix; binary with 0b. See https://www.slackware.uk/~urchlay/calc.html for full doc.";
+
+our $parser;
+our %accumulators;
+
+sub init_parser {
+	$parser = new Math::Calc::Parser;
+	$parser->add_functions(
+			deg   => { args =>   1, code => sub { $_[0] * 180 / pi; } },
+			rad   => { args =>   1, code => sub { $_[0] / 180 * pi; } },
+			frac  => { args =>   1, code => sub { $_[0] - int($_[0]); } },
+			log2  => { args =>   1, code => sub { log($_[0]) / log(2); } },
+
+			k     => { args =>   0, code => sub { 1000; } },
+			m     => { args =>   0, code => sub { 1000000; } },
+			t     => { args =>   0, code => sub { 1000000000; } },
+			kb    => { args =>   0, code => sub { 1024; } },
+			mb    => { args =>   0, code => sub { 1048576; } },
+			tb    => { args =>   0, code => sub { 1073741824; } },
+
+			avg   => { args => '+', code => \&average },
+			ohms  => { args => '+', code => \&parallel_resistors },
+	);
+}
+
+# mean (most people call it an average so I went with that)
+sub average {
+	die "requires at least 2 arguments\n" if @_ < 2;
+
+	my $total;
+	$total += $_ for @_;
+	return $total / @_;
+}
+
+# 1 / (1/x1 + 1/x2 + ... + 1/xn)
+sub parallel_resistors {
+	die "requires at least 2 arguments\n" if @_ < 2;
+
+	my $total = 0;
+	$total += (1 / $_) for @_;
+	return 1 / $total;
+}
+
+# always print an even number of hex digits, with leading 0 if needed.
+sub hex_output {
+	my $res = sprintf("%x", $_[0]);
+	$res = "0" . $res if length($res) & 1;
+	return "0x$res";
+}
+
+# always print a number of bits divisible by 8, with leading zeroes if needed.
+sub bin_output {
+	my $res = sprintf("%b", $_[0]);
+	my $xbits = (length $res) % 8;
+	$res = "0" x (8 - $xbits) . $res if $xbits;
+	return "0b$res";
+}
+
+sub calc {
+	my ($input, $hex, $bin) = @_;
+
+	$input =~ s,\$,0x,g; # allow $xxxx for hex.
+	$input =~ s,([0-9a-f]+)h,0x$1,gi; # allow xxxxh for hex.
+
+	return (1, "Hex constants can't have decimal points") if $input =~ /0x[0-9a-f]+\./g;
+
+	my $result = $parser->try_evaluate($input);
+
+	if(defined $result) {
+		if($hex) {
+			$result = hex_output($result);
+		} elsif($bin) {
+			$result = bin_output($result);
+		}
+		return(0, $result);
+	}
+
+	return(1, $parser->error);
+}
+
+sub expand_vars {
+	$_[0] =~ s,\$_,$accumulators{$_[1]} // 0,ge;
+}
+
+sub on_public_msg {
+	my ($server, $msg, $nick, $address, $target) = @_;
+	my $mynick = $server->{nick};
+
+	unless(length $target) {
+		$target = $nick;
+		$nick = $mynick;
+	}
+
+	my $prefix = "$nick: ";
+	if($target eq $mynick) {
+		# private message... send response to sender
+		$target = $nick;
+		$prefix = "";
+	}
+
+	if($msg !~ /^!(calc|bin|hex)\s+(.+)/) {
+		return;
+	}
+
+	my $hex = ($1 eq 'hex');
+	my $bin = ($1 eq 'bin');
+
+	my $input = lc $2;
+	utf8::decode($input);
+
+	if($input =~ /^-*h(?:elp)?/) {
+		$server->command("msg $target $helpmsg");
+		return;
+	}
+
+	expand_vars($input, $target);
+
+	my ($err, $result) = calc($input, $hex, $bin);
+
+	my $sep;
+	if($err) {
+		$sep = ": ";
+	} else {
+		$sep = " = ";
+		$accumulators{$target} = $result;
+	}
+
+	$server->command("msg $target $prefix$input$sep$result");
+}
+
+### main() {
+init_parser();
+signal_add("message public", "on_public_msg");
+signal_add("message private", "on_public_msg");
+### }
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+  calc.pl - calculator for IRC channels
+
+=head1 SYNOPSIS
+
+  !calc I<expression>
+
+  !hex I<expression>
+
+  !bin I<expression>
+
+=head1 DESCRIPTION
+
+The B<!calc> command takes a mathematical expression and prints the
+result in the IRC channel or query where it was received.
+
+The B<!hex> command is identical to B<!calc>, except that it truncates
+the result to an unsigned integer (32 or 64 bits) and prints it in
+hexadecimal.
+
+The B<!bin> command is the same, except it prints the result in binary.
+
+Variable assignments are not supported. Only one "variable" exists:
+the results of the last calculation are available as B<$_>. This
+variable is local to the channel or query.
+
+=head1 EXAMPLES
+
+  <user> !calc 2+3+4
+  <bot> user: 2+3+4 = 9
+  <user> !calc $_/2
+  <bot> user: 9/2 = 4.5
+
+  <user> !hex 0xff^0x55
+  <bot> user: 0xff^0x55 = 0xaa
+
+  <user> !calc sin(rad(90))
+  <bot> user: sin(rad(90)) = 1
+
+  <user> !calc 1/0
+  <bot> user: 1/0: Error in function "/": Illegal division by zero
+
+=head1 SYNTAX
+
+I<expression> syntax is case-insensitive. It's perl-like, therefore
+C-like, but not identical. Only numbers, numeric operators, and
+(built-in) functions are supported.
+
+Implicit multiplication is supported, e.g. B<2pi> is the same as B<2*pi>.
+
+Complex numbers are supported, with the B<i> constant. B<sqrt(-1)> is B<i>.
+
+=head2 Numbers
+
+Multiple number bases are supported:
+
+=over 4
+
+=item Decimal
+
+Numbers can be in decimal, with optional decimal point. Scientific notation
+is supported (e.g. B<6.0221e+23>). Don't start a number with B<0>, or it
+will be treated as octal, not decimal.
+
+=item Hex
+
+Hexadecimal is also supported, with C/Perl B<0x> prefix, 6502-style B<$> prefix,
+or Intel-style B<h> suffix. Range is limited to the size of an unsigned
+integer, which is generally 32 or 64 bits, depending on your platform.
+
+=item Binary
+
+Binary is also supported, with B<0b> prefix.
+
+=item Octal
+
+Numeric constants starting with B<0> are treated as octal. One caveat:
+attempts to use octal constants with a fractional part (e.g. B<01.23>)
+will give surprising results, as the B<.23> will be treated as a
+separate decimal number. The result will be as though you'd written
+B<01(.23)> (implicit multiplication).
+
+=back
+
+=head2 Operators
+
+These are listed in order of precedence, from lowest to highest.
+
+=over 4
+
+=item | ^
+
+Bitwise OR, exclusive OR.
+
+=item &
+
+Bitwise AND.
+
+=item << >>
+
+Left, Right shifts.
+
+=item + -
+
+Binary operators: Addition, Subtraction.
+
+=item \* / %
+
+Multiplication, Division, Modulus.
+
+=item + -
+
+Unary operators: Positive, Negative (signs).
+
+=item ~
+
+Bitwise NOT.
+
+=item **
+
+Exponentiation.
+
+=item !
+
+Factorial (suffix operator).
+
+=back
+
+=head2 Functions
+
+Functions that take no arguments don't require parentheses. With one argument,
+parentheses aren't required, but it's a good idea to use them (so you
+don't get surprised by the order of operations). For 2 or more args,
+parentheses are required.
+
+Trig functions (B<sin>, B<cos>, etc) are in radians. If you need degrees,
+use something like B<sin(deg(90))>.
+
+=over
+
+=item abs
+
+1 argument: Absolute value.
+
+=item acos asin atan
+
+1 argument: Inverse sine, cosine, and tangent.
+
+=item atan2
+
+Two-argument inverse tangent of first argument divided by second argument.
+
+=item avg
+
+Calculates arithmetic mean. Takes at least 2 arguments.
+
+=item ceil
+
+1 argument: Round up to nearest integer.
+
+=item cos
+
+1 argument: Cosine.
+
+=item deg
+
+1 argument: Convert radians to degrees.
+
+=item e
+
+Euler's number (takes no arguments).
+
+=item floor
+
+1 argument: Round down to nearest integer.
+
+=item frac
+
+1 argument: Fractional part (e.g. B<frac(1.234)> is B<0.234>).
+
+=item i
+
+Imaginary unit (takes no arguments).
+
+=item int
+
+1 argument: Cast (truncate) to integer.
+
+=item k m t
+
+0-argument functions (aka constants) for B<1000>, B<1000000>, B<1000000000>.
+Allows writing e.g. B<4.7K> (evaluates to B<4700>).
+
+=item kb mb tb
+
+0-argument functions (aka constants) for B<1024>, B<1048576>, B<1073741824>.
+Allows writing e.g. B<64KB> (evaluates to B<65536>.
+
+=item ln
+
+1 argument: Natural logarithm (base e).
+
+=item log
+
+1 argument: Log, base 10.
+
+=item log2
+
+1 argument: Log, base 2.
+
+=item logn
+
+2 arguments: Log with arbitrary base given as second argument.
+
+=item ohms
+
+Calculates parallel resistance. Takes at least 2 arguments.
+
+=item pi
+
+π (no arguments).
+
+=item π
+
+π (same as "pi").
+
+=item rad
+
+1 argument: Convert degrees to radians.
+
+=item rand
+
+Random value between 0 and 1 (exclusive of 1). No arguments.
+
+=item round
+
+1 argument: Round to nearest integer, with halfway cases rounded away from zero.
+
+=item sin
+
+1 argument: Sine.
+
+=item sqrt
+
+1 argument: Square root.
+
+=item tan
+
+1 argument: Tangent.
+
+=back
+
+=head1 COPYRIGHT
+
+Licensed under the WTFPL. See http://www.wtfpl.net/txt/copying/ for details.
+
+=head1 AUTHOR
+
+B. Watson (urchlay@slackware.uk).