#!/usr/bin/perl

# Strict;
use strict;
use warnings;


# User-defined
my $pshapes = [
    [ 'Choose shape' => "" ],
    [ 'triangle'     => "80,100,60:360,-120x2" ],
    [ 'square'       => "100,100,90:320,-90x3" ],
    [ 'pentagon'     => "100,290,36:200,-72x4" ],
    [ 'hexagon'      => "80,250,60:180,-60x5"  ],
];


# Libraries
use File::Basename;
use Data::Dumper;
use Tk;


# Globals
my $shape = "";        # Algorithm for drawing shape
my $ppoints = [ ];     # Point data ( [x0, y0, x1, y1, id] )
my $mw = "";           # Main Window object
my $cv = "";           # Canvas object
my $cvfr = "";         # Canvas frame


####################
### Main program ###
####################
create_gui();


###################
### Subroutines ###
###################
sub create_gui {
    my $ver = $Tk::VERSION;
    $mw = new MainWindow(-title => "Shape chooser (Tk version $ver)");
    my $f1 = $mw->Frame()->pack(-expand => '0', -fill => 'x');
    $cvfr = $mw->Frame()->pack(-expand => '1', -fill => 'both');
    my $b1 = $f1->Button(-text => 'Exit (Esc)', -bg => 'skyblue');
    $b1->configure(-command => sub { $mw->destroy() });
    $b1->pack(-side => 'right');
    $mw->bind("<Escape>" => sub { $b1->invoke() });
    my $om = $f1->Optionmenu(-options => $pshapes, -variable => \$shape);
    $om->pack(-side => 'left');
    my $fr = $f1->Frame()->pack(-side => 'left');
    $fr->Label(-text => ' Shape: ')->pack(-side => 'left');
    my @vopts = (-validate => 'focusout', -validatecommand => \&new_shape);
    my $en = $fr->Entry(-width => 50, -textvar => \$shape, @vopts);
    $en->pack(-side => 'left');
    $cv = $cvfr->Canvas(-bg => 'black', -height => 512, -width => 512);
    $cv->pack();
    MainLoop;
}


sub new_shape {
    print "\nChanging shape...\n";

    # Clear canvas
    foreach my $ppoint (@$ppoints) {
        my $id = $ppoint->[-1];
        $cv->delete($id);
    }

    $ppoints = draw_shape($shape);

    # Anomoly #1
    #
    # Uncommenting the following line allows only ONE shape to be drawn!??
    #
    # $mw->update;

    # Anomoly #2
    #
    # Uncommenting the following line makes everything suddenly work!??
    #
    # printf "TFD> ppoints => %s\n", Dumper($ppoints);
}


sub draw_shape {
    my ($shapestr) = @_;

    my $pnewpoints = [ ];
    my @shapeargs = split(',', $shapestr);
    printf "Shape args [%s]\n", Dumper([@shapeargs]);

    my $pargs = [ -fill => 'pink', -width => 2 ];

    if (@shapeargs > 1) {
        my $x = my $x0 = shift @shapeargs;
        my $y = my $y0 = 512 - shift @shapeargs;
        my ($r, $q);

        for (@shapeargs) {
            if ($_ eq '+') {
                my @pts = ($x, $y, $x0, $y0);
                my $ppoint = [ @pts, $cv->createLine(@pts, @$pargs) ];
                push @$pnewpoints, $ppoint;
                last;
            }

            my ($ang, $sep, $N) = /(-?\d+)([:x]?)(-?\d+)?/;
            ($sep eq ':') and ($N,$r) = (1,$N);
            $N ||= 1;
            while ($N--) {
                $q += $ang;

                my $newq = (180 + $q) / 57.2957;
                my ($dx, $dy) = ($r * cos($newq), $r * sin($newq));
                my ($x1, $y1) = ($x - $dx, $y + $dy);
                my @pts = ($x, $y, $x1, $y1);
                my $ppoint = [ @pts, $cv->createLine(@pts, @$pargs) ];
                push @$pnewpoints, $ppoint;
                ($x, $y) = ($x1, $y1);
            }
        }
    }

    $mw->update();
    return $pnewpoints;
}