use Tk;

print PI;

$top = MainWindow->new;
$canvas = $top->Canvas(width => 300, height => 300)->pack(-expand=>'y', -fill=>'both');

$space = Space->new(canvas => $canvas);
for (1..10) {
    $machine = Machine->new;
    $space->add($machine, rand() * 300,rand() * 300);
}

MainLoop();

package Space;
use Carp;

sub new {
    my ($pkg, %args) = @_;
    bless { canvas => $args{canvas}, machines => {} }, $pkg;
}

sub add {
    my ($space, $machine, $x, $y) = @_;
    $space->{machines}{$machine} = $machine;
    $machine->_space($space, $x, $y);
}

sub canvas {
    my ($space) = @_;
    return $space->{canvas};
}

package Machine;
use Carp;
use Tk;
use constant PI => 3.1415926535;

sub new {
    my ($pkg, %args) = @_;
    bless { }, $pkg;
}

sub canvas {
    my ($machine) = @_;
    $machine->{space}->canvas;
}

sub _space {
    my ($machine, $space, $x, $y) = @_;
    @$machine{qw(space x y)} = ($space, $x, $y);
    my $canvas = $space->canvas;
    my $r = 30;
    my $body = $machine->{body} = $canvas->create('oval', $x-$r, $y-$r, $x+$r, $y+$r, -fill => 'yellow', -tags => ["$machine", "${machine}_body"]);
#    my $font = '-adobe-helvetica-medium-r-normal--10-100-75-75-p-46-*-1';
    my $body_text = $machine->{body_text} = $canvas->create('text', $x, $y, text=>'Machine', -fill => 'blue', -font => "Helvetica 12", -tags => ["$machine", "${machine}_body"]);
#    $canvas->addtag("$machine", withtag=>$body);
#    $canvas->addtag("$machine", withtag=>$body_text);
#    $canvas->addtag("${machine}_body", withtag=>$body);
#    $canvas->addtag("${machine}_body", withtag=>$body_text);
    my @nodes;
    for my $angle (map {$_*45} (0..7)) {
	my ($xc, $yc) = ($x + sin($angle*PI/180)*$r, $y - cos($angle*PI/180)*$r);
	my ($xtc, $ytc) = (sin($angle*PI/180), -cos($angle*PI/180));
	my $node;
	push @nodes, $node = $canvas->create('oval', $xc-5, $yc-5, $xc+5, $yc+5, -fill => 'red', -tags => ["$machine", "${machine}_node"]);

	my $anchor = (qw(s sw w nw n ne e se))[int (($angle+22.5) / 45) % 8];
	$node_text = $canvas->create('text', $x+$xtc*($r+7), $y+$ytc*($r+7), -text => 'node', -anchor => $anchor, -tags => ["$machine", "${machine}_node"]);
#	$canvas->bind($node, '<1>' => [\&_press_node, $machine, $node, $node_text, Ev('x'), Ev('y')]);
#	$canvas->bind($node, '<B1-Motion>' => [\&_drag_node, $machine, $node, $node_text, Ev('x'), Ev('y')]);
    }
    $machine->{nodes} = \@nodes;
    $canvas->bind("${machine}_body", '<1>' => [\&_press_body, $machine, Ev('x'), Ev('y')]);
    $canvas->bind("${machine}_body", '<B1-Motion>' => [\&_drag_body, $machine, Ev('x'), Ev('y')]);
}

sub _press_body {
    my ($ev, $machine, $x, $y) = @_;
    my $canvas = $machine->canvas;
    $canvas->raise("$machine", 'all');
    @$machine{qw(pressed_x pressed_y)} = ($x, $y);
    @$machine{qw(dragged_x dragged_y)} = (0, 0);
}

sub _drag_body {
    my ($ev, $machine, $x, $y) = @_;
    my ($pressed_x, $pressed_y) = @$machine{qw(pressed_x pressed_y)};
    my ($dragged_x, $dragged_y) = @$machine{qw(dragged_x dragged_y)};
    my ($dx, $dy) = ($x - ($pressed_x+$dragged_x), $y - ($pressed_y+$dragged_y));
    @$machine{qw(dragged_x dragged_y)} = ($dragged_x + $dx, $dragged_y + $dy);
    my $canvas = $machine->canvas;
    $canvas->move("$machine", $dx, $dy);
    @$machine{qw(x y)} = ($x, $y);
}