#!/usr/bin/perl -w

# Simple INTERCAL desk calculator

# This file is part of CLC-INTERCAL

# Copyright (c) 2006 Claudio Calvelli, all rights reserved.

# CLC-INTERCAL is copyrighted software. However, permission to use, modify,
# and distribute it is granted provided that the conditions set out in the
# licence agreement are met. See files README and COPYING in the distribution.

require 5.005;

use strict;
use Getopt::Long;

use vars qw($PERVERSION);
$PERVERSION = "CLC-INTERCAL bin/intercalc 1.-94.-4";

my ($PERVNUM) = $PERVERSION =~ /\s(\S+)$/;

use Language::INTERCAL::Sick '1.-94.-4';
use Language::INTERCAL::GenericIO '1.-94.-4', qw($stdsplat);
use Language::INTERCAL::Rcfile '1.-94.-4.1';
use Language::INTERCAL::Interface '1.-94.-4', qw(user_interface);
use Language::INTERCAL::GenericIO '1.-94.-4';
use Language::INTERCAL::ReadNumbers '1.-94.-4', qw(roman roman_type);

my %roman_ok = map { ( roman_type($_) => 1 ) } qw(CLC ARCHAIC WIMPMODE);

if (defined &Getopt::Long::Configure) {
    Getopt::Long::Configure qw(no_ignore_case auto_abbrev permute bundling);
} else {
    $Getopt::Long::ignorecase = 0;
    $Getopt::Long::autoabbrev = 1;
    $Getopt::Long::order = $Getopt::Long::PERMUTE;
    $Getopt::Long::bundling = 1;
}

my $compiler = new Language::INTERCAL::Sick;
my $setoption = sub { $compiler->setoption(@_) };
my $rcfile = new Language::INTERCAL::Rcfile;
my $language = 'ick'; # XXX should be 'sick' - see discussion in MISSING
my @options = ();
my $mode = 'full';
my $user_interface = '';
my $verbhandle = $stdsplat;
my $history = 5;

GetOptions(
    # User Interface Options
    'graphic|X'     => sub { $user_interface = 'X' },
    'curses|c'      => sub { $user_interface = 'Curses' },
    'line'          => sub { $user_interface = 'Line' },
    'batch'         => sub { $user_interface = 'None' },
    'interface|i=s' => \$user_interface,
    # source language and compile options
    'bug=i'         => $setoption,
    'ubug=i'        => $setoption,
    'include|I=s'   => $setoption,
    'language|l=s'  => \$language,
    'option|o=s'    => \@options,
    'mode|m=s'      => \$mode,
    # misc options
    'rcfile|r=s'    => sub { $rcfile->setoption(@_) },
    'verbose|v'     => sub { &$setoption('verbose', $verbhandle) },
    'quiet|q'       => sub { &$setoption('verbose', 0) },
    'stdverb=s'     => sub {
			       my ($opt, $file) = @_;
			       my $mode = $file =~ s/^([ra]),// ? lc($1) : 'r';
			       $verbhandle =
				   new Language::INTERCAL::GenericIO
				       ('FILE', $mode, $file);
			   },
) or usage();

$rcfile->setoption('include', $_)
    for $compiler->getoption('include');
$rcfile->load;

my $calculator = undef;
if ($mode =~ /^oic(\d+)?$/i) {
    my $nmems = $1 || 100;
    my $digits = length($nmems - 1);
    $calculator = bless {
	nmems => $nmems,
	memory => [(0) x $nmems],
	digits => $digits,
	format => "m%0${digits}d",
	regex => qr/^m(\d{1,$digits})/i,
	command => '',
	has_memory => 1,
	mode => 'oic',
	display_size => 22,
    }, 'OIC';
} else {
    $mode =~ /^(?:full|expr)$/i or die "Invalid mode $mode\n";
    $mode = lc($mode);
#    my $trace_data = '';
#    my $trace_fh =
#	Language::INTERCAL::GenericIO->new('STRING', 'r', \$trace_data);
#    $compiler->setoption('trace', $trace_fh);
    $calculator = bless {
	has_memory => 0,
	command => '',
	mode => $mode,
	display_size => 48,
	finish => \&_finish,
	cache => {},
#	trace => \$trace_data,
    }, 'INC';
}

my $progname = $0;
$progname =~ s#^.*/##;

my $ui = user_interface($user_interface, $rcfile->getitem('SPEAK'));
if (! $ui->is_interactive) {
    $| = 1;
    &{$calculator->{finish}}($calculator, 0) if exists $calculator->{finish};
    if ($calculator->{is_wimp}) {
	my $msg = make_wimp();
	my $len = 0;
	for my $l (@$msg) {
	    $len = length $l if $len < length $l;
	}
	my $dash = '=' x $len;
	print "$_\n" for ('', $dash, '', @$msg, '', $dash);
    }
    while (<STDIN>) {
	chomp;
	next unless /\S/;
	my ($calculation, $memory, $scroll, @result) = $calculator->run($_);
	push @result, '' unless @result;
	for my $result (@result) {
	    $result =~ s/\s+$//;
	    $result =~ s/\n/ /g;
	    print $memory if $calculator->{has_memory};
	    printf "%$calculator->{display_size}s     %s\n",
		   $result, $calculation;
	    $memory = $calculation = '';
	}
    }
    exit 0;
}

# interactive user interface - set up environment

my @about = ("About $progname", '', "Distributed with CLC-INTERCAL $PERVNUM");

my @copyright = split(/\n/, <<EOC);
Copyright (c) 2006 Claudio Calvelli <intercal\@sdf.lonestar.org>

In addition to the above, permission is hereby granted to use, misuse,
modify, distribute, break, fix again, etcetera CLC-INTERCAL-$PERVNUM
provided that the following conditions are met:

    1. Redistributions of source code must retain the above copyright
       notice, this list of conditions and the following disclaimer.
    2. Redistributions in binary form must reproduce the above copyright
       notice, this list of conditions and the following disclaimer in the
       documentation and/or other materials provided with the distribution.
    3. Neither the name of the Author nor the names of its contributors
       may be used to endorse or promote products derived from this software
       without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
SUCH DAMAGE.
EOC

my @for = ("Help for $progname");

my @help = split(/\n/, <<'EOH');
For information about CLC-INTERCAL, please RTFM.

For information about the calculator, please press
keys at random until you figure out what they do.

For any other queries, please ask them somewhere else.

We hope this information helped. Thank you for contacting us.
EOH

my $about = undef;
my $help = undef;
my $give_up = 0;
my $reserved = 0;

my @interface = (
    'vstack', border => 2, data =>
    # title
    ['hstack', data =>
     ['text', value => "CLC-INTERCAL $PERVNUM", align => 'c'],
    ],
    # history and display
    ['vstack', data =>
     (map {
	 ['hstack', data =>
	  ($calculator->{has_memory}
	     ? ['text', value => '', size => 1 + $calculator->{digits},
	        align => 'l', name => "memory$_"]
	     : ()),
	  ['text', value => ' ' x $calculator->{display_size},
	   align => 'r', name => "display$_"],
	 ],
     } (1..$history), ''),
    ],
);
if ($calculator->{mode} eq 'oic') {
    push @interface, (
	# command
	['hstack', data =>
	 ['text', value => '', align => 'l', size => 32, name => 'command'],
	],
	# keyboard
	['table', columns => 4, border => 2, data =>
	 # keyboard - row 1
	 ['key', name => 'Give Up', key => [qw(g G)], action => \&_give_up],
	 'l',
	 ['key', name => 'About', key => [qw(a A)], action => \&_about],
	 'l',
	 # keyboard - row 2
	 ['key', name => '7', key => '7', action => \&_addkey],
	 ['key', name => '8', key => '8', action => \&_addkey],
	 ['key', name => '9', key => '9', action => \&_addkey],
	 ['key', name => '?', key => [qw(? h H)], action => \&_help],
	 # keyboard - row 3
	 ['key', name => '4', key => '4', action => \&_addkey],
	 ['key', name => '5', key => '5', action => \&_addkey],
	 ['key', name => '6', key => '6', action => \&_addkey],
	 ['key', name => '<-', key => ["\cH", 'Left', 'BackSpace'], action => \&_delkey],
	 # keyboard - row 4
	 ['key', name => '1', key => '1', action => \&_addkey],
	 ['key', name => '2', key => '2', action => \&_addkey],
	 ['key', name => '3', key => '3', action => \&_addkey],
	 ['key', name => 'C', key => [qw(c C)], action => \&_clear],
	 # keyboard - row 5
	 ['key', name => '.', key => '.', action => \&_addkey],
	 ['key', name => '0', key => '0', action => \&_addkey],
	 ['key', name => '-', key => '-', action => \&_addkey],
	 ['key', name => 'M', key => [qw(m M)], action => \&_addkey],
	],
    );
} elsif ($calculator->{mode} eq 'expr') {
    push @interface, (
	# command
	['hstack', data =>
	 ['text', value => '', align => 'l', size => 48, name => 'command'],
	],
	# keyboard
	['table', border => 2, columns => 7, data =>
	 (map {
	     ['key',
	      name => $_,
	      key => /[a-z]/i ? [lc($_), uc($_)] : $_,
	      action => \&_addkey]
	 } (
	     qw(. < - S U B Y),            # row 1
	     qw(: / 7 8 9 ' ),            # row 2
	     ',', qw(\ 4 5 6 " &),         # row 3
	     qw(; $ 1 2 3 ! V),            # row 4
	     qw(@ ~ * 0), '#', qw(+ ),    # row 5
	 )),
	 # row 6
	 ['key', name => '^', key => '^', action => \&_addkey],
	 ['key', name => 'Do It', key => ["\cJ", "\cM", qw(Enter Return Linefeed d D)], action => \&_calculate],
	 'l',
	 ['key', name => 'Give Up', key => [qw(g G)], action => \&_give_up],
	 'l',
	 'l',
	 ['key', name => '?', key => '?', action => \&_addkey],
	 # row 7
	 ['key', name => '%', key => '%', action => \&_addkey],
	 ['key', name => 'Clear', key => [qw(c C)], action => \&_clear],
	 'l',
	 ['key', name => 'backspace', key => ["\cH", 'Left', 'BackSpace'], action => \&_delkey],
	 'l',
	 'l',
	 ['key', name => '|', key => '|', action => \&_addkey],
	 # row 8
	 ['key', name => ' ', key => ' ', action => \&_addkey],
	 ['key', name => 'Help', key => [qw(h H)], action => \&_help],
	 'l',
	 ['key', name => 'About', key => [qw(a A)], action => \&_about],
	 'l',
	 'l',
	 ['key', name => ' ', key => ' ', action => \&_addkey],
	],
    );
} else {
    push @interface, (
	# command
	['hstack', data =>
	 ['text', value => '', align => 'l', size => 49, name => 'command'],
	],
	# keyboard
	['table', border => 2, columns => 8, data =>
	 (map {
	     ['key',
	      name => $_,
	      key => /[a-z]/i ? [lc($_), uc($_)] : $_,
	      action => \&_addkey]
	 } (
	     qw(. 0 1 2 3 4), '#', qw(=),
	     qw(: 5 6 7 8 9 + -),
	     ',', qw(A B C D E ' "),
	     qw(; F G H I J), '(', ')',
	     qw(@ K L M N O [ ]),
	     qw(% P Q R S T ! *),
	     qw(^ U V W X Y & |),
	     qw($ Z / \ ~   ?),
	 )),
	 ['key', name => 'space', key => ' ', action => \&_addkey],
	 'l',
	 ['key', name => 'F1: Help', key => 'F1', action => \&_help],
	 'l',
	 ['key', name => 'F3: Quit', key => 'F3', action => \&_give_up],
	 'l',
	 ['key', name => 'F5: Do It', key => ["\cJ", "\cM", qw(Enter Return Linefeed F5)], action => \&_calculate],
	 'l',
	 ['key', name => 'backspace', key => ["\cH", 'Left', 'BackSpace'], action => \&_delkey],
	 'l',
	 ['key', name => 'F2: About', key => 'F2', action => \&_about],
	 'l',
	 ['key', name => 'F4: Clear', key => 'F4', action => \&_clear],
	 'l',
	 ['key', name => "F6: Res'ved", key => 'F6', action => \&_reserved],
	 'l',
	],
    );
}
$ui->window('Calculator', \&_give_up, \@interface);
$ui->set_text("display$_", '') for (1..$history, '');
$ui->start();
&{$calculator->{finish}}($calculator, 1) if exists $calculator->{finish};
_clear_status();
_enable_keys();
if ($calculator->{is_wimp}) {
    my $wimp = undef;
    _popup(\$wimp, make_wimp(), [], 'WIMP');
    $calculator->{is_wimp} = 0;
}
$ui->run;

sub make_wimp {
    my $ugly = 69 + int(rand 65467);
    my $beautiful = roman($ugly, roman_type('CLC'));
    [split(/\n/, <<EOH)];
You have requested the 'wimp' compiler option. This means that
the display output will use those ugly digits where you could
have some beautiful Roman numerals instead.

Compare the ugly $ugly with the beautiful $beautiful.

It also means that you are a WIMP WIMP WIMP WIMP.

As a penance, write "I AM A WIMP" M (sorry, 1000) times.
EOH
}

sub _finish {
    my ($inc, $interactive) = @_;
    my $status = $interactive
	? sub { _status(@_); $ui->update() }
	: sub { print STDERR @_, "\n" };
    $status->("Loading compiler ($language)");
    eval {
	$compiler->setoption('default_charset', $_)
	    for $rcfile->getitem('WRITE');
	$compiler->setoption('default_backend', 'Run');
	$compiler->clearoption('preload');
	$compiler->setoption('preload', $language);
	$compiler->setoption('preload', $_) for @options;
	$compiler->setoption('trace', 0);
	$compiler->source('null.iacc');
	$compiler->load_objects();
	my $obj = $compiler->get_object('null.iacc')
	    or die "Internal error: no compiler object\n";
	$calculator->{object} = $obj;
	$calculator->{parser} = $obj->{object}->parser(1);
	$calculator->{s_space} = $obj->getreg('SS')->number;
	$calculator->{s_line} =
	    $obj->getreg($calculator->{mode} eq 'full' ? 'FS' : 'ES')->number;
	my $read_data = '';
	my $read_fh = Language::INTERCAL::GenericIO->new('STRING', 'r',
							 \$read_data);
	$calculator->{read_data} = \$read_data;
	$calculator->{read_fh} = $read_fh;
	my $write_data = '';
	my $write_object = bless \$write_data, 'WOBJ';
	my $write_fh = Language::INTERCAL::GenericIO->new('OBJECT', 'w',
							  $write_object);
	$obj->setreg('ORFH', $read_fh);
	$obj->setreg('OSFH', $read_fh);
	$obj->setreg('OWFH', $write_fh);
	my $rt = $obj->getreg('RT')->number;
	if (! exists $roman_ok{$rt}) {
	    $obj->setreg('RT', 'CLC');
	}
	$calculator->{is_wimp} = $obj->getreg('WT')->number;
	$status->("Done loading compiler");
    };
    if ($@) {
	my $e = $@;
	$e =~ s/\s+/ /g;
	$e =~ s/undefined subroutine &(?:Language::INTERCAL::)?/&/i;
#	$e =~ s/ at \S+ line \d+.*$//;
	$e =~ s/^ //;
	$e =~ s/ $//;
	$status->($e);
	sleep 2;
	exit 1;
    }
}

sub _enable_keys {
    my $enable_all = $ui->pending_events();
    $ui->forall('key',
		sub {
		    my ($ui, $key, $name, $action) = @_;
		    $enable_all = 1 if ! $enable_all && $ui->pending_events();
		    if ($action == \&_addkey) {
			$enable_all || defined $calculator->can_add($name)
			    ? $ui->enable($key)
			    : $ui->disable($key);
			return 1;
		    }
		    if ($action == \&_calculate) {
			$enable_all || $calculator->can_run()
			    ? $ui->enable($key)
			    : $ui->disable($key);
			return 1;
		    }
		    return 1;
		});
}

sub _popup {
    my ($object, $list1, $list2, $title) = @_;
    $give_up = 0;
    _clear_status();
    if (! $$object) {
	my $destroy = sub {
	    $$object = undef;
	    $give_up = 0;
	    _clear_status();
	    1;
	};
	my $close = sub {
	    $ui->close($$object) if $$object;
	    $$object = undef;
	    $give_up = 0;
	    _clear_status();
	};
	$$object = $ui->window($title, $destroy, [
	    'vstack', border => 2, data =>
	    ['vstack', data =>
	     (map { ['text', value => $_, align => 'c'] } @$list1),
	     (@$list1 && @$list2 ? (['text', value => '']) : ()),
	     (map { ['text', value => $_, align => 'l'] } @$list2),
	     ['text', value => ''],
	     ['key',
	      name => 'OK',
	      key => ["\cJ", "\cM", qw(Enter Return Linefeed)],
	      action => $close],
	     ]
	]);
    }
    $ui->show($$object);
}

sub _about {
    _popup(\$about, \@about, \@copyright, 'About');
}

sub _help {
    _popup(\$help, \@for, \@help, 'Help');
}

sub _reserved {
    $reserved == 0 and _status("That key is reserved. Don't press it again");
    $reserved == 1 and _status("I really mean it. Don't press that key");
    $reserved > 1 and do {
	_status("Well, you've asked for it. Didn't I tell you?");
	$ui->update();
	exit;
    };
    $reserved++;
}

sub _give_up {
    exit if $give_up;
    $give_up = 1;
    _status('Do that again to really GIVE UP');
}

sub _clear {
    $give_up = 0;
    _clear_status();
    $calculator->{command} = '';
    $ui->set_text('command', '');
    _enable_keys();
}

sub _addkey {
    my ($key) = @_;
    $give_up = 0;
    my $ok = $calculator->can_add($key);
    if (defined $ok) {
	if (ref $ok) {
	    $calculator->{command} .= $$ok;
	    _calculate();
	    return;
	} else {
	    $calculator->{command} .= $ok;
	    _enable_keys();
	}
    }
    _clear_status();
}

sub _calculate {
    my $c = $calculator->{command};
    if ($c eq '') {
	_clear_status();
    } elsif ($calculator->can_run) {
	my ($calculation, $memory, $scroll, @result) = $calculator->run($c);
	$calculator->{command} = '';
	$ui->set_text('command', $calculation);
	for my $result (@result) {
	    if (exists $calculator->{skip_scroll}) {
		delete $calculator->{skip_scroll};
	    } else {
		for (my $h = 1; $h <= $history; $h++) {
		    my $ph = $h == $history ? '' : $h + 1;
		    $ui->set_text("display$h", $ui->get_text("display$ph"));
		    $ui->set_text("memory$h", $ui->get_text("memory$ph"))
			if $calculator->{has_memory};
		}
	    }
	    $result =~ s/\s+$//;
	    $result =~ s/\n/ /g;
	    $ui->set_text('display', $result);
	    $ui->set_text('memory', $memory) if $calculator->{has_memory};
	}
	$calculator->{skip_scroll} = 1 if $scroll;
    }
    _enable_keys();
}

sub _delkey {
    $give_up = 0;
    _clear_status();
    my $command = $calculator->{command};
    $command =~ s/.$//;
    $calculator->{command} = $command;
    $ui->set_text('command', $command);
    _enable_keys();
}

sub _clear_status {
    $ui->set_text('command', $calculator->{command});
    if ($calculator->{skip_scroll}) {
	$calculator->{skip_scroll} = 0;
	$ui->set_text("display", '');
	$ui->set_text("memory", '') if $calculator->{has_memory};
    }
}

sub _status {
    my ($msg) = @_;
    $ui->set_text('command', $msg);
    $ui->update();
}

sub usage {
    (my $p = $0) =~ s#^.*/##;
    die "Usage: $p [-alphabet] files...\n";
}

sub _parse {
    my ($inc, $line) = @_;
}

package INC;

sub can_add {
    my ($inc, $key) = @_;
    _check($inc, $inc->{command} . $key, 0, $key);
}

sub _check {
    my ($inc, $line, $p, $key) = @_;
    return $inc->{cache}{$line}[$p] if exists $inc->{cache}{$line};
    my $expr = 1;
    my @l;
    my $ok = 0;
    my $run = 0;
    eval {
	@l = $inc->{parser}->compile($inc->{s_line}, $line, 0,
				     $inc->{s_space}, 0);
	$run = grep { ref $_ && $_->[1] == length($line) } @l;
	$ok = grep { ! ref $_ || $_->[1] == length($line) } @l;
    };
    $inc->{cache}{$line} =  [($ok ? $key : undef), $run];
    return $inc->{cache}{$line}[$p];
}

sub can_run {
    my ($inc) = @_;
    _check($inc, $inc->{command}, 1, '');
}

sub run {
    my ($inc, $oline) = @_;
    my @result;
    eval {
	my $line = $oline;
	_check($inc, $line, 1, '') or die "Syntax error\n";
	my @l = $inc->{parser}->compile($inc->{s_line}, $line, 0,
					$inc->{s_space}, 0);
	$inc->{cache} = {} if $calculator->{invalidate};
	@l = map { $_->[3] } grep { ref $_ } @l;
	die "Syntax error\n" unless @l;
	$inc->{object}->object->code(\@l);
	$inc->{object}->object->source($line);
	${$inc->{read_data}} = '';
	$inc->{object}->start()->run()->stop();
	@result = grep { /./ } split(/\n+/, ${$inc->{read_data}});
    };
    push @result, $@ if $@;
    for (@result) {
#	s/\s+/ /g;
	if (/\*\d{3}/) {
	    s/\s+/ /g;
	    s/undefined subroutine &(?:Language::INTERCAL::)?/&/i;
#	    s/ at \S+ line \d+.*$//i;
	    s/^ //;
	    s/ $//;
	}
    }
    my $scroll = 0;
    unless (@result) {
	push @result, 'OK';
	$scroll = 1;
    }
    ($oline, '', $scroll, @result);
}

package OIC;

sub run {
    my ($oic, $line) = @_;
    my $calculation = '';
    my $memory = '';
    my @result = ();
    eval {
	$line =~ s/\s+//g;
	$calculation = '(';
	my $a = _extract_oic($oic, \$line, \$calculation);
	die "Missing number\n" if $a eq '';
	$calculation .= ' - ';
	my $b = _extract_oic($oic, \$line, \$calculation);
	die "Missing number\n" if $b eq '';
	$calculation .= ') / ';
	my $c = _extract_oic($oic, \$line, \$calculation);
	die "Missing number\n" if $c eq '';
	$line =~ s/$oic->{regex}//
	    or die "Invalid result: $line\n";
	$1 >= $oic->{nmems}
	    and die "Invalid memory $1\n";
	my $m = $1;
	$memory = sprintf $oic->{format}, $m;
	my $result = ($a - $b) / $c;
	$oic->{memory}[$m] = $result;
	push @result, $result;
	$line eq '' or die "Extra data after line: $line\n";
    };
    push @result, $@ if $@;
    ($calculation, $memory, 0, @result);
}

sub _extract_oic {
    my ($oic, $line, $calculation) = @_;
    if ($$line =~ s/$oic->{regex}//) {
	$1 >= $oic->{nmems}
	    and die "Invalid memory $1\n";
	$$calculation .= sprintf $oic->{format}, $1;
	return $oic->{memory}[$1];
    }
    if ($$line =~ s/^(-?\d+\.\d*|-?\d*\.\d+|-?\d+)//) {
	$$calculation .= $1;
	return $1;
    }
    die "Invalid syntax: $line\n";
}

sub can_add {
    my ($oic, $key) = @_;
    my $l = $oic->{command} . $key;
    for (1..3) {
	my $r = '';
	last if $l =~ s/^(?:-\.?|\.|m)$//i;
	eval { _extract_oic($oic, \$l, \$r) };
	return undef if $@;
	last if $l eq '';
    }
    if ($l ne '') {
	$l =~ s/^m//i or return undef;
	$l =~ /^\d*$/ or return undef;
	return \$key if length($l) == $oic->{digits};
    }
    return $key;
}

sub can_run {
    my ($oic) = @_;
    my $ok = $oic->can_add('');
    defined $ok && ref $ok;
}

package WOBJ;

sub write {
    my ($wobj, $size) = @_;
    while (1) {
	return substr($$wobj, 0, $size, '') if length $$wobj >= $size;
	if ($ui->is_interactive) {
	    return ''; # XXX not yet implemented
	} else {
	    print "DATA> ";
	    my $line = <STDIN>;
	    $$wobj .= $line;
	}
    }
}

__END__

=pod

=head1 NAME

intercalc - CLC-INTERCAL desk calculator

=head1 SYNOPSIS

B<intercalc> [options]

=head1 DESCRIPTION

B<intercalc> is a simple desk calculator, allowing the user to
enter INTERCAL statements (to see what they do) and expressions
(to see what value they produce); it uses an interpreter object
from CLC-INTERCAL to provide immediate feedback.

The desk calculator accepts several options, some of which are documented here.

=head2 User Interface Options

=over 4

=item B<-X> / B<--graphic>

Enters X-based graphical user interface. Requires Perl-GTK. This is the
default if Perl-GTK is installed, the environment variable I<$DISPLAY> is
set and the opening of the X display succeeds.

=item B<-c> / B<--curses>

Enters full screen, curses-based interface. This is the default if the
X based interface cannot be started, the environment variable I<$TERM>
is set and the terminal name is known.

=item B<--line>

Enters the line-mode user interface. This is the default if the X based
and the curses based interfaces do not work.

=item B<--batch>

Avoids entering interactive mode. This is the default if the standard
input and output are not connected to a terminal and the X based interface
cannot be started.

=item B<-i>I<type> / B<--interface=>I<type>

Selects the user interface I<type>. Currently, only I<X>, I<Curses>,
I<Line> and I<None> are defined, but more can be installed as compiler
plug-ins. If the interface selected is I<None>, B<intercalc> will work in
batch mode. In addition, an empty string will reinstate the default
behaviour.

=back

=head2 Source language and compilation options

=over 4

=item B<--bug=>I<number>

Selects a different probability for the compiler bug. The compiler bug is
implemented by initialising the compiler's state with the required probability:
when a statement is compiled (usually at runtime), a "BUG" instruction is
emitted with the required probability. The default is 1%.

=item B<--ubug=>I<number>

Selects a probability for the unexplainable compiler bug. This is the compiler
bug which occurs when the probability of a (explainable) compiler bug is zero.
Only wimps would use this option. The default is 0.01%.

=item B<-I>I<path> / B<--include=>I<path>

Adds a directory before the standard search path for compiler objects
and source code. If a file is accessible from the current directory,
it is never searched in any include path.

If this option is repeated, the given paths will be searched in reverse
order (last specified searched first), followed by the standard paths,
in direct order.

=item B<-l>I<language> / B<--language=>I<language>

Selects the language to use when interpreting user input. This should
correspond to the name of a compiler, which is an INTERCAL object
which was originally built by I<iacc>. Only the expression and
statement parsers are used, so it is possible to test incomplete
compilers by loading them into I<intercalc> even if they don't
work with I<sick>.

=item -B<-o>I<option> -B<--option=>I<option>

Adds a language option. For example, -B<-o>I<3> selects base 3 calculation,
and -B<-o>I<wimp> selects wimp mode.

=item B<-m>I<mode> / B<--mode=>I<mode>

Select operation mode. Currently, the only valid modes are I<full>,
I<expr> and I<one>. See L</Operating Modes>

=back

=head2 Misc Options

=over 4

=item B<-r>I<name> / B<--rcfile=>I<name>

Executes commands from file I<name> before entering interactive mode.
This option can be repeated, to execute more than one file. If it is
not specified, the standard library, the current directory, and the
current user's home directory are searched for files with name
F<system.sickrc> or F<.sickrc>, which are then executed. The order
for this search is: specified library (B<--include>), system library,
home directory, current directory. This is different from the search
order used when looking for objects or source code. If a directory
contains both F<.sickrc> and F<system.sickrc>, the F<system.sickrc>
is executed first, followed by F<.sickrc>. Also note that if the
current directory or the home directory appear in the search path
and contain one of these files, they will be executed twice.

If filenames are explicitely specified, they must be fully qualified:
the search path is not used to find them.

=item B<-v> / B<--verbose>

Tells everything it's doing on Standard Error.

=item B<--stdverb=>I<file>

Sends verbose output to I<file> rather than standard error

=item B<-q> / B<--quiet>

Does not chatter to Standard Error or whatever.

=back

=head1 Operating Modes

The calculator can operate in the following modes:

=over 5

=item full
Fully functional INTERCAL interpreter.

The calculator can parse and execute any statement or expression.

Statements are compiled as a one-statement program, and executed;
any register value etc. will be preserved between statements, so
entering a list of statements is equivalent to running a program
in which all these statements are executed in sequence.

It is important to note that some statements will not execute in
the normal manner. For example, a COME FROM will be parsed but
have no effect, unless it is something like:

    (1) PLEASE COME FROM (1)

which causes the calculator to hang. On the other hand, an ABSTAIN FROM
or a REINSTATE will work as expected, as will CREATE and DESTROY.
A GIVE UP does not cause the calculator to terminate. One final
difference is that comments are not parsed, and therefore you get a
"Syntax Error" from the calculator rather than a splat *000 from the
INTERCAL interpreter.

For expressions, the calculator READs OUT the expression's result.
Any side effects will be remembered, so if the expression contains
overloads they will remain to haunt the calculator.

=item expr
INTERCAL expression interpreter

The calculator can only parse expressions or assignments. In either
case, the calculated values are READ OUT; assignments will also
store the value to the destination, while expressions will then
discard the result.

=item oic
The B<O>ne B<I>nstruction B<C>alculator.

This is something we've made
up one early morning while discussing desk calculators (as one does).
It is not INTERCAL at all, in fact it is inspired from the One Instruction
Set Computer.

The calculator has a number of memories (default 100 - these can be changed
by appending a number to the operating mode, for example I<oic10> will
use a 10-memory calculator). These memories are identified by the letter
B<m> followed by a number; in the default 100-memory version, the first two
digits after B<m> are the memory, and any subsequent digit forms part
of the next operand. At the start, all memories are initialised to 0.

Since there is only one operation, there is no need to specify it, so an
"operation" is a sequence of three operands and a result. The result must
be a memory, while each operand can be a number or a memory, with the
limitation that consecutive numbers are acceptable only if the parser can
determine where one ends and the next one starts. So for example "1-0" is
two numeric operands, 1 and -0 (aka 0); "1.2.3" is also two operands,
1.2 and 3; "12" is a single operand, even if you intended it to be two
operands, 1 and 2, and even if you put spaces: "1 2" is still interpreted
as the single operand 12.

The operation performed is the difference between the first two operands,
divided by the third. For example, the three operations:

    7 m01 2 M01
    1 m02 1 m02
    m1 .5 m2 m03

will produce results m01=3.5 ((7-0)/2); m02=1 ((1-0)/1); m03=3 ((3.5-.5)/1).
and will produce the following output if the calculator is running in batch
mode:

    m01                  3.5     (7 - m01) / 2
    m02                    1     (1 - m02) / 1
    m03                    3     (m01 - .5) / m02

=back

=head1 SEE ALSO

The INTERCAL on-line documentation, by entering B<intercalc>'s interactive mode
and finding the "help" menu (X), key (Curses) or command (Line). There is no
help in batch mode, however the documentation will have been installed somewhere
on the system.

