view release on metacpan or  search on metacpan

lib/Game/TextMapper/Traveller.pm  view on Meta::CPAN

sub match {
  my ($re1, $re2, $sys1, $sys2) = @_;
  return 1 if any { /$re1/ } @$sys1 and any { /$re2/ } @$sys2;
  return 1 if any { /$re2/ } @$sys1 and any { /$re1/ } @$sys2;
  return 0;
}

sub minimal_spanning_tree {
  # http://en.wikipedia.org/wiki/Kruskal%27s_algorithm
  my $self = shift;
  # Initialize a priority queue Q to contain all edges in G, using the
  # weights as keys.
  my @Q = sort { @{$a}[2] <=> @{$b}[2] } @_;
  # Define a forest T ← Ø; T will ultimately contain the edges of the MST
  my @T;
  # Define an elementary cluster C(v) ← {v}.
  my %C;
  my $id;
  foreach my $edge (@Q) {
    # edge u,v is the minimum weighted route from u to v
    my ($u, $v) = @{$edge};
    # prevent cycles in T; add u,v only if T does not already contain
    # a path between u and v; also silence warnings
    if (not $C{$u} or not $C{$v} or $C{$u} != $C{$v}) {
      # Add edge (v,u) to T.
      push(@T, $edge);
      # Merge C(v) and C(u) into one cluster, that is, union C(v) and C(u).
      if ($C{$u} and $C{$v}) {
	my @group;
	foreach (keys %C) {
	  push(@group, $_) if $C{$_} == $C{$v};
	}
	$C{$_} = $C{$u} foreach @group;
      } elsif ($C{$v} and not $C{$u}) {
	$C{$u} = $C{$v};
      } elsif ($C{$u} and not $C{$v}) {
	$C{$v} = $C{$u};
      } elsif (not $C{$u} and not $C{$v}) {
	$C{$v} = $C{$u} = ++$id;
      }
    }
  }
  return \@T;
}

sub to_text {
  my $self = shift;
  my $tiles = shift;
  my $comms = shift;
  my $text = "";
  for my $x (0 .. $self->cols - 1) {
    for my $y (0 .. $self->rows - 1) {
      my $tile = $tiles->[$x + $y * $self->cols];
      if ($tile) {
	$text .= sprintf("%02d%02d @$tile\n", $x + 1, $y + 1);
      }
    }
  }
  $text .= join("\n", @$comms, "\ninclude traveller.txt\n");
  $text .= $self->legend();
  return $text;
}

sub legend {
  my $self = shift;
  my $template = qq{# frame and legend};
  my $x = int(($self->cols + 1) * 1.5 * $dx);
  my $y = int(($self->rows + 1) * $dy + 5);
  $template .= qq{
other <rect fill="none" stroke="black" stroke-width="10" x="0" y="-50" width="$x" height="$y" />},
  $x = int(($self->cols + 1) * 0.75 * $dx);
  $y = int(($self->rows + 1) * $dy - 60);
  $template .= qq{
other <text font-size="24pt" y="-10" x="$x" font-family="Optima, Helvetica, sans-serif" text-anchor="middle">coreward</text>
other <text font-size="24pt" y="$y" x="$x" font-family="Optima, Helvetica, sans-serif" text-anchor="middle">rimward</text>};
  $x = int($self->rows * $dy / 2);
  $template .= qq{
other <text font-size="24pt" x="-$x" y="40" transform="rotate(-90)" font-family="Optima, Helvetica, sans-serif" text-anchor="middle">spinward</text>
};
  $y = int(($self->cols + 1) * 1.5 * $dx);
  $template .= qq{
other <text font-size="24pt" x="$x" y="40" transform="rotate(90) translate(0, -$y)" font-family="Optima, Helvetica, sans-serif" text-anchor="middle">trailing</text>
};
  $x = int(($self->rows + 0.5) * $dy);
  $template .= qq{
other <text font-size="14pt" x="-$x" y="30" transform="rotate(-90)" font-family="Optima, Helvetica, sans-serif">◉ gas giant – ▲ scout base – ★ navy base – π research base – ☠ pirate base</text>
} if $self->rows > 8;
  $template .= qq{
other <text font-size="14pt" x="-650" y="30" transform="rotate(-90)" font-family="Optima, Helvetica, sans-serif">■ imperial consulate – ☼ TAS – <tspan fill="#ff6347">▮</tspan> communication – <tspan fill="#afeeee">▮</tspan> trade <tspan...
} if $self->rows > 8;
  return $template;
}

1;