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

srand;
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, -fill => "red");
$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");

if($ARGV[0] eq "full"){
    $full = 1;
    shift(@ARGV);
}
if($ARGV[0] eq "noupdate"){
    $noupdate = 1;
    shift(@ARGV);
}

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

$nat = $#atoms+1;
print("Running with $nat actual atoms\n");
$nexp = int($nat/9);
$g->create(text, 225, 60, -text => "11% expected");
$c->update;
while(1){
    $rotdir = ($rotdir==1) ? -1:1;
    &check_collisions;
    &advance;
    &graphdensity;
    $c->update;
    $g->update;
}
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){
	    $$a{'x'}++;
	}
	elsif($$a{'dir'} == 3){
	    $$a{'x'}--;
	}
	elsif($$a{'dir'} == 1){
	    if($$a{'y'}%2 != 0){
		$$a{'x'}++;
	    }
	    $$a{'y'}--;
	}
	elsif($$a{'dir'} == 2){
	    if($$a{'y'}%2 == 0){
		$$a{'x'}--;
	    }
	    $$a{'y'}--;
	}
	elsif($$a{'dir'} == 4){
	    if($$a{'y'}%2 == 0){
		$$a{'x'}--;
	    }
	    $$a{'y'}++;
	}
	elsif($$a{'dir'} == 5){
	    if($$a{'y'}%2 != 0){
		$$a{'x'}++;
	    }
	    $$a{'y'}++;
	}


	# Check for overflows
	if($$a{'x'} == -1){
	    $$a{'x'} = 30;
	}
	elsif($$a{'x'} == 31){
	    $$a{'x'} = 0;
	}

	if($$a{'y'} == -1){
	    $$a{'y'} = 30;
	}
	elsif($$a{'y'} == 31){
	    $$a{'y'} = 0;
	}

	# Move the blob
	$c->coords($$a{'obj'}, (10*$$a{'x'})+(5*(($$a{'y'})%2)), (10*$$a{'y'}), (10*$$a{'x'})+(5*(($$a{'y'})%2))+10, (10*$$a{'y'})+10);
	$newlattice[$$a{'x'}][$$a{'y'}][$$a{'dir'}] = $a;
    }
    @lattice = @newlattice;
}

sub check_collisions {
    for $x (0..30){
	for $y (0..30) {
	    $ct = 0;
	    @col = ();
	    for $d (0..5){
		if ($lattice[$x][$y][$d]){
		    $ct++;
		    $col[$d]=1;
		}
	    }
	    if($ct == 2){
		for $d2 (0..2){
		    if($col[$d2] && $col[$d2+3]){
			$a = $lattice[$x][$y][$d2];
			$b = $lattice[$x][$y][$d2+3];
			$$a{'dir'} = ($$a{'dir'}+$rotdir)%6;
			$$b{'dir'} = ($$b{'dir'}+$rotdir)%6;
			undef $lattice[$x][$y][$d2];
			undef $lattice[$x][$y][$d2+3];
			$lattice[$x][$y][$$a{'dir'}] = $a;
			$lattice[$x][$y][$$b{'dir'}] = $b;
			$collision{$a} = 1;
			$collision{$b} = 1;
		    }
		}
	    }
	    elsif($ct == 3){
		for $d2 (0..1){
		    if($col[$d2] && $col[$d2+2] && $col[$d2+4]){
			$a = $lattice[$x][$y][$d2];
			$b = $lattice[$x][$y][$d2+2];
			$e = $lattice[$x][$y][$d2+4];
			$$a{'dir'} = ($$a{'dir'}+1)%6;
			$$b{'dir'} = ($$b{'dir'}+1)%6;
			$$e{'dir'} = ($$e{'dir'}+1)%6;
			undef $lattice[$x][$y][$d2];
			undef $lattice[$x][$y][$d2+2];
			undef $lattice[$x][$y][$d2+4];
			$lattice[$x][$y][$$a{'dir'}] = $a;
			$lattice[$x][$y][$$b{'dir'}] = $b;
			$lattice[$x][$y][$$e{'dir'}] = $e;
			$collision{$a} = 1;
			$collision{$b} = 1;
			$collision{$e} = 1;
		    }
		}
	    }
	}
    }
}

sub graphdensity {
    $max = 150;
    $pop=0;
    $time++;
    for $cx (10..20){
	for $cy (10..20){
	    for $d (0..5) {
		$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 {} }