#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::WorldCanvas;
require Tk::Dialog;
use Graphics::ColorNames;
use Math::Trig;

# define our color set
my $colors = Graphics::ColorNames->new( 'HTML' );
my %colors = %{ $colors->{SCHEMES}[0] };
delete $colors{fuscia};    # this is the misspelling of fuschia
delete $colors{black};     # color of our axes
delete $colors{white};     # kind of hard to see
delete $colors{silver};    # kind of hard to see
delete $colors{gray};      # kind of hard to see
my @colors = keys %colors; # array of colors for the lines
my $maxcolors = @colors;   # mod the line count with this later

my @IDs; # store line IDs so that we can delete them without removing axes

# main window
my $top = new MainWindow(-width => 800, -height => 600, -title => 'Graphing Calculator');

# dialog box for error messages
my $d = $top->DialogBox(-title => "Calculation Error", -buttons => ["OK"]);

# scrolled worldcanvas
# left mouse click zooms in, middle mouse click centers, right mouse click zooms out
my $cvs = $top->Scrolled('WorldCanvas', -scrollbars => 'se', -width => 800, -height => 550);
$cvs->CanvasBind('<1>' => sub { $cvs->zoom(1.25) });
$cvs->CanvasBind('<3>' => sub { $cvs->zoom(0.8) });
$cvs->CanvasBind('<2>' => sub { $cvs->CanvasFocus; $cvs->center($cvs->eventLocation) });

# normal canvas with labels and text entries
my $frm = $top->Canvas(-width => 800, -height => 20);
my $txt_txt = $frm->Label(-text => 'Expression');
my $txt = $frm->Entry(-width => 40);
my $min_txt = $frm->Label(-text => 'X Min');
my $min = $frm->Entry(-width => 5);
my $max_txt = $frm->Label(-text => 'X Max');
my $max = $frm->Entry(-width => 5);
my $stp_txt = $frm->Label(-text => 'Step');
my $stp = $frm->Entry(-width => 5 );
my $redraw = $frm->Button(-text => 'Redraw Axes', -command => [ \&axes ]);
my $clr = $frm->Button(-text => 'Clear', -command  => [ sub { $cvs->delete(@IDs); @IDs = (); } ]);

# bind the enter key to call the evaluate subroutine
$txt->bind('<KeyPress-Return>', [ \&evaluate ]);

# form up
$frm->pack(-side => 'bottom');
$min_txt->pack(-side => 'left');
$min->pack(-side => 'left');
$max_txt->pack(-side => 'left');
$max->pack(-side => 'left');
$stp_txt->pack(-side => 'left');
$stp->pack(-side => 'left');
$redraw->pack(-side => 'left');
$txt_txt->pack(-side => 'left');
$clr->pack(-side => 'right');
$txt->pack(-side => 'right');
$cvs->pack(-side => 'top');

# preload our text boxes
$min->insert(0, "0");
$max->insert(0, "100");
$stp->insert(0, "1");

axes();

MainLoop;

sub evaluate {
  my $text = $txt->get();
  my $func = lc $text;
  $func =~ s/(\d+)(pi|x)/$1 * $2/g;
  $func =~ s/([xy])/\$$1/g;
  $func =~ s/\^/**/g;
  my $mini = $min->get();
  my $maxi = $max->get();
  my $step = $stp->get();

  # what's our new color?
  my $color = $colors->hex($colors[@IDs % $maxcolors], '#');

  my @errors;
  my @points;

  for ( my $i = $mini ; $i <= $maxi ; $i += $step ) {
    my $y = 0;
    my $x = $i;
    eval "$func";
    if ($@) { # do we have an eval error?
      # strip the ' at (eval XXX) line XXX' part of the error
      $@ =~ s/ at \(eval \d+\) line \d+//;
      push @errors, "$@\n";
    }

    # only graph real points
    if ( $y =~ /i/ ) {
      push @errors, "Calculation '$text' resulted in y containing an imaginary number.";
    } else {
      push @points, $x, $y;
    }
  }

  if ( @errors ) {
    # create dialog box with errors
    # if there are more than 5, only show the first one

    my $errors = @errors;
    my $msg;
    if ( @errors > 5 ) {
      $msg = "Showing only the first of $errors errors:\n$errors[0]";
    } else {
      $msg = join( "\n", @errors );
    }
   
    my $DialogRef = $top->Dialog(
      -title          => 'Calculation Error',
      -text           => $msg,
      -bitmap         => 'warning',
      -buttons        => [ 'OK' ],
    );

    my $selected = $DialogRef->Show(); # I don't use $selected but may in the future
  } else {
    # no errors

    # create the line and grab the ID
    my $ID = $cvs->createLine( @points, -smooth => 1, -fill => $color );

    # keep track of all IDs so that we can delete them
    push( @IDs, $ID );

    $cvs->viewFit( @IDs );
  }
}

sub axes {
  $cvs->delete('all');

  my $minx = $min->get();
  my $maxx = $max->get();
  my $step = $stp->get();
  my $tick = (abs($minx) + abs($maxx)) / 10;
  my $maxi = 2 * $maxx;
  my $mini = -$maxi;
  my $scale = 10 * $step / $tick;
  $cvs->createLine($mini, 0, $maxi, 0);
  $cvs->createLine(0, $mini, 0, $maxi);

  for ( my $i = $mini; $i <= $maxi; $i += $tick ) {
    $cvs->createLine($i, -$scale, $i,  $scale);
    $cvs->createLine(-$scale, $i,  $scale, $i);
  }
}