view release on metacpan or  search on metacpan

lib/Traveller/Mapper.pm  view on Meta::CPAN

        stroke: black;
      }
      .red {
        fill: red;
      }
      #hex {
        stroke-width: 3pt;
        fill: none;
        stroke: black;
      }
      #background {
        fill: inherit;
      }
      #bg {
        fill: inherit;
      }
    ]]></style>
    <polygon id="hex" points="%s,%s %s,%s %s,%s %s,%s %s,%s %s,%s" />
    <polygon id="bg" points="%s,%s %s,%s %s,%s %s,%s %s,%s %s,%s" />
  </defs>
  <rect fill="white" stroke="black" stroke-width="10" id="frame"
        x="%s" y="%s" width="%s" height="%s" />

EOT
  my $scale = 100;
  return sprintf($template,
		 map { sprintf("%.3f", $_ * $scale) }
		 # viewport
		 -0.5, -0.5, 3 + ($self->width - 1) * 1.5, ($self->height + 1.5) * sqrt(3),
		 # empty hex, once for the backgrounds and once for the stroke
		 @hex,
		 @hex,
		 # framing rectangle
		 -0.5, -0.5, 3 + ($self->width - 1) * 1.5, ($self->height + 1.5) * sqrt(3));
}

sub colour {
  my $self = shift;
  my $culture = shift or return "white";
  # The same colours result from the same names.
  my @colours = ("#d3d3d3", "#f5f5f5", "#eaeaea", "#fffeb0", "#fff0f5", "#eee0e5", "#ffe1ff",
                 "#eed2ee", "#c6e2ff", "#fdf5e6", "#e0ffff", "#d1eeee", "#c5fff5", "#eeeee0",
                 "#fff68f", "#eee685", "#fffacd", "#eee9bf", "#ffe7ba", "#ffefdb", "#ffe4e1",
                 "#eed5d2", "#e6e6fa", "#f0ffff", "#c5ffd5", "#e6ffe6", "#d5ffc5", "#f5f5dc");
  my $i = unpack("%32W*", lc $culture) % @colours; # checksum
  return $colours[$i];
}

sub background {
  my $self = shift;
  my $scale = 100;
  return join("\n", map {
    my $hex = $_;
    my $x = $hex->x;
    my $y = $hex->y;
    my $c = $hex->colour || $self->colour($hex->culture);
    sprintf(qq{    <use xlink:href="#bg" x="%.3f" y="%.3f" fill="$c"/>},
            (1 + ($x-1) * 1.5) * $scale,
            ($y - $x%2/2) * sqrt(3) * $scale);

lib/Traveller/Mapper.pm  view on Meta::CPAN

    $data .= sprintf(qq{    <line class="trade" x1="%.3f" y1="%.3f" x2="%.3f" y2="%.3f" />\n},
		     (1 + ($x1-1) * 1.5) * $scale, ($y1 - $x1%2/2) * sqrt(3) * $scale,
		     (1 + ($x2-1) * 1.5) * $scale, ($y2 - $x2%2/2) * sqrt(3) * $scale);
  }
  return $data;
}

sub svg {
  my ($self, $width, $height) = @_;
  my $data = $self->header($width, $height);
  $data .= qq{  <g id='background'>\n};
  $data .= $self->background;
  $data .= qq{  </g>\n\n};
  $data .= qq{  <g id='comm'>\n};
  foreach my $hex (@{$self->hexes}) {
    $data .= $hex->comm_svg();
  }
  $data .= qq{  </g>\n\n};
  $data .= qq{  <g id='routes'>\n};
  $data .= $self->trade_svg();
  $data .= qq{  </g>\n\n};
  $data .= qq{  <g id='grid'>\n};