package Organism;
use strict;
use warnings;

# This seems to work fine and is a tiny bit faster
use integer;

# ----------------------------------------------------------------
# The Universe is modelled as a set of overlapping tiles.
# For background, see http://conwaylife.com/wiki/Life128_and_vlife
# We use a simple scheme of 64 x 64 tiles (60 x 60 core) with
# conventional tiling (each tile has eight neighbours).
# Alternatively 32 x 32 (28 x 28 core) are used with 32-bit integers.
# Note that this was chosen for simplicity; more efficient schemes
# are available, such as the "brick wall tiling" used by Goucher
# in later versions (apgmera, version 3)
# This code is loosely based on apgnano (version 2).
# ----------------------------------------------------------------
# SQUARE TILE
# Note: 64 x 64 square tiles require a perl built with 64-bit integers
# Choose tile size (32 or 64) automatically based on perl integer size:
use Config;
our $TILE_SIZE_FULL = $Config{ivsize} < 8 ? 32 : 64;
# ... or manually override by editing the next line
# $TILE_SIZE_FULL = 32;    # manually set to 32 or 64
# warn __PACKAGE__, ": using $TILE_SIZE_FULL x $TILE_SIZE_FULL tiles\n";

my $BM_MIDDLE      = 0x3ffffffc;
my $BM_LEFT        = 0xfffffffc;
my $BM_RIGHT       = 0x3fffffff;
my $BM_OUTER       = 0xc0000003;
my $BM_LEFTMIDDLE  = 0x30000000;
my $BM_RIGHTMIDDLE = 0x0000000c;
my $BM_FMT         = '%032b';
if ($TILE_SIZE_FULL == 64) {
   no warnings qw(portable overflow);
   $BM_MIDDLE      = 0x3ffffffffffffffc;
   $BM_LEFT        = 0xfffffffffffffffc;
   $BM_RIGHT       = 0x3fffffffffffffff;
   $BM_OUTER       = 0xc000000000000003;
   $BM_LEFTMIDDLE  = 0x3000000000000000;
   $BM_RIGHTMIDDLE = 0x000000000000000c;
   $BM_FMT         = '%064b';
}

my $BORDER_WIDTH       = 2;
my $BORDER_WIDTH_P1    = $BORDER_WIDTH + 1;
my $TILE_SIZE_FULL_M1  = $TILE_SIZE_FULL - 1;
my $TILE_SIZE_FULL_M2  = $TILE_SIZE_FULL - 2;
my $TILE_SIZE_MBD      = $TILE_SIZE_FULL - $BORDER_WIDTH;
my $TILE_SIZE_MBD_M1   = $TILE_SIZE_MBD - 1;
my $TILE_SIZE_CORE     = $TILE_SIZE_FULL - 2 * $BORDER_WIDTH;
my $TILE_SIZE_CORE_P1  = $TILE_SIZE_CORE + 1;

# Neighbours are numbered clockwise starting with the one directly above
my $NUM_NEIGH          = 8;
my $NUM_NEIGH_M1       = $NUM_NEIGH - 1;
my $NEIGH_TOP          = 0;
my $NEIGH_TOP_RIGHT    = 1;
my $NEIGH_RIGHT        = 2;
my $NEIGH_BOTTOM_RIGHT = 3;
my $NEIGH_BOTTOM       = 4;
my $NEIGH_BOTTOM_LEFT  = 5;
my $NEIGH_LEFT         = 6;
my $NEIGH_TOP_LEFT     = 7;
my $NEIGH_ANY          = 0xff;    # test if any neighbour is set
# Note that the i ^ 4 trick sets i to the opposite one, that is:
#   0 > 4  (TOP > BOTTOM)
#   1 > 5  (TOP RIGHT > BOTTOM LEFT)
#   2 > 6  (RIGHT > LEFT)
#   3 > 7  (BOTTOM RIGHT > TOP LEFT)
#   4 > 0  (BOTTOM > TOP)
#   5 > 1  (BOTTOM LEFT > TOP RIGHT)
#   6 > 2  (LEFT > RIGHT)
#   7 > 3  (TOP LEFT > BOTTOM RIGHT)

# Instead of a hashref, these list indices are slightly faster
my $Tx          = 0;
my $Ty          = 1;
my $Updateflags = 2;
my $Row         = 3;
my $Neighbours  = 4;

# The functions starting with st_ manipulate
# a simple $TILE_SIZE_FULL x $TILE_SIZE_FULL square tile bitmap.
# Note that $x and $y must be in 0..$TILE_SIZE_FULL-1 range.
# $row is a ref to an array of 64 unsigned 64-bit ints
#  ... or a ref to an array of 32 unsigned 32-bit ints.
# The value in row[] bitmap is 0 (dead) or 1 (alive).

sub st_getcellval {
   my ($row, $x, $y) = @_;
   # my $mask = 1 << ($TILE_SIZE_FULL_M1 - $x);
   # return $row->[$y] & $mask ? 1 : 0;
   $row->[$y] & ( 1 << ($TILE_SIZE_FULL_M1 - $x) );
}

sub st_setcellval {
   my ($row, $x, $y, $v) = @_;
   my $mask = 1 << ($TILE_SIZE_FULL_M1 - $x);
   if ($v) { $row->[$y] |= $mask; } else { $row->[$y] &= ~$mask; }
}

sub st_insertcells {
   my $row = shift;
   for my $r (@_) { st_setcellval($row, $r->[0], $r->[1], 1) }
}

# Used for verification and unit testing of st_tiletick
sub st_count {
   my $row = shift;
   my $cnt = 0;
   for my $y (0 .. $TILE_SIZE_FULL_M1) {
      next unless $row->[$y];
      # $cnt += popcount($row->[$y]);
      $cnt += sprintf('%b', $row->[$y]) =~ tr/1//;
   }
   return $cnt;
}

# Used for verification and unit testing of st_tiletick
sub st_getlivecells {
   my $row = shift;
   my @cells;
   for my $y (0 .. $TILE_SIZE_FULL_M1) {
      next unless $row->[$y];
      for my $x (0 .. $TILE_SIZE_FULL_M1) {
         st_getcellval($row, $x, $y) and push @cells, [ $x, $y ];
      }
   }
   sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @cells;
}

# Advance the interior of square tile by one tick.
# Return a two element list:
#   [0] : boolean: TRUE if square tile changed, else FALSE
#   [1] : neighbour flags (see NEIGH flags above)
#         indicates which neighbours need to be updated
# $top    is index of first non-zero element in $row
# $bottom is index of last  non-zero element in $row
# Note: Do not call this function with all elements zero
#  .... and it is pointless to do so
sub st_tiletick {
   my ( $row, $top, $bottom ) = @_;

   my $neigh = my $bigdiff = 0;
   my @carry = my @parity = my @diff = my @ee = (0) x $TILE_SIZE_FULL;
   my ( $aa, $bb, $p, $q, $r, $s, $bit0, $bit1, $bit2 );

   for my $i ($top .. $bottom) {
      $aa = $row->[$i] >> 1;
      $bb = $row->[$i] << 1;
      $q = $aa ^ $bb;
      $parity[$i] = $q ^ $row->[$i];
      $carry[$i] = ($q & $row->[$i]) | ($aa & $bb);
   }
   --$top; ++$bottom;
   $top < 1 and $top = 1;
   $bottom > $TILE_SIZE_MBD and $bottom = $TILE_SIZE_MBD;
   for my $i ($top .. $bottom) {
      $aa = $parity[$i-1];
      $bb = $parity[$i+1];
      $q = $aa ^ $bb;
      $bit0 = $q ^ $parity[$i];
      $r = ($q & $parity[$i]) | ($aa & $bb);

      $aa = $carry[$i-1];
      $bb = $carry[$i+1];
      $q = $aa ^ $bb;
      $p = $q ^ $carry[$i];
      $s = ($q & $carry[$i]) | ($aa & $bb);

      $bit1 = $p ^ $r;
      $bit2 = $s ^ ($p & $r);
      $p = ($bit0 & $bit1 & ~$bit2) | ($bit2 & ~$bit1 & ~$bit0 & $row->[$i]);
      $diff[$i] = ($row->[$i] ^ $p) & $BM_MIDDLE;
      $bigdiff |= $diff[$i];
      $row->[$i] = ($p & $BM_MIDDLE) | ($row->[$i] & ~$BM_MIDDLE);
   }
   $aa = $diff[$BORDER_WIDTH]   | $diff[$BORDER_WIDTH_P1];
   $bb = $diff[$TILE_SIZE_CORE] | $diff[$TILE_SIZE_CORE_P1];
   if ($bigdiff) {
      $bigdiff & $BM_LEFTMIDDLE and $neigh |= 1 << $NEIGH_LEFT;
      $bigdiff & $BM_RIGHTMIDDLE and $neigh |= 1 << $NEIGH_RIGHT;
   }
   if ($aa) {
      $neigh |= 1 << $NEIGH_TOP;
      $aa & $BM_LEFTMIDDLE and $neigh |= 1 << $NEIGH_TOP_LEFT;
      $aa & $BM_RIGHTMIDDLE and $neigh |= 1 << $NEIGH_TOP_RIGHT;
   }
   if ($bb) {
      $neigh |= 1 << $NEIGH_BOTTOM;
      $bb & $BM_LEFTMIDDLE and $neigh |= 1 << $NEIGH_BOTTOM_LEFT;
      $bb & $BM_RIGHTMIDDLE and $neigh |= 1 << $NEIGH_BOTTOM_RIGHT;
   }
   ( $bigdiff, $neigh );
}

# Advance the interior of square tile by two ticks.
# Return a two element list:
#   [0] : boolean: TRUE if square tile changed, else FALSE
#   [1] : neighbour flags (see NEIGH flags above)
#         indicates which neighbours need to be updated
sub st_tiletwoticks {
   my ( $row, $top, $bottom ) = @_;

   my $neigh = my $bigdiff = 0;
   my @carry = my @parity = my @diff = my @ee = (0) x $TILE_SIZE_FULL;
   my ( $aa, $bb, $p, $q, $r, $s, $bit0, $bit1, $bit2 );

   # even --> odd
   for my $i ($top .. $bottom) {
      $aa = $row->[$i] >> 1;
      $bb = $row->[$i] << 1;
      $q = $aa ^ $bb;
      $parity[$i] = $q ^ $row->[$i];
      $carry[$i] = ($q & $row->[$i]) | ($aa & $bb);
   }
   --$top; ++$bottom;
   $top < 1 and $top = 1;
   $bottom > $TILE_SIZE_MBD and $bottom = $TILE_SIZE_MBD;

   for my $i ($top .. $bottom) {
      $aa = $parity[$i-1];
      $bb = $parity[$i+1];
      $q = $aa ^ $bb;
      $bit0 = $q ^ $parity[$i];
      $r = ($q & $parity[$i]) | ($aa & $bb);

      $aa = $carry[$i-1];
      $bb = $carry[$i+1];
      $q = $aa ^ $bb;
      $p = $q ^ $carry[$i];
      $s = ($q & $carry[$i]) | ($aa & $bb);

      $bit1 = $p ^ $r;
      $bit2 = $s ^ ($p & $r);
      $ee[$i] = ($bit0 & $bit1 & ~$bit2) | ($bit2 & ~$bit1 & ~$bit0 & $row->[$i]);
   }

   # odd --> even
   for my $i ($top .. $bottom) {
      $aa = $ee[$i] >> 1;
      $bb = $ee[$i] << 1;
      $q = $aa ^ $bb;
      $parity[$i] = $q ^ $ee[$i];
      $carry[$i] = ($q & $ee[$i]) | ($aa & $bb);
   }
   --$top; ++$bottom;
   $top < $BORDER_WIDTH and $top = $BORDER_WIDTH;
   $bottom > $TILE_SIZE_MBD_M1 and $bottom = $TILE_SIZE_MBD_M1;

   for my $i ($top .. $bottom) {
      $aa = $parity[$i-1];
      $bb = $parity[$i+1];
      $q = $aa ^ $bb;
      $bit0 = $q ^ $parity[$i];
      $r = ($q & $parity[$i]) | ($aa & $bb);

      $aa = $carry[$i-1];
      $bb = $carry[$i+1];
      $q = $aa ^ $bb;
      $p = $q ^ $carry[$i];
      $s = ($q & $carry[$i]) | ($aa & $bb);

      $bit1 = $p ^ $r;
      $bit2 = $s ^ ($p & $r);
      $p = ($bit0 & $bit1 & ~$bit2) | ($bit2 & ~$bit1 & ~$bit0 & $ee[$i]);
      $diff[$i] = ($row->[$i] ^ $p) & $BM_MIDDLE;
      $bigdiff |= $diff[$i];
      # $hist->[$i] |= ($row->[$i] | $ee[$i]) & $BM_MIDDLE;
      $row->[$i] = ($p & $BM_MIDDLE) | ($row->[$i] & ~$BM_MIDDLE);
   }

   $aa = $diff[$BORDER_WIDTH]   | $diff[$BORDER_WIDTH_P1];
   $bb = $diff[$TILE_SIZE_CORE] | $diff[$TILE_SIZE_CORE_P1];
   if ($bigdiff) {
      $bigdiff & $BM_LEFTMIDDLE and $neigh |= 1 << $NEIGH_LEFT;
      $bigdiff & $BM_RIGHTMIDDLE and $neigh |= 1 << $NEIGH_RIGHT;
   }
   if ($aa) {
      $neigh |= 1 << $NEIGH_TOP;
      $aa & $BM_LEFTMIDDLE and $neigh |= 1 << $NEIGH_TOP_LEFT;
      $aa & $BM_RIGHTMIDDLE and $neigh |= 1 << $NEIGH_TOP_RIGHT;
   }
   if ($bb) {
      $neigh |= 1 << $NEIGH_BOTTOM;
      $bb & $BM_LEFTMIDDLE and $neigh |= 1 << $NEIGH_BOTTOM_LEFT;
      $bb & $BM_RIGHTMIDDLE and $neigh |= 1 << $NEIGH_BOTTOM_RIGHT;
   }
   ( $bigdiff, $neigh );
}

# Note: mapping of x (cell) to tx (tile) is:
#        x       tx
#   ----------   --
#   ...
#   -121..-180   -3
#    -61..-120   -2
#     -1..-60    -1
#      0.. 59     0
#     60..119     1
#    120..179     2
#   ...
# Ditto for y (cell) to ty (tile).

# Input cell (x, y). Return (tx, ty, ix, iy)
# (tx, ty) : Tile coords
# (ix, iy) : x, y coords inside tile
sub get_tile_coords {
   my ( $x, $y ) = @_;
   my $ox = $x % $TILE_SIZE_CORE;
   my $oy = $y % $TILE_SIZE_CORE;
   if ($ox < 0) { $ox += $TILE_SIZE_CORE }
   if ($oy < 0) { $oy += $TILE_SIZE_CORE }
   my $tx = ($x - $ox) / $TILE_SIZE_CORE;
   my $ty = ($y - $oy) / $TILE_SIZE_CORE;
   my $ix = $ox + $BORDER_WIDTH;
   my $iy = $oy + $BORDER_WIDTH;
   return ( $tx, $ty, $ix, $iy );
}

# Converse of get_tile_coords
# Input (tx, ty, ix, iy). Return cell (x, y)
sub get_cell_coords {
   my ( $tx, $ty, $ix, $iy ) = @_;
   my $x = $TILE_SIZE_CORE * $tx + $ix - $BORDER_WIDTH;
   my $y = $TILE_SIZE_CORE * $ty + $iy - $BORDER_WIDTH;
   return ( $x, $y );
}

# See perlmonks.org, node_id: 1199987
# Inline this popcount function below
# sub popcount { sprintf('%b', shift) =~ tr/1// }

# ----------------------------------------------------------------
# ORGANISM

# Input a list of [ x, y ] coords
sub insert_cells {
   my $self = shift;
   for my $r (@_) { $self->setcell($r->[0], $r->[1], 1) }
}

# Used for verification and testing the state of the organism
sub count {
   my $self  = shift;
   my $tiles = $self->{Tiles};
   my $cnt = 0;
   for my $sqt (values %{$tiles}) {
      my $row = $sqt->[$Row];
      for my $iy ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
         next unless $row->[$iy];
         # $cnt += popcount($row->[$iy] & $BM_MIDDLE);
         $cnt += sprintf('%b', $row->[$iy] & $BM_MIDDLE) =~ tr/1//;
      }
   }
   return $cnt;
}

sub dump_one_tile {
   my $sqt = shift;
   my $tx = $sqt->[$Tx];
   my $ty = $sqt->[$Ty];
   my $updateflags = $sqt->[$Updateflags];
   my $row = $sqt->[$Row];
   my $ngh = $sqt->[$Neighbours];
   my $popc = 0;
   for my $iy ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
      next unless $row->[$iy];
      # $cnt += popcount($row->[$iy] & $BM_MIDDLE);
      $popc += sprintf('%b', $row->[$iy] & $BM_MIDDLE) =~ tr/1//;
   }
   my $uf = sprintf '%032b', $updateflags;
   print STDERR "tx=$tx ty=$ty popc=$popc\n";
   print STDERR "  updateflags=$uf\n";
   print STDERR "  live neighbours:";
   for my $n (0 .. $NUM_NEIGH_M1) { $ngh->[$n] or next; print STDERR " $n" }
   print STDERR "\n";
}

# Used for verification and testing the state of the organism
sub dump_tiles {
   my $self  = shift;
   my $tiles = $self->{Tiles};
   my @tkeys = sort keys %{$tiles};
   my $ntiles = @tkeys;
   print STDERR "=== Dump Tiles, n=$ntiles ==========\n";
   my $ii = 0;
   for my $k (@tkeys) {
      ++$ii;
      my ($kx, $ky) = unpack 'i2', $k;    # Note: $kx,$ky match Tx,Ty
      print STDERR "$ii:-----------------------------\n";
      my $sqt = $tiles->{$k};
      dump_one_tile($sqt);
   }
   my $modified = $self->{Modified};
   my $nmodified = @{$modified};
   print STDERR "=== Dump Modif, n=$nmodified ==========\n";
   $ii = 0;
   for my $sqt (@{$modified}) {
      ++$ii;
      print STDERR "$ii:-----------------------------\n";
      dump_one_tile($sqt);
   }
}

# Used for verification and testing the state of the organism
sub get_live_cells {
   my $self  = shift;
   my $tiles = $self->{Tiles};
   my @cells;
   for my $sqt (values %{$tiles}) {
      my $tx  = $sqt->[$Tx];
      my $ty  = $sqt->[$Ty];
      my $row = $sqt->[$Row];
      for my $iy ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
         my $rowval = $row->[$iy];
         next unless $rowval;
         for my $ix ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
            # next unless st_getcellval($row, $ix, $iy);
            next unless $rowval & ( 1 << ($TILE_SIZE_FULL_M1 - $ix) );
            push @cells,
               [ $TILE_SIZE_CORE * $tx + $ix - $BORDER_WIDTH,
                 $TILE_SIZE_CORE * $ty + $iy - $BORDER_WIDTH ];
         }
         # my @biton = split //, sprintf($BM_FMT, $rowval & $BM_MIDDLE);
         # for my $ix ( grep($biton[$_], 0 .. $#biton) )
         # {
         #    push @cells,
         #       [ $TILE_SIZE_CORE * $tx + $ix - $BORDER_WIDTH,
         #         $TILE_SIZE_CORE * $ty + $iy - $BORDER_WIDTH ];
         # }
      }
   }
   sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @cells;
}

# Assumes initial $sqt->[$Neighbours]->[$i] check has been done
sub get_neighbour {
   my $self = shift;
   my $sqt  = shift;
   my $i    = shift;
   # $sqt->[$Neighbours]->[$i] and return $sqt->[$Neighbours]->[$i];
   my $tx = $sqt->[$Tx];
   my $ty = $sqt->[$Ty];
   $i >= $NEIGH_TOP_RIGHT    && $i <= $NEIGH_BOTTOM_RIGHT and ++$tx;
   $i >= $NEIGH_BOTTOM_RIGHT && $i <= $NEIGH_BOTTOM_LEFT  and ++$ty;
   $i >= $NEIGH_BOTTOM_LEFT  && $i <= $NEIGH_TOP_LEFT     and --$tx;
   $i == $NEIGH_TOP_LEFT     || $i <= $NEIGH_TOP_RIGHT    and --$ty;
   my $tiles = $self->{Tiles};
   my $k = pack 'i2', $tx, $ty;
   exists($tiles->{$k}) or
      $tiles->{$k} = [
         $tx,           # $Tx
         $ty,           # $Ty
         0,             # $Updateflags
         [ (0) x $TILE_SIZE_FULL ],    # $Row
         [],            # $Neighbours
      ];
   $sqt->[$Neighbours]->[$i] = $tiles->{$k};
}

# Alert the neighbour that its neighbour (the original tile) has changed
sub update_neighbour {
   my $self = shift;
   my $sqt  = shift;
   my $i    = shift;
   my $n = $sqt->[$Neighbours]->[$i] || $self->get_neighbour($sqt, $i);
   $n->[$Updateflags] == 0 and push @{$self->{Modified}}, $n;
   $n->[$Updateflags] |= 1 << ($i ^ 4);
}

# Update the relevant portions of the boundary (a 64-by-64 square
# with the central 60-by-60 square removed) by copying data from
# the interiors (the 60-by-60 central squares) of the neighbours.
# Alternatively, for 32-bit ints, 32-by-32 with 28-by-28 core.
# Only perform this copying when necessary.
sub update_boundary {
   my $self = shift;
   my $sqt = shift;
   if ( $sqt->[$Updateflags] & (1 << $NEIGH_TOP) ) {
      my $n = $sqt->[$Neighbours]->[$NEIGH_TOP] || $self->get_neighbour($sqt, $NEIGH_TOP);
      $sqt->[$Row]->[0] = ($n->[$Row]->[$TILE_SIZE_CORE] & $BM_MIDDLE) | ($sqt->[$Row]->[0] & $BM_OUTER);
      $sqt->[$Row]->[1] = ($n->[$Row]->[$TILE_SIZE_CORE_P1] & $BM_MIDDLE) | ($sqt->[$Row]->[1] & $BM_OUTER);
   }
   if ( $sqt->[$Updateflags] & (1 << $NEIGH_TOP_LEFT) ) {
      my $n = $sqt->[$Neighbours]->[$NEIGH_TOP_LEFT] || $self->get_neighbour($sqt, $NEIGH_TOP_LEFT);
      $sqt->[$Row]->[0] = (($n->[$Row]->[$TILE_SIZE_CORE] & $BM_MIDDLE) << $TILE_SIZE_CORE) | ($sqt->[$Row]->[0] & $BM_RIGHT);
      $sqt->[$Row]->[1] = (($n->[$Row]->[$TILE_SIZE_CORE_P1] & $BM_MIDDLE) << $TILE_SIZE_CORE) | ($sqt->[$Row]->[1] & $BM_RIGHT);
   }
   if ( $sqt->[$Updateflags] & (1 << $NEIGH_TOP_RIGHT) ) {
      my $n = $sqt->[$Neighbours]->[$NEIGH_TOP_RIGHT] || $self->get_neighbour($sqt, $NEIGH_TOP_RIGHT);
      $sqt->[$Row]->[0] = (($n->[$Row]->[$TILE_SIZE_CORE] & $BM_MIDDLE) >> $TILE_SIZE_CORE) | ($sqt->[$Row]->[0] & $BM_LEFT);
      $sqt->[$Row]->[1] = (($n->[$Row]->[$TILE_SIZE_CORE_P1] & $BM_MIDDLE) >> $TILE_SIZE_CORE) | ($sqt->[$Row]->[1] & $BM_LEFT);
   }
   if ( $sqt->[$Updateflags] & (1 << $NEIGH_BOTTOM) ) {
      my $n = $sqt->[$Neighbours]->[$NEIGH_BOTTOM] || $self->get_neighbour($sqt, $NEIGH_BOTTOM);
      $sqt->[$Row]->[$TILE_SIZE_MBD] = ($n->[$Row]->[$BORDER_WIDTH] & $BM_MIDDLE) | ($sqt->[$Row]->[$TILE_SIZE_MBD] & $BM_OUTER);
      $sqt->[$Row]->[$TILE_SIZE_FULL_M1] = ($n->[$Row]->[3] & $BM_MIDDLE) | ($sqt->[$Row]->[$TILE_SIZE_FULL_M1] & $BM_OUTER);
   }
   if ( $sqt->[$Updateflags] & (1 << $NEIGH_BOTTOM_LEFT) ) {
      my $n = $sqt->[$Neighbours]->[$NEIGH_BOTTOM_LEFT] || $self->get_neighbour($sqt, $NEIGH_BOTTOM_LEFT);
      $sqt->[$Row]->[$TILE_SIZE_MBD] = (($n->[$Row]->[$BORDER_WIDTH] & $BM_MIDDLE) << $TILE_SIZE_CORE) | ($sqt->[$Row]->[$TILE_SIZE_MBD] & $BM_RIGHT);
      $sqt->[$Row]->[$TILE_SIZE_FULL_M1] = (($n->[$Row]->[3] & $BM_MIDDLE) << $TILE_SIZE_CORE) | ($sqt->[$Row]->[$TILE_SIZE_FULL_M1] & $BM_RIGHT);
   }
   if ( $sqt->[$Updateflags] & (1 << $NEIGH_BOTTOM_RIGHT) ) {
      my $n = $sqt->[$Neighbours]->[$NEIGH_BOTTOM_RIGHT] || $self->get_neighbour($sqt, $NEIGH_BOTTOM_RIGHT);
      $sqt->[$Row]->[$TILE_SIZE_MBD] = (($n->[$Row]->[$BORDER_WIDTH] & $BM_MIDDLE) >> $TILE_SIZE_CORE) | ($sqt->[$Row]->[$TILE_SIZE_MBD] & $BM_LEFT);
      $sqt->[$Row]->[$TILE_SIZE_FULL_M1] = (($n->[$Row]->[3] & $BM_MIDDLE) >> $TILE_SIZE_CORE) | ($sqt->[$Row]->[$TILE_SIZE_FULL_M1] & $BM_LEFT);
   }
   if ( $sqt->[$Updateflags] & (1 << $NEIGH_LEFT) ) {
      my $n = $sqt->[$Neighbours]->[$NEIGH_LEFT] || $self->get_neighbour($sqt, $NEIGH_LEFT);
      for my $i ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
         $sqt->[$Row]->[$i] = (($n->[$Row]->[$i] & $BM_MIDDLE) << $TILE_SIZE_CORE) | ($sqt->[$Row]->[$i] & $BM_RIGHT);
      }
   }
   if ( $sqt->[$Updateflags] & (1 << $NEIGH_RIGHT) ) {
      my $n = $sqt->[$Neighbours]->[$NEIGH_RIGHT] || $self->get_neighbour($sqt, $NEIGH_RIGHT);
      for my $i ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
         $sqt->[$Row]->[$i] = (($n->[$Row]->[$i] & $BM_MIDDLE) >> $TILE_SIZE_CORE) | ($sqt->[$Row]->[$i] & $BM_LEFT);
      }
   }
}

sub tick {
   my $self = shift;
   my $modified = $self->{Modified};

   # Update boundary of all modified tiles
   for my $sqt (@{$modified}) {
      $sqt->[$Updateflags] & $NEIGH_ANY and $self->update_boundary($sqt);
      $sqt->[$Updateflags] = 0;
   }

   # Update core of all modified tiles, creating new modified list
   # Using map rather than foreach is odd, but it's faster (no need for temporary list)
   @{$modified} = map {
      my $sqt = $_;
      my @tmp;
      my $row = $sqt->[$Row];
      my $top = my $bottom = $TILE_SIZE_FULL;
      $row->[$_] and $top = $_, last for 0..$TILE_SIZE_FULL_M1;
      if ($top != $TILE_SIZE_FULL) {
         1 while --$bottom && !$row->[$bottom];
         my ($update_flag, $neigh) = st_tiletick($row, $top, $bottom);
         # update tile
         if ($update_flag) {
            $sqt->[$Updateflags] == 0 and push @tmp, $sqt;
            $sqt->[$Updateflags] |= 1 << $NUM_NEIGH;
         }
         if ($neigh) {
            for my $i (0 .. $NUM_NEIGH_M1) {
               next unless $neigh & (1 << $i);
               # $self->update_neighbour($sqt, $i)
               my $n = $sqt->[$Neighbours]->[$i] || $self->get_neighbour($sqt, $i);
               $n->[$Updateflags] == 0 and push @tmp, $n;
               $n->[$Updateflags] |= 1 << ($i ^ 4);
            }
         }
      }
      @tmp
   } @{$modified};
}

sub twoticks {
   my $self = shift;
   my $modified = $self->{Modified};

   # Update boundary of all modified tiles
   for my $sqt (@{$modified}) {
      $sqt->[$Updateflags] & $NEIGH_ANY and $self->update_boundary($sqt);
      $sqt->[$Updateflags] = 0;
   }

   # Update core of all modified tiles, creating new modified list
   # Using map rather than foreach is odd, but it's faster (no need for temporary list)
   @{$modified} = map {
      my $sqt = $_;
      my @tmp;
      my $row = $sqt->[$Row];
      my $top = my $bottom = $TILE_SIZE_FULL;
      $row->[$_] and $top = $_, last for 0..$TILE_SIZE_FULL_M1;
      if ($top != $TILE_SIZE_FULL) {
         1 while --$bottom && !$row->[$bottom];
         my ($update_flag, $neigh) = st_tiletwoticks($row, $top, $bottom);
         # update tile
         if ($update_flag) {
            $sqt->[$Updateflags] == 0 and push @tmp, $sqt;
            $sqt->[$Updateflags] |= 1 << $NUM_NEIGH;
         }
         if ($neigh) {
            for my $i (0 .. $NUM_NEIGH_M1) {
               next unless $neigh & (1 << $i);
               # $self->update_neighbour($sqt, $i)
               my $n = $sqt->[$Neighbours]->[$i] || $self->get_neighbour($sqt, $i);
               $n->[$Updateflags] == 0 and push @tmp, $n;
               $n->[$Updateflags] |= 1 << ($i ^ 4);
            }
         }
      }
      @tmp
   } @{$modified};
}

sub ticks {
   my $self = shift;
   my $nticks = shift;
   return if $nticks <= 0;
   if ($nticks == 1) { $self->tick(); return }
   my $half = $nticks >> 1;
   my $rem  = $nticks &  1;
   $self->twoticks() for 1 .. $half;
   $rem and $self->tick();
}

sub updatecell {
   my $self = shift;
   my $sqt  = shift;
   my $ix   = shift;
   my $iy   = shift;

   $sqt->[$Updateflags] == 0 and push @{$self->{Modified}}, $sqt;
   $sqt->[$Updateflags] |= 1 << $NUM_NEIGH;
   $iy <= $BORDER_WIDTH_P1 and $self->update_neighbour($sqt, $NEIGH_TOP);
   $iy >= $TILE_SIZE_CORE  and $self->update_neighbour($sqt, $NEIGH_BOTTOM);
   if ($ix <= $BORDER_WIDTH_P1) {
      $self->update_neighbour($sqt, $NEIGH_LEFT);
      $iy <= $BORDER_WIDTH_P1 and $self->update_neighbour($sqt, $NEIGH_TOP_LEFT);
      $iy >= $TILE_SIZE_CORE  and $self->update_neighbour($sqt, $NEIGH_BOTTOM_LEFT);
   }
   if ($ix >= $TILE_SIZE_CORE) {
      $self->update_neighbour($sqt, $NEIGH_RIGHT);
      $iy <= $BORDER_WIDTH_P1 and $self->update_neighbour($sqt, $NEIGH_TOP_RIGHT);
      $iy >= $TILE_SIZE_CORE  and $self->update_neighbour($sqt, $NEIGH_BOTTOM_RIGHT);
   }
}

sub setcell {
   my $self  = shift;
   my $x     = shift;
   my $y     = shift;
   my $state = shift;
   my $tiles = $self->{Tiles};

   my ( $tx, $ty, $ix, $iy ) = get_tile_coords($x, $y);
   my $k = pack 'i2', $tx, $ty;
   exists($tiles->{$k}) or
      $tiles->{$k} = [
         $tx,
         $ty,
         0,
         [ (0) x $TILE_SIZE_FULL ],
         [],
      ];
   st_setcellval($tiles->{$k}->[$Row], $ix, $iy, $state);
   $self->updatecell($tiles->{$k}, $ix, $iy);
}

sub getcellval {
   my $self = shift;
   my $x    = shift;
   my $y    = shift;
   my $tiles = $self->{Tiles};

   my ( $tx, $ty, $ix, $iy ) = get_tile_coords($x, $y);
   my $k = pack 'i2', $tx, $ty;
   exists $tiles->{$k} or return 0;
   return st_getcellval( $tiles->{$k}->[$Row], $ix, $iy );
}

sub new {
   my $class = shift;
   my %init_self = ( Tiles => {}, Modified => [] );
   bless \%init_self, $class;
}

1;

##</code><code>##

# tbench1.pl - Simple benchmark of Organism class.
# Generate blinker test file with, for example:
#   perl createblinker.pl 500000 -900000 100 >x.tmp 2>y.tmp
# then run this script for two ticks, for example:
#   perl tbench1.pl x.tmp 2
use strict;
use warnings;
use Organism;

# XXX: To read Life 1.06 file, ignore leading line containing "#Life 1.06"
sub read_cells {
   my $fname = shift;
   open( my $fh, '<', $fname ) or die "error: open '$fname': $!";
   map { [ split ' ' ] } <$fh>;
}

@ARGV == 2 or die "usage: $0 file nticks\n";
my $file   = shift;
my $nticks = shift;
$nticks =~ /^\d+$/ or die "error: nticks ($nticks) not a number";
my $org = Organism->new();
{
   my @cells = read_cells($file);
   $org->insert_cells(@cells);
   my $ncells = $org->count();
   print "cell count at start = $ncells\n";
   $ncells == scalar(@cells) or die "oops";
   # Uncomment for tile dump
   # $org->dump_tiles();
}
warn "run benchmark for $nticks ticks\n";
my $tstart = time;
# for my $i ( 1 .. $nticks ) { $org->tick() }
$org->ticks($nticks);
my $tend = time;
my $taken = $tend - $tstart;
my $ncells = $org->count();

# Uncomment for diff with goodlidkaout.txt
# {
#    my @vcells = $org->get_live_cells();
#    my $cnt = 0;
#    for my $c (@vcells) {
#       ++$cnt;
#       print "$cnt: $c->[0],$c->[1]\n";
#    }
#    $cnt == $ncells or warn "error: $cnt != $ncells\n";
# }

print "cell count at end = $ncells\n";
warn "time taken: $taken secs\n";

# Uncomment for tile dump
# $org->dump_tiles();

##</code><code>##

# tgol3.t - Simple lidka test of Conway Game of Life Organism class
use strict;
use warnings;
use Organism;
use Test::More;
my $ntests = 321;
plan tests => $ntests;

sub test_one {
   my $org = shift;           # Organism handle
   my $desc = shift;          # Test description
   my $nexpected = shift;     # Expected cell count
   # my $expected = shift;    # Array ref of (sorted) expected cells
   my @cells = $org->get_live_cells();
   my $ncells = $org->count();
   cmp_ok( $ncells, '==', $nexpected, "$desc cell count ($ncells)" );
   cmp_ok( scalar(@cells), '==', $nexpected, "$desc cell array count" );
   # is_deeply( \@cells, $expected, "$desc cell array" );
}

# Test first 101 ticks from famous lidka methuselah
# See: http://conwaylife.com/wiki/Lidka
my @lidka_ticks = (
   13,    # [ 0] initial count

   15,    # [ 1]
   15,    # [ 2]
   19,    # [ 3]
   19,    # [ 4]
   23,    # [ 5]
   23,    # [ 6]
   32,    # [ 7]
   29,    # [ 8]
   47,    # [ 9]
   27,    # [10]

   32,    # [11]
   36,    # [12]
   42,    # [13]
   48,    # [14]
   48,    # [15]
   46,    # [16]
   60,    # [17]
   54,    # [18]
   56,    # [19]
   64,    # [20]

   86,    # [21]
   64,    # [22]
   74,    # [23]
   70,    # [24]
   68,    # [25]
   52,    # [26]
   58,    # [27]
   50,    # [28]
   44,    # [29]
   50,    # [30]

   54,    # [31]
   80,    # [32]
   50,    # [33]
   54,    # [34]
   56,    # [35]
   54,    # [36]
   62,    # [37]
   50,    # [38]
   58,    # [39]
   56,    # [40]

   70,    # [41]
   60,    # [42]
   48,    # [43]
   52,    # [44]
   56,    # [45]
   72,    # [46]
   70,    # [47]
   68,    # [48]
   78,    # [49]
   86,    # [50]

   82,    # [51]
   93,    # [52]
   98,    # [53]
   94,    # [54]
   110,   # [55]
   87,    # [56]
   95,    # [57]
   79,    # [58]
   88,    # [59]
   80,    # [60]

   69,    # [61]
   76,    # [62]
   91,    # [63]
   89,    # [64]
   93,    # [65]
   112,   # [66]
   108,   # [67]
   140,   # [68]
   129,   # [69]
   157,   # [70]

   138,   # [71]
   147,   # [72]
   129,   # [73]
   111,   # [74]
   101,   # [75]
   105,   # [76]
   98,    # [77]
   117,   # [78]
   106,   # [79]
   114,   # [80]

   131,   # [81]
   124,   # [82]
   132,   # [83]
   118,   # [84]
   128,   # [85]
   133,   # [86]
   128,   # [87]
   140,   # [88]
   129,   # [89]
   126,   # [90]

   140,   # [91]
   147,   # [92]
   168,   # [93]
   163,   # [94]
   174,   # [95]
   164,   # [96]
   170,   # [97]
   152,   # [98]
   150,   # [99]
   144,   # [100]

   135,   # [101]
);

# Lidka cells after 100 ticks
my @lidka100 = (
   [ -29, 2 ],    # 1-10
   [ -28, 1 ],
   [ -28, 2 ],
   [ -28, 3 ],
   [ -27, 0 ],
   [ -27, 4 ],
   [ -26, 0 ],
   [ -26, 1 ],
   [ -26, 4 ],
   [ -26, 5 ],

   [ -25, 3 ],    # 11-20
   [ -25, 4 ],
   [ -24, 2 ],
   [ -24, 3 ],
   [ -23, 1 ],
   [ -23, 2 ],
   [ -22, 0 ],
   [ -21, 0 ],
   [ -21, 1 ],
   [ -17, -2 ],

   [ -17, -1 ],    # 21-30
   [ -16, -2 ],
   [ -16, -1 ],
   [ -12, 8 ],
   [ -11, 9 ],
   [ -11, 10 ],
   [ -11, 16 ],
   [ -11, 17 ],
   [ -10, 8 ],
   [ -10, 9 ],

   [ -10, 10 ],    # 31-40
   [ -10, 15 ],
   [ -10, 16 ],
   [ -10, 18 ],
   [ -10, 19 ],
   [ -9, 18 ],
   [ -9, 19 ],
   [ -8, 13 ],
   [ -8, 18 ],
   [ -8, 19 ],

   [ -7, 12 ],    # 41-50
   [ -6, -19 ],
   [ -6, -18 ],
   [ -6, 16 ],
   [ -6, 17 ],
   [ -5, -19 ],
   [ -5, -17 ],
   [ -5, 12 ],
   [ -5, 16 ],
   [ -5, 17 ],

   [ -4, -19 ],    # 51-60
   [ -4, 13 ],
   [ -4, 14 ],
   [ -4, 15 ],
   [ -4, 16 ],
   [ -4, 18 ],
   [ -3, 14 ],
   [ -3, 15 ],
   [ -3, 18 ],
   [ -2, 17 ],

   [ -2, 18 ],    # 61-70
   [ -1, -13 ],
   [ -1, 6 ],
   [ 0, -14 ],
   [ 0, -13 ],
   [ 0, -12 ],
   [ 0, 5 ],
   [ 0, 6 ],
   [ 0, 7 ],
   [ 1, -15 ],

   [ 1, -14 ],    # 71-80
   [ 1, -12 ],
   [ 1, 6 ],
   [ 1, 9 ],
   [ 1, 10 ],
   [ 2, -22 ],
   [ 2, -15 ],
   [ 2, 3 ],
   [ 2, 6 ],
   [ 3, -22 ],

   [ 3, -16 ],    # 81-90
   [ 3, 2 ],
   [ 3, 3 ],
   [ 3, 4 ],
   [ 3, 5 ],
   [ 3, 9 ],
   [ 4, -22 ],
   [ 4, -17 ],
   [ 4, -16 ],
   [ 4, -15 ],

   [ 4, -12 ],    # 91-100
   [ 4, -11 ],
   [ 4, 3 ],
   [ 4, 8 ],
   [ 5, -16 ],
   [ 5, -14 ],
   [ 5, -12 ],
   [ 5, 7 ],
   [ 6, -16 ],
   [ 6, -15 ],

   [ 6, -14 ],    # 101-110
   [ 6, 4 ],
   [ 6, 6 ],
   [ 7, -15 ],
   [ 7, -14 ],
   [ 7, 4 ],
   [ 7, 12 ],
   [ 7, 13 ],
   [ 8, -14 ],
   [ 8, 12 ],

   [ 8, 13 ],    # 111-120
   [ 9, -14 ],
   [ 9, -13 ],
   [ 9, -4 ],
   [ 9, -2 ],
   [ 9, 10 ],
   [ 9, 11 ],
   [ 10, -5 ],
   [ 10, -1 ],
   [ 10, 10 ],

   [ 10, 11 ],    # 121-130
   [ 11, -1 ],
   [ 11, 0 ],
   [ 12, -7 ],
   [ 12, -1 ],
   [ 12, 0 ],
   [ 13, -8 ],
   [ 13, -7 ],
   [ 13, -3 ],
   [ 13, -2 ],

   [ 13, -1 ],    # 131-140
   [ 14, -8 ],
   [ 14, -3 ],
   [ 14, -2 ],
   [ 14, 1 ],
   [ 15, -7 ],
   [ 15, -6 ],
   [ 15, -5 ],
   [ 15, -1 ],
   [ 15, 0 ],

   [ 15, 1 ],    # 141-144
   [ 16, -7 ],
   [ 16, -6 ],
   [ 16, -5 ],
);
my @slidka100 = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @lidka100;

# Lidka cells after 101 ticks
my @lidka101 = (
   [ -29, 1 ],    # 1-10
   [ -29, 2 ],
   [ -29, 3 ],
   [ -28, 1 ],
   [ -28, 2 ],
   [ -28, 3 ],
   [ -27, 0 ],
   [ -27, 4 ],
   [ -27, 5 ],
   [ -26, 0 ],

   [ -26, 1 ],   # 11-20
   [ -26, 5 ],
   [ -25, 1 ],
   [ -25, 5 ],
   [ -24, 1 ],
   [ -24, 4 ],
   [ -23, 1 ],
   [ -23, 2 ],
   [ -23, 3 ],
   [ -22, 0 ],

   [ -22, 2 ],    # 21-30
   [ -21, 0 ],
   [ -21, 1 ],
   [ -17, -2 ],
   [ -17, -1 ],
   [ -16, -2 ],
   [ -16, -1 ],
   [ -12, 9 ],
   [ -11, 10 ],
   [ -11, 15 ],

   [ -11, 16 ],   # 31-40
   [ -11, 17 ],
   [ -11, 18 ],
   [ -10, 8 ],
   [ -10, 10 ],
   [ -10, 15 ],
   [ -10, 16 ],
   [ -10, 19 ],
   [ -9, 9 ],
   [ -9, 20 ],

   [ -8, 18 ],   # 41-50
   [ -8, 19 ],
   [ -7, 17 ],
   [ -7, 18 ],
   [ -6, -19 ],
   [ -6, -18 ],
   [ -6, 16 ],
   [ -6, 17 ],
   [ -5, -20 ],
   [ -5, -19 ],

   [ -5, 13 ],   # 51-60
   [ -5, 14 ],
   [ -5, 18 ],
   [ -4, -18 ],
   [ -4, 13 ],
   [ -4, 18 ],
   [ -3, 13 ],
   [ -3, 18 ],
   [ -3, 19 ],
   [ -2, 17 ],

   [ -2, 18 ],    # 61-70
   [ -1, -14 ],
   [ -1, -13 ],
   [ -1, -12 ],
   [ -1, 5 ],
   [ -1, 6 ],
   [ -1, 7 ],
   [ 0, -15 ],
   [ 0, -12 ],
   [ 0, 5 ],

   [ 0, 7 ],    # 71-80
   [ 1, -15 ],
   [ 1, -12 ],
   [ 2, -16 ],
   [ 2, -15 ],
   [ 2, -14 ],
   [ 2, 2 ],
   [ 2, 3 ],
   [ 2, 6 ],
   [ 2, 9 ],

   [ 2, 10 ],    # 81-90
   [ 3, -23 ],
   [ 3, -22 ],
   [ 3, -21 ],
   [ 3, -17 ],
   [ 3, 2 ],
   [ 3, 5 ],
   [ 4, -17 ],
   [ 4, -13 ],
   [ 4, -12 ],

   [ 4, -11 ],    # 91-100
   [ 4, 2 ],
   [ 4, 3 ],
   [ 4, 8 ],
   [ 5, -14 ],
   [ 5, -12 ],
   [ 5, -11 ],
   [ 5, 7 ],
   [ 6, -16 ],
   [ 6, 5 ],

   [ 7, -16 ],    # 101-110
   [ 7, -13 ],
   [ 7, 5 ],
   [ 7, 12 ],
   [ 7, 13 ],
   [ 8, 13 ],
   [ 9, -14 ],
   [ 9, -13 ],
   [ 9, 10 ],
   [ 10, -2 ],

   [ 10, -1 ],    # 111-120
   [ 10, 0 ],
   [ 10, 10 ],
   [ 10, 11 ],
   [ 11, -2 ],
   [ 12, -8 ],
   [ 12, -7 ],
   [ 13, -8 ],
   [ 13, -7 ],
   [ 13, -3 ],

   [ 14, -8 ],    # 121-130
   [ 14, -4 ],
   [ 14, -3 ],
   [ 14, 1 ],
   [ 15, -8 ],
   [ 15, -5 ],
   [ 15, -4 ],
   [ 15, -2 ],
   [ 15, -1 ],
   [ 15, 0 ],

   [ 15, 1 ],    # 131-135
   [ 16, -7 ],
   [ 16, -5 ],
   [ 16, 0 ],
   [ 17, -6 ],
);
my @slidka101 = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @lidka101;

# Lidka starting pattern
my @lidka0 = (
   [ -3, -7 ],
   [ -4, -6 ],
   [ -2, -6 ],
   [ -3, -5 ],
   [  4,  3 ],
   [  2,  4 ],
   [  4,  4 ],
   [  1,  5 ],
   [  2,  5 ],
   [  4,  5 ],
   [  0,  7 ],
   [  1,  7 ],
   [  2,  7 ],
);
my @slidka0 = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @lidka0;

# Test one tick at a time up to 101
{
   # Initial cell array
   my $org = Organism->new();
   $org->insert_cells(@lidka0);
   {
      my @cells = $org->get_live_cells();
      is_deeply( \@cells, \@slidka0, "lidka initial cell array" );
      test_one( $org, "lidka 0", $lidka_ticks[0] );
   }

   # Test first 100 ticks
   for my $i ( 1 .. 100 ) {
      $org->tick();
      test_one( $org, "lidka $i", $lidka_ticks[$i] );
   }

   # Final cell array after 100 ticks
   {
      my @cells = $org->get_live_cells();
      cmp_ok( scalar(@cells), '==', $lidka_ticks[100], "lidka final array count" );
      is_deeply( \@cells, \@slidka100, "lidka final cell array" );
   }

   # Tick 101
   {
      my $i = 101;
      $org->tick();
      test_one( $org, "lidka $i", $lidka_ticks[$i] );
   }

   # Final cell array after 101 ticks
   {
      my @cells = $org->get_live_cells();
      cmp_ok( scalar(@cells), '==', $lidka_ticks[101], "lidka final array count" );
      is_deeply( \@cells, \@slidka101, "lidka final cell array" );
   }
}

# Test ticks(101) in one go
{
   # Initial cell array
   my $org = Organism->new();
   $org->insert_cells(@lidka0);
   {
      my @cells = $org->get_live_cells();
      is_deeply( \@cells, \@slidka0, "lidka initial cell array" );
      test_one( $org, "lidka 0", $lidka_ticks[0] );
   }

   # Test cell array after 101 ticks
   {
      my $i = 101;
      $org->ticks($i);
      test_one( $org, "lidka $i", $lidka_ticks[$i] );
   }

   # Final cell array after 101 ticks
   {
      my @cells = $org->get_live_cells();
      cmp_ok( scalar(@cells), '==', $lidka_ticks[101], "lidka final array count" );
      is_deeply( \@cells, \@slidka101, "lidka final cell array" );
   }
}

# Test two ticks at a time up to 100
{
   my $nticks_half = 50;

   # Initial cell array
   my $org = Organism->new();
   $org->insert_cells(@lidka0);
   {
      my @cells = $org->get_live_cells();
      is_deeply( \@cells, \@slidka0, "lidka initial cell array" );
      test_one( $org, "lidka 0", $lidka_ticks[0] );
   }

   # Test first 100 ticks, two at a time
   for my $i ( 1 .. $nticks_half ) {
      my $j = $i * 2;    # test two at a time
      # $org->tick(); $org->tick();    # For parallel testing
      $org->twoticks();
      test_one( $org, "lidka $j", $lidka_ticks[$j] );
   }

   # Final cell array
   {
      my @cells = $org->get_live_cells();
      cmp_ok( scalar(@cells), '==', $lidka_ticks[100], "lidka final array count" );
      is_deeply( \@cells, \@slidka100, "lidka final cell array" );
   }
}

##</code><code>##

# tgol4.t - Simple standalone test of Organism.pm st_ functions
use strict;
use warnings;
use Organism;
use Test::More;
my $ntests = 9;
plan tests => $ntests * 7;

# Test cells
sub test_cells {
   my $desc       = shift;      # Test description
   my $row        = shift;      # Row of cells in square tile
   my $cells_ref  = shift;      # Expected cells
   my $nexpected = Organism::st_count($row);
   my @cells = Organism::st_getlivecells($row);
   my $ncells = @cells;
   cmp_ok( $ncells, '==', $nexpected, "$desc cell count ($ncells)" );
   is_deeply( \@cells, $cells_ref, "$desc cell array" );
}

# Test one tick of a set of cells
sub test_one {
   my $desc            = shift;  # Test description
   my $one_two         = shift;  # 1 to test one tick, 2 to test two ticks
   my $incells_ref     = shift;  # Initial input cells
   my $outcells_ref    = shift;  # Expected output cells
   my $expected_update = shift;  # 1 if cells should change

   $one_two == 1 || $one_two == 2 or die "oops: invalid one_two ($one_two)";
   my @incells = @{$incells_ref};

   my $TILE_SIZE_FULL    = $Organism::TILE_SIZE_FULL;
   my $TILE_SIZE_FULL_M1 = $TILE_SIZE_FULL - 1;
   my @rowbuf = (0) x $TILE_SIZE_FULL;
   my $row    = \@rowbuf;

   # Insert initial cells
   Organism::st_insertcells($row, @incells);

   # Sanity check of initial state
   test_cells($desc, $row, $incells_ref);

   # Find top and bottom of tile (first and last non-zero row)
   my $top = my $bottom = $TILE_SIZE_FULL;
   $row->[$_] and $top = $_, last for 0..$TILE_SIZE_FULL_M1;
   if ($top != $TILE_SIZE_FULL) {
      1 while --$bottom && !$row->[$bottom];
   }
   $top != $TILE_SIZE_FULL or die "oops, wrong top";
   ok( 1, "top & bottom sane (TILE_SIZE_FULL=$TILE_SIZE_FULL top=$top bottom=$bottom)" );

   # Test st_ tile tick.
   my ($update_flag, $neigh) = ($one_two == 1)
      ? Organism::st_tiletick($row, $top, $bottom)
      : Organism::st_tiletwoticks($row, $top, $bottom);
   my $update_flag_bits = sprintf '%b', $update_flag;
   $update_flag = !!$update_flag;    # convert to boolean
   cmp_ok( $update_flag, '==', $expected_update, "$desc update flag ($update_flag_bits)" );
   cmp_ok( $neigh, '==', 0, "$desc neigh flag ($neigh)" );
   # Check cells after tick/s
   test_cells($desc, $row, $outcells_ref);
}

{
   my @incells = (
      [ 8, 5 ],
      [ 8, 6 ],
      [ 8, 7 ],
   );
   my @outcells = (
      [ 7, 6 ],
      [ 8, 6 ],
      [ 9, 6 ],
   );
   @incells  = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @incells;
   @outcells = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @outcells;
   test_one("Vertical Blinker one", 1, \@incells, \@outcells, 1);
   test_one("Vertical Blinker two", 2, \@incells, \@incells,  0);
}

{
   my @incells = (
      [ 7, 6 ],
      [ 8, 6 ],
      [ 9, 6 ],
   );
   my @outcells = (
      [ 8, 5 ],
      [ 8, 6 ],
      [ 8, 7 ],
   );
   @incells  = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @incells;
   @outcells = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @outcells;
   test_one("Horizontal Blinker one", 1, \@incells, \@outcells, 1);
   test_one("Horizontal Blinker two", 2, \@incells, \@incells,  0);
}

{
   my @incells = (
      [ 6, 6 ],
      [ 7, 6 ],
      [ 6, 7 ],
      [ 7, 7 ],
   );
   @incells = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @incells;
   test_one("Simple block one", 1, \@incells, \@incells, 0);
   test_one("Simple block two", 2, \@incells, \@incells, 0);
}

{
   my @incells = (
      [ 6, 6 ], [ 6, 7 ], [ 6, 8 ],
      [ 7, 6 ], [ 7, 7 ], [ 7, 8 ],
      [ 8, 6 ], [ 8, 7 ], [ 8, 8 ],
      [ 9, 6 ],
   );
   my @outcells = (
      [ 5, 7 ],
      [ 6, 6 ], [ 6, 8 ],
      [ 7, 5 ], [ 7, 9 ],
      [ 8, 5 ], [ 8, 8 ],
      [ 9, 6 ],
   );
   my @outcells2 = (
      [ 5, 7 ],
      [ 6, 6 ], [ 6, 7 ], [ 6, 8 ],
      [ 7, 5 ], [ 7, 6 ], [ 7, 7 ], [ 7, 8 ], [ 7, 9 ],
      [ 8, 5 ], [ 8, 6 ],
   );
   @incells   = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @incells;
   @outcells  = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @outcells;
   @outcells2 = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @outcells2;
   test_one("Weird block one-a", 1, \@incells,  \@outcells,  1);
   test_one("Weird block one-b", 1, \@outcells, \@outcells2, 1);
   test_one("Weird block two",   2, \@incells,  \@outcells2, 1);
}