#!/usr/bin/perl -w

###############
## Libraries ##
###############
use strict;
use warnings;
use Math::Trig;
use Tk;


##################
## User-defined ##
##################
my $cw  = 768;
my $ch  = 512;
my $x1  = 40;
my $y1  = 40;
my $x2  = 250;
my $y2  = 250;
my $deg = 60;
my $ext = 45;



##################
## Main Program ##
##################
my @ids = ( );
my $top = MainWindow->new;
my $frm = $top->Frame()->pack(-fill => 'x');
my $can = canvas($top, $cw, $ch);

labent($frm, 'X1',     \$x1,   8);
labent($frm, 'Y1',     \$y1,   8);
labent($frm, 'X2',     \$x2,   8);
labent($frm, 'Y2',     \$y2,   8);
labent($frm, 'Start',  \$deg,  8);
labent($frm, 'Extent', \$ext,  8);

button($frm, 'Exit (Esc)',          'r', sub { exit },           'Escape');
button($frm, 'Clear Canvas (^L)',   'r', sub { clear_canvas() }, 'Control-l');
button($frm, 'Random Draw (Space)', 'r', sub { random_draw() },  'space');
button($frm, 'Draw Arc',            'r', sub { arrowed_arc() });
button($frm, 'Random Args',         'r', sub { random_args() });

MainLoop;


#################
## Subroutines ##
#################

sub canvas {
    my ($w, $width, $height) = @_;
    my $bg = 'peachpuff';
    my $can = $w->Canvas(-width => $width, -height => $height, -bg => $bg);
    $can->pack(-expand => 1, -fill => 'both');
    return $can;
}


sub labent {
    my ($w, $text, $s_var, $width) = @_;
    my @fargs = (-relief => 'groove', -borderwidth => 4);
    my @pargs = (-side   => 'left', -expand => 1, -fill => 'y');
    my $f    = $w->Frame(@fargs)->pack(@pargs);
    my $lbl  = $f->Label(-text => $text);
    my $ent  = $f->Entry(-textvar => $s_var, -width => $width);
    $lbl->pack($ent, -side => 'left');
    return [ $lbl, $ent ];
}


sub button {
    my ($f, $text, $side, $c_sub, $binding) = @_;
    my $btn = $f->Button(-text => $text, -bg => 'lightgreen');
    $btn->configure(-command => $c_sub);
    my $h_sides = {qw( l left r right t top b bottom )};
    exists($h_sides->{$side}) and $side = $h_sides->{$side};
    $btn->pack(-side => $side);
    ($binding || 0) and $top->bind("<$binding>" => sub { $btn->invoke });
    return $btn;
}


sub arrowed_arc {
    my @opts = ( -style => 'arc', -start => $deg, -extent => $ext );
    my $id1 = $can->createArc($x1, $y1, $x2, $y2, @opts);
    my $a_end   = getArcEnd($x1, $y1, $x2, $y2, $deg, $ext);
    my ($x, $y) = @$a_end;
    my $id2 = $can->createOval($x - 5, $y - 5, $x + 5, $y + 5, -fill => 'red');
    push @ids, $id1, $id2;
}


sub random_args {
    $x1  = random_value(0, $cw);
    $x2  = random_value(0, $cw);
    $y1  = random_value(0, $ch);
    $y2  = random_value(0, $ch);
    $deg = random_value(0, 360);
}


sub clear_canvas {
    foreach my $id (@ids) {
        $can->delete($id);
    }
    @ids = ( );
    $top->update;
}


sub random_draw {
    random_args();
    arrowed_arc();
}


sub random_value {
    my ($min, $max) = @_;
    my $rnd = int(rand($max - $min + 1)) + $min;
    return $rnd;
}


sub getArcEnd {
  my ($x, $y, $x2, $y2, $start, $extent) = @_;

  # $x, $y, $x2, $y2 can be the bounding box of an
  # ellipse (not just a circle) so calculate vertical
  # and horizontal radius separately

  my $radiusX = ($x2 - $x)/2;
  my $centerX = $x + $radiusX;
  my $radiusY = ($y2 - $y)/2;
  my $centerY = $y + $radiusY;

  # Tk expects the starting angle and length of the
  # arc (extent) to be in degrees but cos and sin expect
  # them in radian

  my $radians = deg2rad($start + $extent);

  # [ x coord of arc end point, y coord of arc end point ]
  # the coordinate system for Tk::Canvas makes "down"
  # positive so we need to subtract the Y component
  # rather than add it.

  return [ $centerX + $radiusX*cos($radians)
           , $centerY - $radiusY*sin($radians) ];
}