#!/usr/bin/perl -w

use strict;

my $rows = 0;
my $cols = 80;
my @src = ();
my @piecemap = ();

my $numpieces = 0;
my @minxs = ();
my @maxxs = ();
my @minys = ();
my @maxys = ();


my @startpieces = (); # pieces we could start with
my $startpiece = 0;  # index of piece to start with

my @pieces = ();
my @requiredconnections = ();

my $fieldwidth = 80;
my $fieldheight = 24;
my @field = ();

# flag to indicate placing the first piece
my $firstpiece = 1;

sub iscodechar {
  return $_[0] > 32 && $_[0] <= 126;
}

sub readsrc {
  my ($srcfile) = @_;
  open FILE, "<$srcfile" or die "couldn't open source file";

  my $y = 0;
  while (<FILE>) {
    my $line = $_;
    chomp $line;
    my @chars = split //, $line;

    my $x = 0;
    for my $char (@chars) {
      my $val = ord($char);
      if (!iscodechar($val) && $val != 32) { die "invalid char $val in source"; }
      $src[$y*$cols + $x] = $val;
      ++$x;
    }
    for ( ; $x<$cols; ++$x) { $src[$y*$cols + $x] = 32; }
    ++$y;
  }
  $rows = $y;

  close FILE;
}

# debug fn
sub printsrc {
  for (my $y = 0; $y<$rows; ++$y) {
    for (my $x = 0; $x<$cols; ++$x) {
      print chr($src[$y*$cols + $x]);
    }
    print "\n";
  }    
}

# debug fn
sub printpiecemap {
  for (my $y = 0; $y<$rows; ++$y) {
    for (my $x = 0; $x<$cols; ++$x) {
      print chr($piecemap[$y*$cols + $x] + 97);
    }
    print "\n";
  }    
}

sub newpiece {
  my $num = $numpieces++;
  $minxs[$num] = 999999;
  $maxxs[$num] = 0;
  $minys[$num] = 999999;
  $maxys[$num] = 0;

  return $num;
}

sub maybelabelcellas {
  my ($piecenum, $x, $y) = @_;
  if ($x < 0 || $x >= $cols ||
      $y < 0 || $y >= $rows) { return; }

  if (!iscodechar($src[$y*$cols+$x])) { return; } # is a space
  if ($piecemap[$y*$cols+$x] != -1) { return; }   # already a piece

  $piecemap[$y*$cols+$x] = $piecenum;

  if ($x < $minxs[$piecenum]) { $minxs[$piecenum] = $x; }
  if ($x > $maxxs[$piecenum]) { $maxxs[$piecenum] = $x; }
  if ($y < $minys[$piecenum]) { $minys[$piecenum] = $y; }
  if ($y > $maxys[$piecenum]) { $maxys[$piecenum] = $y; }

  maybelabelcellas($piecenum, $x+1, $y);
  maybelabelcellas($piecenum, $x-1, $y);
  maybelabelcellas($piecenum, $x, $y+1);
  maybelabelcellas($piecenum, $x, $y-1);
}

sub findpieces {

  # set the piecemap to -1's
  for (my $y = 0; $y<$rows; ++$y) {
    for (my $x = 0; $x<$cols; ++$x) {
      $piecemap[$y*$cols + $x] = -1;
    }
  }

  my $piecenum = 1;
  for (my $y = 0; $y<$rows; ++$y) {
    for (my $x = 0; $x<$cols; ++$x) {
      if (iscodechar($src[$y*$cols + $x]) &&
	  $piecemap[$y*$cols + $x] == -1) {

	# must be a new piece
      
	my $piecenum = newpiece();
	maybelabelcellas($piecenum, $x, $y);
      }
    }
  }    
  
}

sub copyoutpieces {
  for (my $i=0; $i<$numpieces; ++$i) {
    my $width = ($maxxs[$i] - $minxs[$i]) + 1;
    my $height = ($maxys[$i] - $minys[$i]) + 1;
    
    $requiredconnections[$i] = -1;

    $pieces[$i] = [ $width, $height ]; # $pieces[$i] is a ref to an array
    for (my $y=$minys[$i]; $y <= $maxys[$i]; ++$y) {
      for (my $x=$minxs[$i]; $x <= $maxxs[$i]; ++$x) {
	if ($src[$y*$cols + $x] == ord("@")) {
	  push @startpieces, $i;
	}
	if ($src[$y*$cols + $x] >= ord("0") && $src[$y*$cols + $x] <= ord("9")) {
	  if ($requiredconnections[$i] == -1) { $requiredconnections[$i] = 0; }
	  $requiredconnections[$i] += $src[$y*$cols + $x] - ord("0");
	}
	push @{$pieces[$i]}, $src[$y*$cols + $x];
      }
    }
    
    # default number of connections is 1
    if ($requiredconnections[$i] == -1) { $requiredconnections[$i] = 1; }
  }

  # no piece had an @ so we may start with any
  if (@startpieces == 0) { for (my $i=0; $i<$numpieces; ++$i) { push @startpieces, $i; } }
}

# debug fn
sub printpieces {
  for (my $i=0; $i<$numpieces; ++$i) {
    my @piece = @{$pieces[$i]};
    my $width = shift @piece;
    my $height = shift @piece;

    for (my $y = 0; $y<$height; ++$y) {
      for (my $x = 0; $x<$width; ++$x) {
	print chr($piece[$y*$width + $x]);
      }
      print "\n";
    }    
    print "\n";
  }
}

# array of refs to caches, one for each piece.  A cache is an array with the following for each square:
#  bit 0 : 0 = don't know if piece placed here would be adjacent to enough things
#          1 = would definitely not be adjacent to enough things
#  bit 1 : 0 = don't know if piece placed here would fit.
#              (fit meaning not overlap things or be next to wrong things)
#          1 = piece placed here would not fit.  (once this bit is set it will not be unset).

my @caches = ();
my @oksquaresincaches = (); # number of squares with zero in each cache

sub invalidatearound {
  # args passed in are the shape that has been placed - we need to mark anywhere around
  # it as being possibly adjacent to enough things now
  my ($xpos, $ypos, $width, $height) = @_;
  
  for (my $piecenum = 0; $piecenum < $numpieces; ++$piecenum) {
    
    # the area to invalidate is anywhere that this shape could
    # touch the one that was placed.
    my $pw = @{$pieces[$piecenum]}[0];
    my $ph = @{$pieces[$piecenum]}[1];
    my $startx = $xpos - $pw; if ($startx < 0) { $startx += $fieldwidth; }
    my $starty = $ypos - $ph; if ($starty < 0) { $starty += $fieldheight; }
    my $endx = $startx + $pw + $width + 1; # don't wrap these or loops could break
    my $endy = $starty + $ph + $height + 1; # don't wrap these or loops could break

    for (my $y=$starty; $y<$endy; ++$y) {
      for (my $x=$startx; $x<$endx; ++$x) {
	my $fx = $x % $fieldwidth;
	my $fy = $y % $fieldheight;
	if ($caches[$piecenum]->[$fy*$fieldwidth+$fx] == 1) { # if we're going to make it ok
	  ++$oksquaresincaches[$piecenum];
	}
	$caches[$piecenum]->[$fy*$fieldwidth+$fx] &= 2; # zero bit 0, preserve bit 1.
      }
    }    
  } 
}

sub initcaches {
  for (my $piecenum = 0; $piecenum < $numpieces; ++$piecenum) {
    $caches[$piecenum] = []; # ref to an array
    $oksquaresincaches[$piecenum] = 0;

    # a piece either can go anywhere, if doesn't need any connections,
    # or can go nowhere yet, if needs some.
    my $initval = 1;
    if ($requiredconnections[$piecenum] == 0) {
      $initval = 0;
      $oksquaresincaches[$piecenum] = $fieldheight * $fieldwidth;
    }

    for (my $y=0; $y<$fieldheight; ++$y) {
      for (my $x=0; $x<$fieldwidth; ++$x) {
	$caches[$piecenum]->[$y*$fieldwidth+$x] = $initval;
      }
    }
  }

  # pretend one square is adjacent to enough things, so that first piece can be placed
  my $startpos = int(rand($fieldwidth*$fieldheight));
  if ($caches[$startpiece]->[$startpos] != 0) {
    $caches[$startpiece]->[$startpos] = 0;
    ++$oksquaresincaches[$startpiece];
  }
}

sub cachedoesntfit {
  my ($piecenum, $x, $y) = @_;
  if ($caches[$piecenum]->[$y*$fieldwidth+$x] == 0) { --$oksquaresincaches[$piecenum]; }
  $caches[$piecenum]->[$y*$fieldwidth+$x] |= 2; # set bit 1
}

sub cacheunadjacent {
  my ($piecenum, $x, $y) = @_;
  if ($caches[$piecenum]->[$y*$fieldwidth+$x] == 0) { --$oksquaresincaches[$piecenum]; }
  $caches[$piecenum]->[$y*$fieldwidth+$x] |= 1; # set bit 0
}

sub okbycache {
  my ($piecenum, $pos) = @_;

  # if piece would not be adjacent to anything or would not fit with surroundings, it is not ok.
  if ($caches[$piecenum]->[$pos] != 0) { return 0; }

  # return 1 to indicate that it is OK as far as we can tell from cached info
  return 1;
}

sub leftof {
  my ($x, $y) = @_;
  if ($x == 0) { $x = $fieldwidth; }
  --$x;
  return $field[$y*$fieldwidth + $x];
}
sub rightof {
  my ($x, $y) = @_;
  return $field[$y*$fieldwidth + (++$x % $fieldwidth)];
}
sub above {
  my ($x, $y) = @_;
  if ($y == 0) { $y = $fieldheight; }
  --$y;
  return $field[$y*$fieldwidth + $x];
}
sub below {
  my ($x, $y) = @_;
  return $field[(++$y % $fieldheight) *$fieldwidth + $x];
}

sub checkpieceatpos {
  my ($piecenum, $xpos, $ypos) = @_;

  my @piece = @{$pieces[$piecenum]};
  my $width = shift @piece;
  my $height = shift @piece;

  my $conns = 0; # number of connections this piece will have if we put it here
  for (my $y = 0; $y < $height; ++$y) {
    for (my $x = 0; $x < $width; ++$x) {
      my $c = @piece[$y*$width+$x];

      if ($c == 32) { next; } # spaces can go anywhere

      my $fx = ($xpos + $x) % $fieldwidth;
      my $fy = ($ypos + $y) % $fieldheight;
      
      # can't go on top of things
      if ($field[$fy*$fieldwidth+$fx] != 32) { cachedoesntfit($piecenum, $xpos, $ypos); return 0; }

      my $adj = 0; # 1 if this char is adjacent to something
      # check adjacent things
      if (leftof($fx, $fy) != 32) {
	if (leftof($fx, $fy) != $c) { cachedoesntfit($piecenum, $xpos, $ypos); return 0; }
	$adj = 1;
      }
      if (rightof($fx, $fy) != 32) {
	if (rightof($fx, $fy) != $c) { cachedoesntfit($piecenum, $xpos, $ypos);return 0; }
	$adj = 1;
      }
      if (above($fx, $fy) != 32) {
	if (above($fx, $fy) != $c) { cachedoesntfit($piecenum, $xpos, $ypos); return 0; }
	$adj = 1;
      }
      if (below($fx, $fy) != 32) {
	if (below($fx, $fy) != $c) { cachedoesntfit($piecenum, $xpos, $ypos); return 0; }
	$adj = 1
      }
      if ($adj) { ++$conns; }
    }
  }
  if (!$firstpiece) {
    # pieces must have enough connections
    if ($conns < $requiredconnections[$piecenum]) {
      cacheunadjacent($piecenum, $xpos, $ypos);
      return 0;
    }
  }

  return 1;
}

sub placepieceatpos {
  my ($piecenum, $xpos, $ypos) = @_;

  my @piece = @{$pieces[$piecenum]};
  my $width = shift @piece;
  my $height = shift @piece;
  
  for (my $y = 0; $y < $height; ++$y) {
    for (my $x = 0; $x < $width; ++$x) {
      if ($piece[$y*$width+$x] == 32) { next; }

      my $fx = ($xpos + $x) % $fieldwidth;
      my $fy = ($ypos + $y) % $fieldheight;
      $field[$fy*$fieldwidth + $fx] = $piece[$y*$width+$x];
    }
  }

  invalidatearound($xpos, $ypos, $width, $height);
}

sub trypiece {
  my ($piecenum) = @_;

  for (;;) {
    my $numpossposns = $oksquaresincaches[$piecenum];
    if ($numpossposns == 0) { return 0; } # was no valid posn for this piece
    #print "$numpossposns\n";

    my $pos = 0;
    my $skip = int(rand($numpossposns)) + 1;
    # find the skip'th next untried position.
    for (my $i=0; $i<$skip; ++$i) {
      do { $pos = ($pos+1) % ($fieldwidth*$fieldheight); } until (okbycache($piecenum, $pos));
    }
    
    # try placing the piece.  Will become not ok in cache if didn't work
    if (checkpieceatpos($piecenum, $pos % $fieldwidth, int($pos / $fieldwidth))) {
      placepieceatpos($piecenum, $pos % $fieldwidth, int($pos / $fieldwidth));
      return 1;
    }
  }
  
  die "shouldn't get here";
  return 0;
}

sub step {
  my @triedpieces = ();
  for (my $i = 0; $i<$numpieces; ++$i) { $triedpieces[$i] = 0; }

  my $numtriedpieces = 0;
  while ($numtriedpieces < $numpieces) {
    my $i = 0;
    if ($firstpiece) { $i = $startpiece; }
    else { $i = int(rand($numpieces)); }
    if (!$triedpieces[$i]) {
      if (trypiece($i)) { $firstpiece = 0; return 1; }
      $triedpieces[$i] = 1;
      ++$numtriedpieces;
    }
  }
  
  # no piece fitted anywhere
  return 0;
}

sub printfield {
  for (my $y=0; $y<$fieldheight; ++$y) {
    for (my $x=0; $x<$fieldwidth; ++$x) {
      print chr($field[$y*$fieldwidth+$x]);
    }
    print "\n";
  }
}

sub interpret {

  # initialise the field to nulls
  for (my $y=0; $y<$fieldheight; ++$y) {
    for (my $x=0; $x<$fieldwidth; ++$x) {
      $field[$y*$fieldwidth+$x] = 32;
    }
  }

  $startpiece = $startpieces[int(rand(@startpieces))];
  initcaches();
  
  while (step()) {
    print "\f";    # form feed
    printfield();

    #sleep 1; # if it's too fast
  }
}

#### main

if (@ARGV != 1) { print STDERR "usage: clunk <filename>\n"; exit 1; }

readsrc("$ARGV[0]");
#printsrc();

findpieces();
#printpiecemap();

copyoutpieces();
#printpieces();

interpret();

exit 0;
