#!/usr/bin/perl

eval 'exec perl -S $0 ${1+"$@"}'
    if 0;

# INTERCAL RPN calculator

# The program reads the input one character at a time (if possible, otherwise
# one line at a time) and passes it to an INTERCAL program which implements
# an INTERCAL RPN calculator. Use '0' and '1' to create a binary number (the
# program will reply with the corresponding Roman numerals), 'e' to separate
# two numbers ("ENTER^" key on HP calculators), '&', 'V', '?' for the unary
# operators, and '~', '$' for the binary operators. Press 'q' to quit.

# This file is part of CLC-INTERCAL.

# WARNING - do not operate heavy machinery while using CLC-INTERCAL

# Copyright (C) 1999 Claudio Calvelli <lunatic@assurdo.com>, all rights reserved

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

my $use_readkey;

BEGIN {
    $use_readkey = 0;
    eval {
	require Term::ReadKey;
	import Term::ReadKey;
	ReadMode(4);
	$use_readkey = 1;
    };
}

END {
    if ($use_readkey) {
	ReadMode(0);
    }
}

my $kbuff = '';

use Language::INTERCAL 'rpn', '
	@k@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@k@@{@L`@{
	@@@k
	@K@L`@{
	@K@L`@{
	@K@L`@{
	@K@L`@{
	@K@L`@{
	@K@L`@{
	@@@M]
	@@@M]
	@^@L`@{
	@^@@{@L`@{
	@^@@{@L`@{
	@^@@{@L`@{
	@^@@{@L`@{
	@@@^
	@^@L`@{
	@@@^
	@K@L`@}^{}{
	@z@L`@{J{
	@K@L`@}P}eKJ{}zJ{}z
	@K@L`@}e}KK}{J{}{
M]	@K@L`@{}}KJK}J}KJK}J}KJK}J}KJK}}
	@K@L`@}P}eKJ{}zJ{}z
	@K@L`@}e}KK}{J{}{
M]	@K@L`@{}}KJK}J}KJK}J}KJK}J}KJK}}
	@K@L`@}P}eKJ{}zJ{}z
	@K@L`@}e}KK}{J{}{
M]	@K@L`@{}}KJK}J}KJK}J}KJK}J}KJK}}
	@K@L`@}P}eKJ{}zJ{}z
	@K@L`@}e}KK}{J{}{
M]	@K@L`@{}}KJK}J}KJK}J}KJK}J}KJK}}
	@K@L`@}P}eKJ{}zJ{}z
	@K@L`@}e}KK}{J{}{
M]	@K@L`@{}}KJK}J}KJK}J}KJK}J}KJK}}
	@K@L`@}P}eKJ{}zJ{}z
	@K@L`@}e}KK}{J{}{
M]	@K@L`@{}}KJK}J}KJK}J}KJK}J}KJK}}
	@K@L`@}P}eKJ{}zJ{}z
	@K@L`@}e}KK}{J{}{
M]	@K@L`@{}}KJK}J}KJK}J}KJK}J}KJK}}
	@K@L`@}eKJ{}z
	@K@L`@}e}KK}{J{}{
M]	@K@L`@{}}KJK}J}KJK}J}KJK}J}KJK}}
	@K@L`@}eKJ{}z
	@K@L`@}e}KK}{J{}{
M]	@K@L`@{}}KJK}J}KJK}J}KJK}J}KJK}}
M]	@@@@K
	@@@K
M]	@K@L`@}KJ{}}{J{}
	@@@K
	@K@L`@}}KJ{}}{J{}J{}}{J{}
	@@@M]
	@K@L`@K
	@@@M]
	@^@L`@{
	@^@@{@L`@{
	@@@^
M]	@@@K
	@@@K
	@K@L`@K
	@K@L`@K
	@K@L`@K
	@@@M]
	@@@M]
	@@@M]
	@@@M]
M]	@K@L`@{
	@@@K
M]	@K@L`@KP
	@@@K
M]	@K@L`@K
	@@@K
M]	@K@L`@Ke
	@@@K
	@K@L`@KK
	@@@M]
	@K@L`@K
M]	@K@L`@K
	@@@K
M]	@K@L`@}KJK}{
	@@@K
	@^@L`@{
	@^@@{@L`@{
	@^@@{@L`@{
	@@@^
	@@
', (@ARGV == 1 && lc($ARGV[0]) eq 'list' ? (\*STDOUT) : ()), 'nobug', 'opt';
(@ARGV != 1 or lc($ARGV[0]) ne 'list') and rpn(\&in);

sub in {
    if ($use_readkey) {
	ReadKey(0);
    } else {
	if ($kbuff eq '') {
	    chomp($kbuff = <STDIN>);
	}
	my $k = substr($kbuff, 0, 1);
	$kbuff = substr($kbuff, 1);
	return $k;
    }
}

