#!/usr/bin/perl -w

use strict;

use Fcntl;
use Errno qw(EWOULDBLOCK);

use Tk;

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

$top->fileevent(\*STDIN, "readable", \&readable);

MainLoop();

package Controller;

sub readable {
	my $line = <STDIN>;
	if (! defined $line) { exit(0); }
	chomp $line;
	my @words = split /\t/, $line, -1;
	my $command = shift @words;
	if ($command eq "create") {
		my $type = shift @words;
		if ($type eq "node") {
			
		}
		@words == 2 or die;
		my $node = Node->new(@words);
		print $node->id;
		print "new node\n";
	} elsif ($command eq "arc") {
		@words == 2 or die;
		my $arc = Arc->new(Node->by_id($words[0]), Node->by_id($words[1]));
		print $arc->id;
	}
}

package Node;

$Node::id = 1;

sub new {
	my ($package, $x, $y, $r) = @_;
	$r ||= 5;
	my $item = item => $canvas->create('oval', $x-$r, $y-$r, $x+$r, $y+$r, fill => 'yellow');
	my $self = bless {
		id => $Node::id++,
		x => $x,
		y => $y,
		r => $r,
		item => $item,
	}, $package;
	return $self;
}

sub id {
	my ($self) = @_;
	return $self->{id};
}


package Arc;

sub new {
}


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];
	my $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);
}