You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
110 lines
2.8 KiB
110 lines
2.8 KiB
1 year ago
|
use v5.30;
|
||
|
|
|
||
|
|
use HexGrid;
|
||
|
|
use HexGrid::Pin;
|
||
|
|
use MWTemplate;
|
||
|
|
use Getopt::Long;
|
||
|
|
use File::Find;
|
||
|
|
use File::Basename;
|
||
|
|
use Carp;
|
||
|
|
|
||
|
|
use Data::Dumper;
|
||
|
|
$Data::Dumper::Indent = 1;
|
||
|
|
|
||
|
|
use feature "signatures";
|
||
|
|
no warnings "experimental::signatures";
|
||
|
|
|
||
|
|
my $template_name = "MapRegion";
|
||
|
|
|
||
|
|
my $border_width = 1;
|
||
|
|
my $border_colour = 'black';
|
||
|
|
my $show_coords = 0;
|
||
|
|
|
||
|
|
my @region_files;
|
||
|
|
my @pin_files;
|
||
|
|
my @include_dirs;
|
||
|
|
|
||
|
|
GetOptions(
|
||
|
|
'border-width=f' => \$border_width,
|
||
|
|
'border-colour|border-color=s' => \$border_colour,
|
||
|
|
'show-coords|coords!' => \$show_coords,
|
||
|
|
'region-file=s' => \@region_files,
|
||
|
|
'pin-file=s' => \@pin_files,
|
||
|
|
'directory|include-directory=s' => \@include_dirs
|
||
|
|
);
|
||
|
|
|
||
|
|
my $grid = HexGrid->new(defaults => {
|
||
|
|
style => { 'stroke-width' => $border_width, stroke => $border_colour },
|
||
|
|
show_coords => $show_coords });
|
||
|
|
|
||
|
|
@region_files = split(/,/, join(',', @region_files));
|
||
|
|
@pin_files = split(/,/, join(',', @pin_files));
|
||
|
|
@include_dirs = split(/,/, join(',', @include_dirs));
|
||
|
|
|
||
|
|
find(sub
|
||
|
|
{
|
||
|
|
push @region_files, $File::Find::name if /\.region$/;
|
||
|
|
push @pin_files, $File::Find::name if /\.pin$/;
|
||
|
|
}, @include_dirs);
|
||
|
|
|
||
|
|
foreach my $file (@region_files)
|
||
|
|
{
|
||
|
|
my $name = fileparse($file, qr/\.region/);
|
||
|
|
open my $fh, $file || croak "Couldn't open region file $file: $!";
|
||
|
|
my @region_lines = <$fh>;
|
||
|
|
close $fh;
|
||
|
|
my $tiles_file = $file;
|
||
|
|
$tiles_file =~ s/region$/tiles/;
|
||
|
|
open my $tfh, $tiles_file || croak "Couldn't open tiles file $tiles_file: $!";
|
||
|
|
my @tiles = <$tfh>;
|
||
|
|
close $tfh;
|
||
|
|
process_region($grid, $name, (join "", @region_lines), (join "", @tiles));
|
||
|
|
}
|
||
|
|
foreach my $file (@pin_files)
|
||
|
|
{
|
||
|
|
my $name = fileparse($file, qr/\.pin/);
|
||
|
|
open my $fh, $file || croak "Couldn't open pin file $file: $!";
|
||
|
|
my @lines = <$fh>;
|
||
|
|
close $fh;
|
||
|
|
process_pin($grid, $name, @lines);
|
||
|
|
}
|
||
|
|
|
||
|
|
say wrap_in_html($grid);
|
||
|
|
|
||
|
|
sub process_region($grid, $name, $region_spec, $tiles)
|
||
|
|
{
|
||
|
|
my $region = $grid->make_region($name);
|
||
|
|
my $parsed_template = MWTemplate::Parse($region_spec, $template_name);
|
||
|
|
$region->{defaults}{colour} = $parsed_template->{named_params}{colour};
|
||
|
|
$region->{defaults}{image} = $parsed_template->{named_params}{background};
|
||
|
|
say STDERR Dumper($tiles);
|
||
|
|
|
||
|
|
foreach my $coords (split /;/, $tiles)
|
||
|
|
{
|
||
|
|
# The below regex is a whitespace forgiving version of /^(-?\d+),(-?\d+)/, an int pair
|
||
|
|
do { carp "Skipping bad spec: $coords"; next; }
|
||
|
|
unless $coords =~ /^\s*(-?\s*\d+)\s*,\s*(-?\s*\d+)\s*$/;
|
||
|
|
$region->make_tile_at($1,$2);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
sub process_pin($file)
|
||
|
|
{
|
||
|
|
}
|
||
|
|
|
||
|
|
sub wrap_in_html($grid)
|
||
|
|
{
|
||
|
|
my $html_builder = "<!DOCTYPE html>";
|
||
|
|
$html_builder .= "\n<html>\n<body>";
|
||
|
|
$html_builder .= "\n" . <<EOS;
|
||
|
|
<script>
|
||
|
|
function clickPin(pinId, containerId) {
|
||
|
|
let popup = document.getElementById(pinId + '-popup');
|
||
|
|
popup.style.visibility = popup.style.visibility == 'visible' ? 'hidden' : 'visible';
|
||
|
|
}
|
||
|
|
</script>
|
||
|
|
EOS
|
||
|
|
$html_builder .= "\n" . $grid->render;
|
||
|
|
$html_builder .= "\n</body>\n</html>";
|
||
|
|
return $html_builder;
|
||
|
|
}
|