view release on metacpan or  search on metacpan

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

# Copyright (C) 2009-2022  Alex Schroeder <alex@gnu.org>
#
# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU Affero General Public License as published by the Free
# Software Foundation, either version 3 of the License, or (at your option) any
# later version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
# details.
#
# You should have received a copy of the GNU Affero General Public License along
# with this program. If not, see <http://www.gnu.org/licenses/>.

=encoding utf8

=head1 NAME

Game::TextMapper::Mapper - a text map parser and builder

=head1 SYNOPSIS

    use Modern::Perl;
    use Game::TextMapper::Mapper::Hex;
    my $map = <<EOT;
    0101 forest
    include default.txt
    EOT
    my $svg = Game::TextMapper::Mapper::Hex->new(dist_dir => 'share')
      ->initialize($map)
      ->svg();
    print $svg;

=head1 DESCRIPTION

This class knows how to parse a text containing a map description into SVG
definitions, and regions. Once the map is built, this class knows how to
generate the SVG for the entire map.

The details depend on whether the map is a hex map or a square map. You should
use the appropriate class instead of this one: L<Game::TextMapper::Mapper::Hex>
or L<Game::TextMapper::Mapper::Square>.

=cut

package Game::TextMapper::Mapper;
use Game::TextMapper::Log;
use Modern::Perl '2018';
use Mojo::UserAgent;
use Mojo::Base -base;
use File::Slurper qw(read_text);
use Encode qw(encode_utf8 decode_utf8);
use Mojo::Util qw(url_escape);
use File::ShareDir 'dist_dir';
use Scalar::Util 'weaken';

=head1 ATTRIBUTES

=head2 dist_dir

You need to pass this during instantiation so that the mapper knows where to
find files it needs to include.

=cut

has 'local_files';
has 'dist_dir';
has 'map';
has 'regions' => sub { [] };
has 'attributes' => sub { {} };
has 'defs' => sub { [] };
has 'path' => sub { {} };
has 'lines' => sub { [] };
has 'things' => sub { [] };
has 'path_attributes' => sub { {} };
has 'text_attributes' => '';
has 'glow_attributes' => '';
has 'label_attributes' => '';
has 'messages' => sub { [] };
has 'seen' => sub { {} };
has 'license' => '';
has 'other' => sub { [] };
has 'url' => '';
has 'offset' => sub { [] };

my $log = Game::TextMapper::Log->get;

sub example {
  return <<"EOT";
0101 mountain "mountain"
0102 swamp "swamp"
0103 hill "hill"
0104 forest "forest"
0201 empty pyramid "pyramid"
0202 tundra "tundra"
0203 coast "coast"
0204 empty house "house"
0301 woodland "woodland"
0302 wetland "wetland"
0303 plain "plain"
0304 sea "sea"
0401 hill tower "tower"
0402 sand house "house"
0403 jungle "jungle"
0501 mountain cave "cave"
0502 sand "sand"
0503 hill castle "castle"
0205-0103-0202-0303-0402 road
0101-0203 river
0401-0303-0403 border
include default.txt
license <text>Public Domain</text>
EOT
}

=head1 METHODS

=head2 initialize($map)

Call this to load a map into the mapper.

=cut

sub initialize {
  my ($self, $map) = @_;
  $map =~ s/&#45;/-/g; # -- are invalid in source comments...
  $self->map($map);
  $self->process(split(/\r?\n/, $map));
}

sub process {
  my $self = shift;
  my $line_id = 0;
  foreach (@_) {
    if (/^(-?\d\d)(-?\d\d)(\d\d)?\s+(.*)/ or /^(-?\d\d+)\.(-?\d\d+)(?:\.(\d\d+))?\s+(.*)/) {
      my $region = $self->make_region(x => $1, y => $2, z => $3||'00', map => $self);
      weaken($region->{map});
      my $rest = $4;
      while (my ($tag, $label, $size) = $rest =~ /\b([a-z]+)=["“]([^"”]+)["”]\s*(\d+)?/) {
	if ($tag eq 'name') {
	  $region->label($label);
          $region->size($size) if $size;
	} else {
	  # delay the calling of $self->other_info because the URL or the $self->glow_attributes might not be set
	  push(@{$self->other()}, sub () { $self->other_info($region, $label, $size, "translate(0,45)", 'opacity="0.2"') });
        }
	$rest =~ s/\b([a-z]+)=["“]([^"”]+)["”]\s*(\d+)?//;
      }
      while (my ($label, $size, $transform) = $rest =~ /["“]([^"”]+)["”]\s*(\d+)?((?:\s*[a-z]+\([^\)]+\))*)/) {
	if ($transform or $region->label) {
	  # delay the calling of $self->other_text because the URL or the $self->glow_attributes might not be set
	  push(@{$self->other()}, sub () { $self->other_text($region, $label, $size, $transform) });
	} else {
	  $region->label($label);
	  $region->size($size);
	}
	$rest =~ s/["“]([^"”]+)["”]\s*(\d+)?((?:\s*[a-z]+\([^\)]+\))*)//;
      }
      my @types = split(/\s+/, $rest);
      $region->type(\@types);
      push(@{$self->regions}, $region);
      push(@{$self->things}, $region);
    } elsif (/^(-?\d\d-?\d\d(?:\d\d)?(?:--?\d\d-?\d\d(?:\d\d)?)+)\s+(\S+)\s*(?:["“](.+)["”])?\s*(left|right)?\s*(\d+%)?/
             or /^(-?\d\d+\.-?\d\d+(?:\.\d\d+)?(?:--?\d\d+\.-?\d\d+(?:\.\d\d+)?)+)\s+(\S+)\s*(?:["“](.+)["”])?\s*(left|right)?\s*(\d+%)?/) {
      my $line = $self->make_line(map => $self);
      weaken($line->{map});
      my $str = $1;
      $line->type($2);
      $line->label($3);
      $line->side($4);
      $line->start($5);
      $line->id('line' . $line_id++);
      my @points;
      while ($str =~ /\G(?:(-?\d\d)(-?\d\d)(\d\d)?|(-?\d\d+)\.(-?\d\d+)\.(\d\d+)?)-?/cg) {
	push(@points, Game::TextMapper::Point->new(x => $1||$4, y => $2||$5, z => $3||$6||'00'));
      }
      $line->points(\@points);
      push(@{$self->lines}, $line);
    } elsif (/^(\S+)\s+attributes\s+(.*)/) {
      $self->attributes->{$1} = $2;
    } elsif (/^(\S+)\s+lib\s+(.*)/) {
      $self->def(qq{<g id="$1">$2</g>});
    } elsif (/^(\S+)\s+xml\s+(.*)/) {
      $self->def(qq{<g id="$1">$2</g>});
    } elsif (/^(<.*>)/) {
      $self->def($1);
    } elsif (/^(\S+)\s+path\s+attributes\s+(.*)/) {
      $self->path_attributes->{$1} = $2;
    } elsif (/^(\S+)\s+path\s+(.*)/) {
      $self->path->{$1} = $2;
    } elsif (/^text\s+(.*)/) {
      $self->text_attributes($1);
    } elsif (/^glow\s+(.*)/) {
      $self->glow_attributes($1);
    } elsif (/^label\s+(.*)/) {
      $self->label_attributes($1);
    } elsif (/^license\s+(.*)/) {
      $self->license($1);
    } elsif (/^other\s+(.*)/) {
      push(@{$self->other()}, $1);
    } elsif (/^url\s+(\S+)/) {
      $self->url($1);
    } elsif (/^include\s+(\S*)/) {
      if (scalar keys %{$self->seen} > 5) {
	push(@{$self->messages},
	     "Includes are limited to five to prevent loops");
      } elsif (not $self->seen->{$1}) {
	my $location = $1;
	$self->seen->{$location} = 1;
	my $path;
	if (index($location, '/') == -1 and -f ($path = Mojo::File->new($self->dist_dir, $location))) {
	  # without a slash, it could be a file from dist_dir
	  $log->debug("Reading $location");
	  $self->process(split(/\n/, decode_utf8($path->slurp())));
	} elsif ($self->local_files and -f ($path = Mojo::File->new($location))) {
	  # it could also be a local file in the same directory, but only if
	  # called from the render command (which sets local_files)
	  $log->debug("Reading $location");
	  $self->process(split(/\n/, decode_utf8($path->slurp())));
	} elsif ($location =~ /^https?:/) {
	  $log->debug("Getting $location");
	  my $ua = Mojo::UserAgent->new;
	  my $response = $ua->get($location)->result;
	  if ($response->is_success) {
	    $self->process(split(/\n/, $response->text));
	  } else {