#!/afs/athena/contrib/perl5/perl

use Tk;

my $win = MainWindow->new;
my $graph = MainWindow->new;

my $c = $win->Canvas(-height => 310, -width => 310);
my $g = $graph->Canvas(-height => 310, -width => 310);

$c->pack();
$g->pack();

$g->create(line, 0, 267, 310, 267);
$label = $g->create(text, 225, 50, -text => "");

$c->create(line, 100, 100, 100, 200, -fill => "purple");
$c->create(line, 200, 100, 200, 200, -fill => "purple");
$c->create(line, 100, 100, 200, 100, -fill => "purple");
$c->create(line, 100, 200, 200, 200, -fill => "purple");

for $i (1..$ARGV[0]) {
    $atom = new Atom;
    ${$atom}{'x'} = $x = 10+int(rand(10));
    ${$atom}{'y'} = $y = 10+int(rand(10));
    ${$atom}{'dir'} = $dir = int(rand(4));
next if($lattice[$x][$y][$dir]);
    ${$atom}{'obj'} = $c->create(oval, (10*${$atom}{'x'}), (10*${$atom}{'y'}), 
                                 (10*${$atom}{'x'})+10, 
                                 (10*${$atom}{'y'})+10, -fill => "red");
$lattice[$x][$y][$dir] = $atom;
push(@atoms, $atom);
}


$nat = $#atoms+1;
print("Running with $nat actual atoms\n");
$g->create(text, 225, 60, -text => "11% expected");
$c->update;
while(1){
    &check_collisions;
    &advance;
    $c->update;
    $g->update;
    &graphdensity;
}
MainLoop;

sub advance {
    @xplus = @xminus = @yplus = @yminus = ();
    foreach $a (@atoms){
	undef $lattice[$$a{'x'}][$$a{'y'}][$$a{'dir'}];
	if($collision{$a}){
	    $c->itemconfigure($$a{'obj'}, -fill => "blue");
	    if($collision{$a}++ >1){
		$collision{$a} = 0;
	    }
	}
	else{
	    $c->itemconfigure($$a{'obj'}, -fill => "red");
	}
	if($$a{'dir'} == 0){
	    if($$a{'x'} == 30){
		$$a{'x'} = 0;
		$c->coords($$a{'obj'}, 0, 10*$$a{'y'}, 10, (10*$$a{'y'})+10);
	    }
	    else{
		$$a{'x'}++;
		push(@xplus, $$a{'obj'});
	    }
	}
	elsif($$a{'dir'} == 2){
	    if($$a{'x'} == 0){
		$$a{'x'} = 30;
		$c->coords($$a{'obj'}, 300, 10*$$a{'y'}, 310, (10*$$a{'y'})+10);
	    }
	    else{
		$$a{'x'}--;
		push(@xminus, $$a{'obj'});
	    }
	}
	elsif($$a{'dir'} == 1){
	    if($$a{'y'} == 0){
		$$a{'y'} = 30;
		$c->coords($$a{'obj'}, 10*$$a{'x'}, 300, (10*$$a{'x'})+10, 310);
	    }
	    else{
		$$a{'y'}--;
		push(@yminus, $$a{'obj'});
	    }
	}
	elsif($$a{'dir'} == 3){
	    if($$a{'y'} == 30){
		$$a{'y'} = 0;
		$c->coords($$a{'obj'}, 10*$$a{'x'}, 0, (10*$$a{'x'})+10, 10);
	    }
	    else{
		$$a{'y'}++;
		push(@yplus, $$a{'obj'});
	    }
	}
	$newlattice[$$a{'x'}][$$a{'y'}][$$a{'dir'}] = $a;
	    }
    @lattice = @newlattice;
    foreach $at (@xplus){
	$c->move($at, 10, 0);
    }
    foreach $at (@xminus){
	$c->move($at, -10, 0);
    }
    foreach $at (@yplus){
	$c->move($at, 0, 10);
    }
    foreach $at (@yminus){
	$c->move($at, 0, -10);
    }
}

sub check_collisions {
    for $x (0..30){
	for $y (0..30) {
    if($lattice[$x][$y][0] && $lattice[$x][$y][2] &&
       !($lattice[$x][$y][1] || $lattice[$x][$y][3])){
	$a = $lattice[$x][$y][0];
	$b = $lattice[$x][$y][2];
	${$a}{'dir'} = 1;
	${$b}{'dir'} = 3;
        undef $lattice[$x][$y][0];
        undef $lattice[$x][$y][2];
        $lattice[$x][$y][1] = $a;
        $lattice[$x][$y][3] = $b;
	$collision{$a} = 1;
	$collision{$b} = 1;
	next;
    }

    if($lattice[$x][$y][1] && $lattice[$x][$y][3] &&
       !($lattice[$x][$y][2] || $lattice[$x][$y][0])){
	$a = $lattice[$x][$y][1];
	$b = $lattice[$x][$y][3];
	${$a}{'dir'} = 2;
	${$b}{'dir'} = 0;
        undef $lattice[$x][$y][1];
        undef $lattice[$x][$y][3];
        $lattice[$x][$y][2] = $a;
        $lattice[$x][$y][0] = $b;
	$collision{$a} = 1;
	$collision{$b} = 1;
    }
}
}
}

sub graphdensity {
    $max = 150;
    $pop=0;
    $time++;
    for $cx (10..20){
	for $cy (10..20){
	    for $d (0..3) {
		$pop++ if $lattice[$cx][$cy][$d];
	    }
	}
    }
    $poppct = int(100*$pop/$nat);
    $g->itemconfigure($label, -text => "$poppct% in box");
    $pop = (300-((300/($#atoms+1))*$pop));
    if($#gp > $max){
	foreach $gp (@gp){
	    $g->move($gp, -2, 0);
	}
	$dme = shift(@gp);
	$g->delete($dme);
	$time = $max;
    }
    $g->coords($label, ($time*2)+25 +(($time > ($max*.8)? -50:0 )), $pop-50);
    push(@gp, $g->create(oval, $time*2, $pop, ($time*2)+2, $pop+2));
}

package Atom;

sub new { bless {} }