path: root/calc.pl

#!/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->remove_functions('rand');
	$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 },
			rand  => { args => '+', code => \&random },
			randi => { args => '+', code => \&random_int },
	);
}

# 0 args, or 1 arg if it's 0: random 0 <= x < 1.
# 1 arg (not 0): random 0 <= x < arg.
# 2 args: random arg1 <= x < arg2.
sub random {
	if(!@_ || (@_ == 1 && $_[0] == 0)) {
		return rand(1);
	} elsif(@_ == 1) {
		return rand($_[0]);
	} elsif(@_ == 2) {
		die "can't generate random number between $_[0] and $_[1]" if $_[0] == $_[1];
		@_ = ($_[0], $_[1]) if $_[0] > $_[1];
		return rand($_[1] - $_[0]) + $_[0];
	}
	die "requires 0, 1, or 2 arguments.";
}

sub random_int {
	return int(random(@_));
}

# 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;
	}

	if((!defined $2) || (lc $2 eq 'help') || (lc $2 eq '--help')) {
		$server->command("msg $target $helpmsg");
		return;
	}

	my $hex = ($1 eq 'hex');
	my $bin = ($1 eq 'bin');

	my $input = lc $2;
	utf8::decode($input);

	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

With 0 arguments: same as B<rand(1)>. With 1 argument: random number
between 0 and the argument (or 1, if the arg is 0). With 2 arguments:
random number between the 2 arguments.

=item randi

Same as B<rand>, but truncates the result to an integer. 0, 1, or 2 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).