#!perl -l
#-----------------------------------------------------------------#
#  Calculator
#  pudge
#  Duplicate Mac OS Calculator DA in MacPerl
#
#  Created:       Chris Nandor (pudge@pobox.com)         19-Mar-98
#  Last Modified: Chris Nandor (pudge@pobox.com)         20-Mar-98
#-----------------------------------------------------------------#
#  Why?  Because I can.
#-----------------------------------------------------------------#
use Mac::Events;
use Mac::QuickDraw;
use Mac::Windows;
use Mac::Fonts;
use Mac::Menus;
use Mac::Resources;
use Mac::Memory;
use Math::BigFloat;
use strict;
my($res, $menu, $smenu1, $smenu2, $win, %d, %b, %e, %i, $val, $vals, $op);
++$|;

#=================================================================
%d = (
	winr	=> OffsetRect(Rect->new( 0,  0, 104, 148), 50, 50),
	wrect	=>            Rect->new( 0,  0, 104, 148),
	irect	=>            Rect->new( 0,  0, 102, 146),
	brect	=>            Rect->new( 0,  0,  18,  16),
	hrect	=>            Rect->new( 0,  0,  40,  16),
	vrect	=>            Rect->new( 0,  0,  18,  38),
	trect	=> OffsetRect(Rect->new( 0,  0,  86,  20),  7,  7),
	textp	=> [88, 21],
	c0		=> new_color(    0,     0,     0),
	c7		=> new_color(65535, 65535, 65535),	# white
	c1		=> new_color(48059, 48059, 48059),	# grey
	c2		=> new_color(65535,     0,     0),	# red
	c3		=> new_color(65535, 65535,     0),	# yellow
	c4		=> new_color(    0, 65535,     0),	# green
	c5		=> new_color(    0,     0, 65535),	# blue
	c6		=> new_color(65535,     0, 65535),	# violet
	c8		=> new_color(17476, 17476, 17476),	# dark grey
	c9		=> new_color(13107, 26214, 26214),	# aqua
	c10		=> new_color(    0,     0, 30583),	# dark blue
	c11		=> new_color(26214, 13107, 39321),	# purple
	c12		=> new_color(39321,     0,     0),	# dark red
	c13		=> new_color(65535, 39321,     0),	# orange
);

%i = (
	'C'		=> [  8,  32],	'4'		=> [  8,  76],	'7'		=> [  8,  54],
	'='		=> [ 30,  32],	'5'		=> [ 30,  76],	'8'		=> [ 30,  54],
	'/'		=> [ 52,  32],	'6'		=> [ 52,  76],	'9'		=> [ 52,  54],
	'*'		=> [ 74,  32],	'-'		=> [ 74,  54],	'= '	=> [ 74,  98],
	'1'		=> [  8,  98],	'+'		=> [ 74,  76],
	'2'		=> [ 30,  98],	'0'		=> [  8, 120],
	'3'		=> [ 52,  98],	'.'		=> [ 52, 120],
);

foreach (keys %i) {
	if ($_ eq '= ') {
		$b{$_}{'r'} = OffsetRect($d{vrect}, @{$i{$_}});
		$b{$_}{'o'} = OffsetRect($d{vrect}, ${$i{$_}}[0]+2, ${$i{$_}}[1]+2);
		$b{$_}{'t'} = [ ${$i{$_}}[0] + 6, ${$i{$_}}[1] + 34 ];
	} elsif ($_ eq '0') {
		$b{$_}{'r'} = OffsetRect($d{hrect}, @{$i{$_}});
		$b{$_}{'o'} = OffsetRect($d{hrect}, ${$i{$_}}[0]+2, ${$i{$_}}[1]+2);
		$b{$_}{'t'} = [ ${$i{$_}}[0] + 6, ${$i{$_}}[1] + 12 ];
	} else {
		$b{$_}{'r'} = OffsetRect($d{brect}, @{$i{$_}});
		$b{$_}{'o'} = OffsetRect($d{brect}, ${$i{$_}}[0]+2, ${$i{$_}}[1]+2);
		$b{$_}{'t'} = [ ${$i{$_}}[0] + 6, ${$i{$_}}[1] + 12 ];
	}
	$b{$_}{'d'} = [$b{$_}{'r'}->left(), $b{$_}{'r'}->top(),
					$b{$_}{'r'}->right(), $b{$_}{'r'}->bottom()];
}

$d{bbc} = $d{c0};
$d{bgc} = $d{c1};
$res = OpenResFile($0);
die $^E if !$res;

$menu = MacMenu->new(2048, 'Calculator', (
	['Indicator Color', sub{}, chr(27), chr(230)],
	['Window Color', sub{}, chr(27), chr(231)],
	['Default Colors', \&menu_hit, 'M'],
	[],
	['Close', \&menu_hit, 'W'],
	['Quit', \&menu_hit, 'Q'],
));
$smenu1 = MacHierMenu->new(230, 'Indicator Color', (
	['Grey', \&menu_hit, undef, undef, 463],
	['Red', \&menu_hit, undef, undef, 465],
	['Yellow', \&menu_hit, undef, undef, 464],
	['Green', \&menu_hit, undef, undef, 461],
	['Blue', \&menu_hit, undef, undef, 462],
	['Violet', \&menu_hit, undef, undef, 460],
));
$smenu2 = MacHierMenu->new(231, 'Window Color', (
	['Dark Grey', \&menu_hit, undef, undef, 450],
	['Aqua', \&menu_hit, undef, undef, 451],
	['Dark Blue', \&menu_hit, undef, undef, 452],
	['Purple', \&menu_hit, undef, undef, 453],
	['Dark Red', \&menu_hit, undef, undef, 454],
	['Orange', \&menu_hit, undef, undef, 455],
));

#=================================================================
$win = MacWindow->new(NewCWindow($d{winr}, 'Calculator', 1, rDocProc(), 1));
$win->sethook('redraw', \&draw_win);
$win->sethook('click', \&get_click);
$win->sethook('key', \&get_key);
$menu->insert();
$smenu1->insert();
$smenu2->insert();

while ($win->window()) {
	WaitNextEvent();
}

#=================================================================
sub menu_hit {
	my($m, $v) = @_;
	if ($m == $menu->{id} && ($v == 5 || $v == 6)) {
		$win->dispose();
	} elsif ($m == $menu->{id} && $v == 3) {
		$d{bbc} = $d{c0};
		$d{bgc} = $d{c1};
		$win->redraw();
		for (1..6) {
			CheckItem($smenu1->{menu}, $_, 0);
			CheckItem($smenu2->{menu}, $_, 0);
		}
	} elsif ($m == $smenu1->{id} && $v >= 1 && $v <= 6) {
		$d{bbc} = $d{'c' . $v};
		$win->redraw();
		for (1..6) {
			CheckItem($smenu1->{menu}, $_, 0);
		}
		CheckItem($smenu1->{menu}, $v, 1);
	} elsif ($m == $smenu2->{id} && $v >= 1 && $v <= 6) {
		$d{bgc} = $d{'c' . ($v + 7)};
		$win->redraw();
		for (1..6) {
			CheckItem($smenu2->{menu}, $_, 0);
		}
		CheckItem($smenu2->{menu}, $v, 1);
	}
	redo_trect('What ugly colors!')
	  if ($d{bgc} eq $d{c11} && $d{bbc} eq $d{c2});
	1;
}

#=================================================================
sub get_click {
	my($w, $p, $k, $f, $d) = @_;
	my($ph, $pv) = ($p->h(), $p->v());
	foreach (keys %i) {
		if (is_point($ph, $pv, $b{$_}{'d'})) {
			$k = $_;
		}
	}
	return if !defined($k);
	while (WaitMouseUp()) {
		$p = GetMouse();
		($ph, $pv) = ($p->h(), $p->v());
		$d = is_point($ph, $pv, $b{$k}{'d'});
		if (!$f && $d) {
			but_down($k);
			$f++;
		} elsif ($f && !$d) {
			but_up($k);
			$f--;
		}
		WaitNextEvent();
	}
	$p = GetMouse();
	($ph, $pv) = ($p->h(), $p->v());
	but_up($k);
	if (is_point($ph, $pv, $b{$k}{'d'})) {
		redo_trect(calculate($k));
	}
}

#=================================================================
sub get_key {
	my($win, $v, $k) = @_;
    my($mod) = $Mac::Events::CurrentEvent->modifiers();
	if ($v =~ /^(?:99|67|27)$/) {
		$k = 'C';
	} elsif ($v =~ /^(?:3|13|61)$/) {
		$k = '='; #[46-57] 42|43|45
	} elsif ($v =~ /^(?:4[2-35-9]|5[0-7])$/) {
		$k = chr($v);
	}
	if (defined($k)) {
		but_down($k);
		WaitNextEvent();
		but_up($k);
		redo_trect(calculate($k));
#	} else {
#		print "\007";
	}
}

#=================================================================
sub calculate {
	my($k, $q) = @_;
	if ($k =~ /[\d.]/ || ($k =~ /\-/ && (!defined($val) && !defined($vals)))) {
		$q = $val .= $k;
	} elsif ($k eq 'C') {
		undef $val;
		undef $vals;
		undef $op;
		$q = 0;
	} elsif ($k =~ /[\+\-\/\*\=]/) {
		if (defined($vals) && defined($val) && defined($op)) {
			if ($op eq '/' && $val == 0) {
				$q = 'not a number';
				undef $val;
				undef $vals;
				undef $op;
			} else {
				my($v) = eval("$vals $op $val");
				undef $val;
				$q = $vals = $v;
			}
		} elsif (defined($val)) {
			$vals = $val;
			undef $val;
			$q = $vals;
		} else {
			$q = $vals;
		}
		if ($k =~ /\=/) {
			$vals = $q;
			undef $val;
			undef $op;
		} else {
			$op = $k;
		}
	}
	print_num($q);
}

#=================================================================
sub print_num {
	my($q) = @_;
	$q = 0 if $q == 0;
	if (abs($q) >= 10**12 || ($q != 0 && 1/abs($q) >= 10**9)) {
#		print "1a $q";
		$q = Math::BigFloat->new($q)->fround(9);
		$q =~ s/\+//g;
#		print "1b $q";
	} else {
		$q =~ /^(-?[0-9]+)/;
		my($len) = 11 - length($1);
		$len = 0 if $len < 0;
#		print "2a $q";
		$q = sprintf("%11.${len}f", $q);
		if ($q =~ /\./) {$q =~ s/0*$//}
		$q =~ s/\.$//;
#		print "2b $q";
	}
	$q;
}

#=================================================================
sub redo_trect {
	my($v) = @_;
	EraseRect($d{'trect'});
	FrameRect($d{'trect'});
	MoveTo(${$d{'textp'}}[0] - StringWidth($v), ${$d{'textp'}}[1]);
	DrawString($v);
}

#=================================================================
sub but_up {
	my($k) = @_;
	RGBForeColor($d{bbc});
	PaintRect($b{$k}{'o'});
	RGBForeColor($d{c7});
	PaintRect($b{$k}{'r'});
	RGBForeColor($d{c0});
	FrameRect($b{$k}{'r'});
	MoveTo(@{$b{$k}{'t'}});
	DrawString($k);
}

#=================================================================
sub but_down {
	my($k) = @_;
	RGBForeColor($d{bbc});
	PaintRect($b{$k}{'o'});
	RGBForeColor($d{c0});
	PaintRect($b{$k}{'r'});
	RGBForeColor($d{c7});
	MoveTo(@{$b{$k}{'t'}});
	DrawString($k);
}

#=================================================================
sub draw_win {
	TextFont(geneva());
	TextFace(normal());
	TextSize(9);

	PaintRect($d{wrect});
	RGBForeColor($d{bgc});
	PaintRoundRect($d{irect}, 8, 8);

	RGBForeColor($d{bbc});
	foreach (keys %i) {
		PaintRect($b{$_}{'o'});
	}

	RGBForeColor($d{c7});
	PaintRect($d{'trect'});
	foreach (keys %i) {
		PaintRect($b{$_}{'r'});
	}

	RGBForeColor($d{c0});
	FrameRect($d{'trect'});
	foreach (keys %i) {
		FrameRect($b{$_}{'r'});
		MoveTo(@{$b{$_}{'t'}});
		DrawString($_);
	}
	redo_trect(defined($val) ? print_num($val) :
		defined($vals) ? print_num($vals) : 0);
}

#=================================================================
sub new_color {
	bless \pack('SSS', @_[0..2]), 'RGBColor';
}

#=================================================================
sub is_point {
	my($ph, $pv, $r) = @_;
	$ph > $$r[0] && $ph < $$r[2] &&
	$pv > $$r[1] && $pv < $$r[3];
}

#=================================================================
END {
	$smenu1->dispose() if defined($smenu1);
	$smenu2->dispose() if defined($smenu2);
	$menu->dispose() if defined($menu);
	$win->dispose() if defined($win);
	CloseResFile(CurResFile()) if $res;
}
#=================================================================
__END__