@ -0,0 +1,5 @@ |
|||||||
|
*.png |
||||||
|
*.jpg |
||||||
|
*.jpeg |
||||||
|
*.gif |
||||||
|
output/* |
@ -0,0 +1,94 @@ |
|||||||
|
package HexGrid; |
||||||
|
|
||||||
|
use v5.30; |
||||||
|
|
||||||
|
use Moo; |
||||||
|
use MooX::Aliases; |
||||||
|
use SVG; |
||||||
|
use Hash::Merge qw(merge); |
||||||
|
use HexGrid::Tile; |
||||||
|
use HexGrid::Region; |
||||||
|
use HexGrid::PopUp; |
||||||
|
use Carp; |
||||||
|
use Data::Dumper; |
||||||
|
|
||||||
|
use feature "signatures"; |
||||||
|
no warnings "experimental::signatures"; |
||||||
|
|
||||||
|
has regions => (is => 'rw', default => sub { {} }); |
||||||
|
has sideLength => (is => 'rw', default => 100); |
||||||
|
has width => (is => 'rw', default => 1000); |
||||||
|
has height => (is => 'rw', default => 1000); |
||||||
|
has defaults => (is => 'rw', default => sub { {} }); |
||||||
|
has make_popups => (is => 'rw', default => 1, alias => 'popups'); |
||||||
|
has popup_class => (is => 'rw', default => 'pin-popup'); |
||||||
|
has hidden_popups => (is => 'rw', default => 1, alias => 'popups_are_hidden'); |
||||||
|
|
||||||
|
sub tile_width($this) { 2 * $this->{sideLength} } |
||||||
|
sub tile_height($this) { sqrt(3) * $this->{sideLength} } |
||||||
|
|
||||||
|
#Hash::Merge::merge defaults to Left Precedence, i.e. merge first arg onto second arg |
||||||
|
|
||||||
|
sub add_region($this, $region) { $this->{regions}{$region->{name}} = $region; } |
||||||
|
sub make_region($this, $name, %defaults) |
||||||
|
{ |
||||||
|
my $tile_defaults = merge(\%defaults, $this->{defaults}); |
||||||
|
$this->add_region(HexGrid::Region->new(name => $name, defaults => $tile_defaults)); |
||||||
|
} |
||||||
|
|
||||||
|
sub get_tile_at($this, $nw, $sw) |
||||||
|
{ |
||||||
|
# return $this->{tiles}{$nw}{$sw} if exists $this->{tiles}{$nw}{$sw}; |
||||||
|
foreach my $region (keys $this->{regions}->%*) |
||||||
|
{ |
||||||
|
return $this->{regions}{$region}{tiles}{$nw}{$sw} if exists $this->{regions}{$region}{tiles}{$nw}{$sw}; |
||||||
|
} |
||||||
|
croak "No pin at $nw,$sw"; |
||||||
|
} |
||||||
|
|
||||||
|
sub render($this) |
||||||
|
{ |
||||||
|
my ($min_x,$min_y,$max_x,$max_y) = qw(Inf Inf -Inf -Inf); |
||||||
|
my $svg = SVG->new(); |
||||||
|
my $root_style = $svg->style(); |
||||||
|
my $style_text = ""; |
||||||
|
$style_text .= ".$this->{popup_class} { visibility: hidden; }" if $this->{hidden_popups}; |
||||||
|
$root_style->cdata($style_text); |
||||||
|
|
||||||
|
my $laters = []; |
||||||
|
foreach my $region (keys %{$this->{regions}}) |
||||||
|
{ |
||||||
|
my $m = $this->{regions}{$region}->render($svg, $laters, $this); |
||||||
|
|
||||||
|
$min_x = $m->{min_x} if $m->{min_x} < $min_x; |
||||||
|
$min_y = $m->{min_y} if $m->{min_y} < $min_y; |
||||||
|
$max_x = $m->{max_x} if $m->{max_x} > $max_x; |
||||||
|
$max_y = $m->{max_y} if $m->{max_y} > $max_y; |
||||||
|
} |
||||||
|
foreach my $later (@$laters) |
||||||
|
{ |
||||||
|
$later->($svg); |
||||||
|
} |
||||||
|
my $width = $max_x - $min_x + $this->tile_width; |
||||||
|
my $height = $max_y - $min_y + $this->tile_height; |
||||||
|
$svg->{-docref}{-document}{viewBox} = "$min_x $min_y $width $height"; |
||||||
|
$svg->{-docref}{-document}{width} = $this->{width}; |
||||||
|
$svg->{-docref}{-document}{height} = $this->{height}; |
||||||
|
$svg->{-docref}{-document}{preserveAspectRatio} = "xMidYMid"; |
||||||
|
$svg->{-docref}{-document}{id}='grid-root'; |
||||||
|
$svg->{-docref}{-document}{version}='1.2'; |
||||||
|
|
||||||
|
# $svg->tag('textArea', width => "300", height => "300")->cdata("this is sum text like a bunch."); |
||||||
|
# $svg->foreignObject(width => "300", height => "300")->tag('div', xmlns => "http://www.w3.org/1999/xhtml")->cdata('foo'); |
||||||
|
return $svg->xmlify; |
||||||
|
} |
||||||
|
|
||||||
|
sub translate_coords($this, $nw, $sw) |
||||||
|
{ |
||||||
|
return (-3/4 * $this->tile_width * ($nw + $sw), |
||||||
|
1/2 * $this->tile_height * ($sw - $nw)); |
||||||
|
} |
||||||
|
|
||||||
|
sub to_id($string) { $string =~ s/\W/-/g && return $string; } |
||||||
|
|
||||||
|
1; |
@ -0,0 +1,50 @@ |
|||||||
|
package HexGrid::Pin; |
||||||
|
|
||||||
|
use Moo; |
||||||
|
use MooX::Aliases; |
||||||
|
|
||||||
|
use feature "signatures"; |
||||||
|
no warnings "experimental::signatures"; |
||||||
|
|
||||||
|
has name => (is => 'rw'); |
||||||
|
has id => (is => 'ro', required => 1); |
||||||
|
has icon => (is => 'rw', alias => [qw(img source src)], required => 1); |
||||||
|
has link => (is => 'rw', alias => 'href'); |
||||||
|
has description => (is => 'rw', alias => 'desc'); |
||||||
|
|
||||||
|
has popup_class => (is => 'rw', default => 'pin-popup'); |
||||||
|
|
||||||
|
sub render($this, $pin_container, $x, $y, $w, $h, $laters = undef) |
||||||
|
{ |
||||||
|
my $element = $pin_container->image(href => $this->{icon}, |
||||||
|
x => $x, y => $y, width => $w, height => $h); |
||||||
|
$element->{id} = "$this->{id}-img"; |
||||||
|
$element->{onclick} = "clickPin('$this->{id}', '$pin_container->{id}');"; |
||||||
|
my $center_x = $x + $w/2; |
||||||
|
my $center_y = $y + $h/2; |
||||||
|
|
||||||
|
if(defined $laters) |
||||||
|
{ |
||||||
|
push @$laters, sub ($popup_container) { $this->render_popup($popup_container, |
||||||
|
$pin_container->{transform}, $center_x, $center_y); }; |
||||||
|
} |
||||||
|
return $element; |
||||||
|
} |
||||||
|
|
||||||
|
sub render_popup($this, $popup_container, $transform, $x_shift, $y_shift) |
||||||
|
{ |
||||||
|
my $popup_scaler = $popup_container-> |
||||||
|
g(id => "$this->{id}-popup",transform => $transform, class => $this->{popup_class})-> |
||||||
|
svg(id => "$this->{id}-scaler"); |
||||||
|
my $popup = new HexGrid::PopUp |
||||||
|
( |
||||||
|
name => $this->{name}, |
||||||
|
description => $this->{description}, |
||||||
|
link => $this->{link} |
||||||
|
); |
||||||
|
my $popup_element = $popup->render($popup_scaler); |
||||||
|
$popup_element->{x} = $x_shift - $popup->{origin_x}; |
||||||
|
$popup_element->{y} = $y_shift - $popup_element->{height}; |
||||||
|
} |
||||||
|
|
||||||
|
1; |
@ -0,0 +1,74 @@ |
|||||||
|
package HexGrid::PopUp; |
||||||
|
|
||||||
|
use v5.30; |
||||||
|
|
||||||
|
use Moo; |
||||||
|
use Text::Wrap::OO; |
||||||
|
use Data::Dumper; |
||||||
|
|
||||||
|
use feature "signatures"; |
||||||
|
no warnings "experimental::signatures"; |
||||||
|
|
||||||
|
has width => (is => 'rw', default => 600); |
||||||
|
has height => (is => 'rw', default => 750); |
||||||
|
has origin_x => (is => 'rw', default => 0); |
||||||
|
has origin_y => (is => 'rw', default => 100); |
||||||
|
has corner_radius => (is => 'rw', default => 20); |
||||||
|
has gap_start => (is => 'rw', default => 40); |
||||||
|
has gap_width => (is => 'rw', default => 40); |
||||||
|
has name => (is => 'rw'); |
||||||
|
has link => (is => 'rw', alias => 'href'); |
||||||
|
has description => (is => 'rw', alias => 'desc'); |
||||||
|
has margin => (is => 'rw', default => 20); |
||||||
|
has 'stroke-width' => (is => 'rw', default => 2); |
||||||
|
|
||||||
|
sub render($this, $scaler) |
||||||
|
{ |
||||||
|
my %t = %$this; |
||||||
|
my $gap_end = $t{gap_start} + $t{gap_width}; |
||||||
|
|
||||||
|
$scaler->{width} = $t{width}; |
||||||
|
$scaler->{height} = $t{height}; |
||||||
|
$scaler->{viewBox} = "0 0 $t{width} $t{height}"; |
||||||
|
my $box_height = $t{height} - $t{origin_y}; |
||||||
|
|
||||||
|
my $path_string = _M($t{gap_start},$box_height); |
||||||
|
$path_string .= _L($t{origin_x},$t{height}); |
||||||
|
$path_string .= _L($gap_end,$box_height); |
||||||
|
$path_string .= _l($t{width} - $gap_end - $t{corner_radius}, 0); |
||||||
|
$path_string .= _a($t{corner_radius}, $t{corner_radius}, 0, 0, 0, $t{corner_radius}, -$t{corner_radius}); |
||||||
|
$path_string .= _l(0, -($box_height - 2*$t{corner_radius})); |
||||||
|
$path_string .= _a($t{corner_radius}, $t{corner_radius}, 0, 0, 0, -$t{corner_radius}, -$t{corner_radius}); |
||||||
|
$path_string .= _l(-($t{width} - 2*$t{corner_radius}),0); |
||||||
|
$path_string .= _a($t{corner_radius}, $t{corner_radius}, 0, 0, 0, -$t{corner_radius}, $t{corner_radius}); |
||||||
|
$path_string .= _l(0, ($box_height - 2*$t{corner_radius})); |
||||||
|
$path_string .= _a($t{corner_radius}, $t{corner_radius}, 0, 0, 0, $t{corner_radius}, $t{corner_radius}); |
||||||
|
$path_string .= " Z"; |
||||||
|
my $path = $scaler->path(d => $path_string, stroke => 'black', fill => 'white', 'stroke-width' => $t{'stroke-width'}); |
||||||
|
my $content_container = $scaler->g(transform => "translate($t{margin},$t{margin})"); |
||||||
|
my $obj = $content_container->foreignObject(width => ($t{width} - 2*$t{margin}), height => $box_height - 2*$t{margin}); |
||||||
|
basic_popup($obj, $t{name}, $t{description}, $t{link}); |
||||||
|
return $scaler; |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
sub _M { " M " . join(",", @_); } |
||||||
|
sub _L { " L " . join(",", @_); } |
||||||
|
sub _l { " l " . join(",", @_); } |
||||||
|
sub _a { " a $_[0],$_[1] $_[2] $_[3] $_[4] $_[5],$_[6]"; } |
||||||
|
|
||||||
|
|
||||||
|
# Split this out |
||||||
|
sub basic_popup($obj, $name, $description, $link) |
||||||
|
{ |
||||||
|
my $div = $obj->tag('div', xmlns => "http://www.w3.org/1999/xhtml"); |
||||||
|
$div->tag('h3', style => 'margin-top: 0; margin-left: 0;')->tag('a', href => $link)->cdata($name); |
||||||
|
foreach (split /\n/, $description) |
||||||
|
{ |
||||||
|
/^\s*$/ |
||||||
|
? $div->tag('br')->cdata |
||||||
|
: $div->tag('span')->cdata($_); |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
1; |
@ -0,0 +1,66 @@ |
|||||||
|
package HexGrid::Region; |
||||||
|
|
||||||
|
use v5.30; |
||||||
|
|
||||||
|
use Moo; |
||||||
|
use MooX::Aliases; |
||||||
|
use Hash::Merge qw(merge); |
||||||
|
use HexGrid::Tile; |
||||||
|
use Data::Dumper; |
||||||
|
|
||||||
|
use feature "signatures"; |
||||||
|
no warnings "experimental::signatures"; |
||||||
|
|
||||||
|
has tiles => (is => 'rw', default => sub { {} }); |
||||||
|
has subregions => (is => 'rw', default => sub { {} }); |
||||||
|
has name => (is => 'rw', required => 1); |
||||||
|
has defaults => (is => 'rw', default => sub { {} }); |
||||||
|
has id_suffix => (is => 'rw', default => '_region'); |
||||||
|
|
||||||
|
sub add_tile($this, $tile) { $this->{tiles}{$tile->{nw}}{$tile->{sw}} = $tile; } |
||||||
|
sub make_tile_at($this, $nw, $sw, %tile_settings) |
||||||
|
{ |
||||||
|
my %settings = %{merge(\%tile_settings, $this->{defaults})}; |
||||||
|
# say STDERR Dumper(\%settings); |
||||||
|
$settings{css_class} = HexGrid::to_id($this->{name}); |
||||||
|
$this->add_tile(HexGrid::Tile::at($nw, $sw, %settings)); |
||||||
|
} |
||||||
|
|
||||||
|
sub add_subregion($this, $region) { $this->{subregions}{$region->{name}} = $region; } |
||||||
|
sub make_subregion($this, $name, %defaults) |
||||||
|
{ |
||||||
|
my $tile_defaults = merge(\%defaults, $this->{defaults}); |
||||||
|
$this->add_subregion(HexGrid::Region->new(name => $name, defaults => $tile_defaults)); |
||||||
|
} |
||||||
|
|
||||||
|
sub render($this, $svg, $laters, $grid) |
||||||
|
{ |
||||||
|
my ($min_x,$min_y,$max_x,$max_y) = qw(Inf Inf -Inf -Inf); |
||||||
|
my $g = $svg->g(id => HexGrid::to_id("$this->{name}$this->{id_suffix}")); |
||||||
|
foreach my $nw (keys %{$this->{tiles}}) |
||||||
|
{ |
||||||
|
foreach my $sw (keys %{$this->{tiles}{$nw}}) |
||||||
|
{ |
||||||
|
my ($x_translate, $y_translate) = $grid->translate_coords($nw, $sw); |
||||||
|
my $tile_group = $this->{tiles}{$nw}{$sw}->render($g, $grid->tile_width, $grid->tile_height, $laters); |
||||||
|
$tile_group->{transform} = "translate($x_translate, $y_translate)"; |
||||||
|
|
||||||
|
$min_x = $x_translate if $x_translate < $min_x; |
||||||
|
$min_y = $y_translate if $y_translate < $min_y; |
||||||
|
$max_x = $x_translate if $x_translate > $max_x; |
||||||
|
$max_y = $y_translate if $y_translate > $max_y; |
||||||
|
} |
||||||
|
} |
||||||
|
foreach my $region (keys %{$this->{subregions}}) |
||||||
|
{ |
||||||
|
my $m = $this->{subregions}{$region}->render($svg, $laters, $grid); |
||||||
|
|
||||||
|
$min_x = $m->{min_x} if $m->{min_x} < $min_x; |
||||||
|
$min_y = $m->{min_y} if $m->{min_y} < $min_y; |
||||||
|
$max_x = $m->{max_x} if $m->{max_x} > $max_x; |
||||||
|
$max_y = $m->{max_y} if $m->{max_y} > $max_y; |
||||||
|
} |
||||||
|
return { min_x => $min_x,min_y => $min_y,max_x => $max_x,max_y => $max_y, group => $g }; |
||||||
|
} |
||||||
|
|
||||||
|
1; |
@ -0,0 +1,150 @@ |
|||||||
|
package HexGrid::Tile; |
||||||
|
|
||||||
|
use v5.30; |
||||||
|
|
||||||
|
use Moo; |
||||||
|
use MooX::Aliases; |
||||||
|
use Carp; |
||||||
|
use HexGrid::Pin; |
||||||
|
use Data::Dumper; |
||||||
|
|
||||||
|
use feature "signatures"; |
||||||
|
no warnings "experimental::signatures"; |
||||||
|
|
||||||
|
|
||||||
|
has nw => (is => 'ro', required => 1); |
||||||
|
has sw => (is => 'ro', required => 1); |
||||||
|
|
||||||
|
has style => (is => 'rw'); |
||||||
|
has colour => (is => 'rw', alias => 'color'); |
||||||
|
has opacity => (is => 'rw'); |
||||||
|
has images => (is => 'rw', alias => [qw(image background backgrounds)]); |
||||||
|
has show_coords => (is => 'rw'); |
||||||
|
has css_class => (is => 'rw'); |
||||||
|
has id_suffix => (is => 'rw', default => '_tile'); |
||||||
|
|
||||||
|
my %docks = ( #values are fractions of the height/width |
||||||
|
sw => { order => 1, x => 0, y => 0.5, w => 0.5, h => 0.5 }, |
||||||
|
se => { order => 2, x => 0.5, y => 0.5, w => 0.5, h => 0.5 }, |
||||||
|
n => { order => 3, x => 0.25, y => 0, w => 0.5, h => 0.5 }, |
||||||
|
); |
||||||
|
has pins => (is => 'rw', default => sub { +{ map {$_ => undef} keys %docks } }); |
||||||
|
|
||||||
|
# Class |
||||||
|
|
||||||
|
|
||||||
|
sub at($nw,$sw,@rest) |
||||||
|
{ |
||||||
|
return HexGrid::Tile->new(nw => $nw, sw => $sw, @rest); |
||||||
|
} |
||||||
|
|
||||||
|
sub hex_path($w, $h) |
||||||
|
{ |
||||||
|
# More readable for me at least as a sequence of points than as two sequences |
||||||
|
my @points = ([0, $h/2], [$w*1/4, 0], [$w*3/4, 0], [$w, $h/2], [$w*3/4, $h], [$w*1/4, $h]); |
||||||
|
return join " ", (map {join ",", @$_} @points); |
||||||
|
} |
||||||
|
|
||||||
|
# Instance |
||||||
|
|
||||||
|
sub pin($this, $pin, $dock = undef) |
||||||
|
{ |
||||||
|
if(ref $pin eq 'HexGrid::Pin') |
||||||
|
{ |
||||||
|
$this->_do_pin($pin, $dock); |
||||||
|
} |
||||||
|
elsif(ref $pin eq 'ARRAY') |
||||||
|
{ |
||||||
|
map $this->_do_pin($_), @$pin; |
||||||
|
} |
||||||
|
elsif(ref $pin eq 'HASH') |
||||||
|
{ |
||||||
|
foreach my $dock (keys %$pin) |
||||||
|
{ |
||||||
|
croak "dock $dock doesn't exist" unless grep { $_ eq $dock } keys %docks; |
||||||
|
$this->{pins}{$dock} = $pin->{$dock}; |
||||||
|
} |
||||||
|
return; |
||||||
|
} |
||||||
|
else |
||||||
|
{ |
||||||
|
croak "bad pin type"; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
sub _do_pin($this, $pin, $dock = undef) |
||||||
|
{ |
||||||
|
if($dock) |
||||||
|
{ |
||||||
|
croak "bad dock" unless $dock =~ /^sw|se|n$/i; |
||||||
|
$this->{pins}{$dock} = $pin; |
||||||
|
} |
||||||
|
else |
||||||
|
{ |
||||||
|
my $success = 0; |
||||||
|
DOCK: foreach my $dock (sort { $docks{$a}->{order} <=> $docks{$b}->{order} } (keys %docks)) |
||||||
|
{ |
||||||
|
# say STDERR Dumper($dock); |
||||||
|
unless(defined $this->{pins}{$dock}) |
||||||
|
{ |
||||||
|
$this->{pins}{$dock} = $pin; |
||||||
|
$success = 1; |
||||||
|
last DOCK; |
||||||
|
} |
||||||
|
} |
||||||
|
croak "no free dock" unless $success; |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
sub render($this, $container, $width, $height, $laters = undef) |
||||||
|
{ |
||||||
|
my $g = $container->g( |
||||||
|
id => HexGrid::to_id("$this->{nw}_$this->{sw}$this->{id_suffix}"), |
||||||
|
); |
||||||
|
# $g->{onclick} = "say('($this->{nw},$this->{sw})')"; |
||||||
|
my $hex = $g->polygon(points => hex_path($width, $height), |
||||||
|
id => "$this->{nw}_$this->{sw}_inner_hex", style => $this->{style} || {}); |
||||||
|
my $clipPath = $g->clipPath(id => "$this->{nw}_$this->{sw}_clip"); |
||||||
|
$clipPath->use(href => "#$hex->{id}"); |
||||||
|
|
||||||
|
if($this->{colour}) |
||||||
|
{ |
||||||
|
$hex->{fill} = $this->{colour}; |
||||||
|
} |
||||||
|
if(defined($this->{images})) |
||||||
|
{ |
||||||
|
$this->{images} = [$this->{images}] if ref($this->{images}) ne 'ARRAY'; |
||||||
|
foreach my $image ($this->{images}->@*) |
||||||
|
{ |
||||||
|
my $image_element = $g->image(id => "$this->{nw}_$this->{sw}_${image}_img", |
||||||
|
href => $image, width => $width, height => $height, |
||||||
|
"clip-path" => "url(#$clipPath->{id})"); |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
if(defined($this->{opacity})) { $hex->{'fill-opacity'} = $this->{opacity}; } |
||||||
|
if($this->{show_coords}) |
||||||
|
{ |
||||||
|
my $text = $g->text(x => "@{[0.1 * $width]}", y => "@{[0.6 * $height]}", class => 'coords'); |
||||||
|
$text->{'font-size'} = '3em'; |
||||||
|
$text->cdata("$this->{nw},$this->{sw}"); |
||||||
|
} |
||||||
|
if(defined $this->{css_class}) { $g->{class} = $this->{css_class} } |
||||||
|
if(defined $this->{pins}) |
||||||
|
{ |
||||||
|
foreach my $key (keys $this->{pins}->%*) |
||||||
|
{ |
||||||
|
next unless defined $this->{pins}{$key}; |
||||||
|
my $x = $width * $docks{$key}->{x}; |
||||||
|
my $w = $width * $docks{$key}->{w}; |
||||||
|
my $y = $height * $docks{$key}->{y}; |
||||||
|
my $h = $height * $docks{$key}->{h}; |
||||||
|
|
||||||
|
my $image_element = $this->{pins}{$key}->render($g, $x, $y, $w, $h, $laters); |
||||||
|
$image_element->{"clip-path"} = "url(#$clipPath->{id})"; |
||||||
|
} |
||||||
|
} |
||||||
|
return $g; |
||||||
|
} |
||||||
|
|
||||||
|
1; |
@ -0,0 +1,22 @@ |
|||||||
|
package MWTemplate; |
||||||
|
|
||||||
|
use v5.30; |
||||||
|
|
||||||
|
use feature "signatures"; |
||||||
|
no warnings "experimental::signatures"; |
||||||
|
|
||||||
|
sub Parse($input, $template_name) |
||||||
|
{ |
||||||
|
my ($contents) = $input =~ /\{\{ \s* $template_name \s* \| (.*) \}\}/sx; |
||||||
|
my @params = split /\|/, $contents; |
||||||
|
my @positional_params; |
||||||
|
my %named_params; |
||||||
|
foreach (@params) |
||||||
|
{ |
||||||
|
if(/(.*?)=(.*)/) { $named_params{$1} = $2 } |
||||||
|
else { push @positional_params, $_ } |
||||||
|
} |
||||||
|
return {positional_params => \@positional_params, named_params => \%named_params}; |
||||||
|
} |
||||||
|
|
||||||
|
1; |
@ -0,0 +1,82 @@ |
|||||||
|
use v5.30; |
||||||
|
|
||||||
|
use HexGrid; |
||||||
|
use Carp; |
||||||
|
use Data::Dumper; |
||||||
|
|
||||||
|
my $grid = HexGrid->new(defaults => { style => { 'stroke-width' => 1, 'stroke' => 'black' }, show_coords => 1 }); |
||||||
|
|
||||||
|
$grid->make_region("Viper's Gate", colour => 'red'); |
||||||
|
my $adderwall = $grid->make_region('Adderwall', colour => 'orange'); |
||||||
|
# $adderwall->make_subregion('Adderwall foothills', colour => 'moccasin'); |
||||||
|
$grid->make_region('Adderwall foothills', colour => 'moccasin'); |
||||||
|
$grid->make_region('Midhills', colour => 'moccasin'); |
||||||
|
# $grid->make_region('Minev', colour => 'green', images => ["forest-tile.png"]); |
||||||
|
$grid->make_region('Minev', colour => 'green'); |
||||||
|
$grid->make_region('Barrowcross', colour => 'darkgreen'); |
||||||
|
$grid->make_region('Shinei Mavet', colour => 'orange'); |
||||||
|
$grid->make_region('Jagged Shinei Mavet', colour => 'orange'); |
||||||
|
$grid->make_region('Shinei Mavet waters', colour => 'lightcyan'); |
||||||
|
# $grid->make_region('Shinei Mavet', colour => 'orange', image => 'mountain.svg'); |
||||||
|
# $grid->make_region('Jagged Shinei Mavet', colour => 'orange', images => ['mountain.svg', 'jagged.svg']); |
||||||
|
# $grid->make_region('Shinei Mavet waters', colour => 'lightcyan', image => 'foo.png'); |
||||||
|
$grid->make_region('Southern Ocean', colour => 'skyblue'); |
||||||
|
$grid->make_region('A volcano', colour => 'orange'); |
||||||
|
$grid->make_region('Buslish Scrubs', colour => 'beige'); |
||||||
|
$grid->make_region('The Blasted Metropolis', colour => 'gray'); |
||||||
|
$grid->make_region('The sprawling grasses', colour => 'beige'); |
||||||
|
$grid->make_region('Something sandy?', colour => 'navajowhite'); |
||||||
|
$grid->make_region('Necromancer', colour => 'orange'); |
||||||
|
$grid->make_region('The Narrow Sea', colour => 'skyblue'); |
||||||
|
$grid->make_region('Naurardhon', colour => 'palegoldenrod'); |
||||||
|
$grid->make_region('The Glades of Leamingbury', colour => 'lightgreen'); |
||||||
|
$grid->make_region('Cape of Lost Causes', colour => 'gray'); |
||||||
|
$grid->make_region('Deadlands', colour => 'black'); |
||||||
|
$grid->make_region('Deadlands', colour => 'black'); |
||||||
|
$grid->make_region('Glade borders', colour => 'mediumaquamarine'); |
||||||
|
$grid->make_region('Thicket', colour => 'darkgreen'); |
||||||
|
$grid->make_region('Random house', colour => 'darkgreen'); |
||||||
|
$grid->make_region('Abbey of Plendor', colour => 'beige'); |
||||||
|
$grid->make_region('Khulanu', opacity => '0', style => { 'stroke-width' => 5, 'stroke' => 'black' }); |
||||||
|
|
||||||
|
my $tiles; |
||||||
|
open $tiles, "$ENV{HOME}/RPG-stuff/WestOfVipers/coordinate-mapping"; |
||||||
|
|
||||||
|
my $region; |
||||||
|
my $region_file; |
||||||
|
start_region(); |
||||||
|
while(my $coords = <$tiles>) |
||||||
|
{ |
||||||
|
if ($coords =~ /^\s*$/) |
||||||
|
{ |
||||||
|
start_region(); |
||||||
|
next; |
||||||
|
} |
||||||
|
print $region_file $coords if $coords; |
||||||
|
} |
||||||
|
close $region_file if $region_file; |
||||||
|
|
||||||
|
sub start_region |
||||||
|
{ |
||||||
|
close $region_file if $region_file; |
||||||
|
$region = <$tiles>; |
||||||
|
chomp($region); |
||||||
|
my $encoded_region = $region; |
||||||
|
$encoded_region =~ s/\W/_/g; |
||||||
|
open $region_file, ">region_files/$encoded_region" || croak "Can't open file for $region: $!"; |
||||||
|
say $region_file "== Style =="; |
||||||
|
foreach my $key (keys %{$grid->{regions}{$region}{defaults}}) |
||||||
|
{ |
||||||
|
next if $key eq 'style'; |
||||||
|
say $region_file "$key: $grid->{regions}{$region}{defaults}{$key}"; |
||||||
|
} |
||||||
|
if(my $css = $grid->{regions}{$region}{defaults}{style}) |
||||||
|
{ |
||||||
|
say $region_file "\n=== CSS ==="; |
||||||
|
foreach my $key (keys %{$grid->{regions}{$region}{defaults}{style}}) |
||||||
|
{ |
||||||
|
say $region_file "$key: $grid->{regions}{$region}{defaults}{style}{$key}"; |
||||||
|
} |
||||||
|
} |
||||||
|
say $region_file "\n== Tiles =="; |
||||||
|
} |
@ -0,0 +1,37 @@ |
|||||||
|
use v5.30; |
||||||
|
|
||||||
|
# use Getopt::Long; |
||||||
|
use SVG; |
||||||
|
|
||||||
|
my $width = 400; |
||||||
|
my $height = 300; |
||||||
|
my $origin_x = 0; |
||||||
|
my $origin_height = 100; |
||||||
|
my $corner_radius = 25; |
||||||
|
my $gap_start = 50; |
||||||
|
my $gap_width = 50; |
||||||
|
|
||||||
|
my $full_height = $height + $origin_height; |
||||||
|
|
||||||
|
my $svg = SVG->new(width => $width, height => $full_height, viewBox => "0 0 $width $full_height"); |
||||||
|
|
||||||
|
my $path_string = "M $gap_start,$height"; |
||||||
|
$path_string .= L($origin_x,$full_height); |
||||||
|
$path_string .= L($gap_start + $gap_width,$height); |
||||||
|
$path_string .= L($width - $corner_radius, $height); |
||||||
|
$path_string .= a($corner_radius, $corner_radius, 0, 0, 0, $corner_radius, -$corner_radius); |
||||||
|
$path_string .= l(0, -($height - 2*$corner_radius)); |
||||||
|
$path_string .= a($corner_radius, $corner_radius, 0, 0, 0, -$corner_radius, -$corner_radius); |
||||||
|
$path_string .= l(-($width - 2*$corner_radius),0); |
||||||
|
$path_string .= a($corner_radius, $corner_radius, 0, 0, 0, -$corner_radius, $corner_radius); |
||||||
|
$path_string .= l(0, ($height - 2*$corner_radius)); |
||||||
|
$path_string .= a($corner_radius, $corner_radius, 0, 0, 0, $corner_radius, $corner_radius); |
||||||
|
|
||||||
|
$path_string .= " Z"; |
||||||
|
my $path = $svg->path(d => $path_string, stroke => 'black', fill => 'white'); |
||||||
|
|
||||||
|
say $svg->render(); |
||||||
|
|
||||||
|
sub L { " L " . join(",", @_); } |
||||||
|
sub l { " l " . join(",", @_); } |
||||||
|
sub a { " a $_[0],$_[1] $_[2] $_[3] $_[4] $_[5],$_[6]"; } |
After Width: | Height: | Size: 948 B |
After Width: | Height: | Size: 861 B |
After Width: | Height: | Size: 431 B |
After Width: | Height: | Size: 195 B |
After Width: | Height: | Size: 182 B |
After Width: | Height: | Size: 1.4 KiB |
After Width: | Height: | Size: 582 B |
@ -0,0 +1,127 @@ |
|||||||
|
use v5.30; |
||||||
|
|
||||||
|
use HexGrid; |
||||||
|
use HexGrid::Pin; |
||||||
|
use Data::Dumper; |
||||||
|
|
||||||
|
use Text::Lorem; |
||||||
|
my $lorem = Text::Lorem->new; |
||||||
|
|
||||||
|
# my $adder_pin = new HexGrid::Pin(id => 'mountain-pin', icon => 'mountain.svg', name => 'Adder', description => $lorem->sentences(1)); |
||||||
|
my $grid = HexGrid->new(defaults => { style => { 'stroke-width' => 1, 'stroke' => 'black' }, show_coords => 1 }); |
||||||
|
|
||||||
|
$grid->make_region("Viper's Gate", colour => 'red'); |
||||||
|
# $grid->make_region('Adderwall', colour => 'orange', pins => {n => $adder_pin}); |
||||||
|
my $adderwall = $grid->make_region('Adderwall', colour => 'orange'); |
||||||
|
# $adderwall->make_subregion('Adderwall foothills', colour => 'moccasin'); |
||||||
|
$grid->make_region('Adderwall foothills', colour => 'moccasin'); |
||||||
|
$grid->make_region('Midhills', colour => 'moccasin'); |
||||||
|
# $grid->make_region('Minev', colour => 'green', images => ["forest-tile.png"]); |
||||||
|
$grid->make_region('Minev', colour => 'green'); |
||||||
|
$grid->make_region('Barrowcross', colour => 'darkgreen'); |
||||||
|
$grid->make_region('Shinei Mavet', colour => 'orange'); |
||||||
|
$grid->make_region('Jagged Shinei Mavet', colour => 'orange'); |
||||||
|
$grid->make_region('Shinei Mavet waters', colour => 'lightcyan'); |
||||||
|
# $grid->make_region('Shinei Mavet', colour => 'orange', image => 'mountain.svg'); |
||||||
|
# $grid->make_region('Jagged Shinei Mavet', colour => 'orange', images => ['mountain.svg', 'jagged.svg']); |
||||||
|
# $grid->make_region('Shinei Mavet waters', colour => 'lightcyan', image => 'foo.png'); |
||||||
|
$grid->make_region('Southern Ocean', colour => 'skyblue'); |
||||||
|
$grid->make_region('A volcano', colour => 'orange'); |
||||||
|
$grid->make_region('Buslish Scrubs', colour => 'beige'); |
||||||
|
$grid->make_region('The Blasted Metropolis', colour => 'gray'); |
||||||
|
$grid->make_region('The sprawling grasses', colour => 'beige'); |
||||||
|
$grid->make_region('Something sandy?', colour => 'navajowhite'); |
||||||
|
$grid->make_region('Necromancer', colour => 'orange'); |
||||||
|
$grid->make_region('The Narrow Sea', colour => 'skyblue'); |
||||||
|
$grid->make_region('Naurardhon', colour => 'palegoldenrod'); |
||||||
|
$grid->make_region('The Glades of Leamingbury', colour => 'lightgreen'); |
||||||
|
$grid->make_region('Cape of Lost Causes', colour => 'gray'); |
||||||
|
$grid->make_region('Deadlands', colour => 'black'); |
||||||
|
$grid->make_region('Deadlands', colour => 'black'); |
||||||
|
$grid->make_region('Glade borders', colour => 'mediumaquamarine'); |
||||||
|
$grid->make_region('Thicket', colour => 'darkgreen'); |
||||||
|
$grid->make_region('Random house', colour => 'darkgreen'); |
||||||
|
$grid->make_region('Abbey of Plendor', colour => 'beige'); |
||||||
|
$grid->make_region('Khulanu', opacity => '0', style => { 'stroke-width' => 5, 'stroke' => 'black' }); |
||||||
|
|
||||||
|
my $tiles; |
||||||
|
open $tiles, "$ENV{HOME}/RPG-stuff/WestOfVipers/coordinate-mapping"; |
||||||
|
|
||||||
|
my $region = <$tiles>; |
||||||
|
chomp($region); |
||||||
|
while(my $coords = <$tiles>) |
||||||
|
{ |
||||||
|
if ($coords =~ /^\s*$/) |
||||||
|
{ |
||||||
|
$region = <$tiles>; |
||||||
|
chomp($region); |
||||||
|
next; |
||||||
|
} |
||||||
|
chomp $coords; |
||||||
|
my %settings; |
||||||
|
if($coords =~ /:$/) |
||||||
|
{ |
||||||
|
for(my $line = <$tiles>; $line !~ /^;/; $line = <$tiles>) |
||||||
|
{ |
||||||
|
my($key, $val) = split /:/, $line; |
||||||
|
$settings{$key} = $val; |
||||||
|
} |
||||||
|
chop($coords); |
||||||
|
} |
||||||
|
my ($nw,$sw) = split /,/, $coords; |
||||||
|
my $tile = $grid->{regions}{$region}->make_tile_at($nw, $sw, %settings); |
||||||
|
if($region eq "Necromancer") |
||||||
|
{ |
||||||
|
$tile->pin(new HexGrid::Pin(id => "circle-pin", icon => "foo2.svg", name => "zap", description => scalar $lorem->paragraphs(4), href => 'http://www.tensor.green')); |
||||||
|
} |
||||||
|
} |
||||||
|
|
||||||
|
close $tiles; |
||||||
|
|
||||||
|
# $grid->get_tile_at(0,0)->pin( |
||||||
|
# $grid->{regions}{"Viper's Gate"}{tiles}{0}{0}->pin( |
||||||
|
# { |
||||||
|
# 'n' => new HexGrid::Pin(icon => "1"), |
||||||
|
# 'se' => new HexGrid::Pin(icon => "2"), |
||||||
|
# 'sw' => new HexGrid::Pin(icon => "3") |
||||||
|
# } |
||||||
|
# ); |
||||||
|
|
||||||
|
# $grid->get_tile_at(0,0)->pin( |
||||||
|
# new HexGrid::Pin(icon => "foo2.svg"), |
||||||
|
# 'se' |
||||||
|
# ); |
||||||
|
# $grid->get_tile_at(0,0)->pin( |
||||||
|
# new HexGrid::Pin(icon => "mountain.svg") |
||||||
|
# ); |
||||||
|
# $grid->get_tile_at(0,0)->pin( |
||||||
|
# new HexGrid::Pin(icon => "foo2.svg") |
||||||
|
# ); |
||||||
|
# $grid->{regions}{"Viper's Gate"}{tiles}{0}{0}->pin( |
||||||
|
# new HexGrid::Pin(icon => "2") |
||||||
|
# ); |
||||||
|
# $grid->{regions}{"Viper's Gate"}{tiles}{0}{0}->pin( |
||||||
|
# new HexGrid::Pin(icon => "3"), |
||||||
|
# 'sw' |
||||||
|
# ); |
||||||
|
|
||||||
|
say "<!DOCTYPE html>"; |
||||||
|
say "<html>\n<body>"; |
||||||
|
say <<EOS; |
||||||
|
<script> |
||||||
|
function clickPin(pinId, containerId) { |
||||||
|
let popup = document.getElementById(pinId + '-popup'); |
||||||
|
popup.style.visibility = popup.style.visibility == 'visible' ? 'hidden' : 'visible'; |
||||||
|
} |
||||||
|
</script> |
||||||
|
EOS |
||||||
|
say $grid->render; |
||||||
|
# $grid->render; |
||||||
|
say "</body>\n</html>"; |
||||||
|
|
||||||
|
sub random_colour |
||||||
|
{ |
||||||
|
my $str = '#'; |
||||||
|
$str .= sprintf('%02X', int(rand(256))) for 1..3; |
||||||
|
return $str; |
||||||
|
} |
@ -0,0 +1,109 @@ |
|||||||
|
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; |
||||||
|
} |
@ -0,0 +1,132 @@ |
|||||||
|
use v5.30; |
||||||
|
|
||||||
|
use MediaWiki::API; |
||||||
|
use HexGrid; |
||||||
|
use HexGrid::Pin; |
||||||
|
use MWTemplate; |
||||||
|
use Carp; |
||||||
|
|
||||||
|
use Data::Dumper; |
||||||
|
$Data::Dumper::Indent = 1; |
||||||
|
|
||||||
|
use feature "signatures"; |
||||||
|
no warnings "experimental::signatures"; |
||||||
|
|
||||||
|
my $api_url = "https://wiki.tensor.green/w/api.php"; |
||||||
|
my $region_template_name = "MapRegion"; |
||||||
|
my $site_template_name = "MapSite"; |
||||||
|
|
||||||
|
my $border_width = 1; |
||||||
|
my $border_colour = 'black'; |
||||||
|
my $show_coords = 1; |
||||||
|
|
||||||
|
my $grid = HexGrid->new(defaults => { |
||||||
|
style => { 'stroke-width' => $border_width, stroke => $border_colour }, |
||||||
|
show_coords => $show_coords }); |
||||||
|
my $mw = MediaWiki::API->new(); |
||||||
|
$mw->{config}->{api_url} = $api_url; |
||||||
|
|
||||||
|
my $region_pages = $mw->list ( { |
||||||
|
action => 'query', |
||||||
|
list => 'categorymembers', |
||||||
|
cmtitle => 'Category:Regions', |
||||||
|
cmlimit => 'max' } ) |
||||||
|
|| croak $mw->{error}->{code} . ': ' . $mw->{error}->{details}; |
||||||
|
|
||||||
|
say STDERR "Regions found: " . join(", ", map { $_->{title} } @$region_pages); |
||||||
|
|
||||||
|
foreach my $region_page_ref (@$region_pages) |
||||||
|
{ |
||||||
|
my $region_name = $region_page_ref->{title}; |
||||||
|
say STDERR "Processing Region: $region_name"; |
||||||
|
my $region_page = $mw->get_page({ title => $region_name }); |
||||||
|
my $tile_page = $mw->get_page({ title => "$region_name/Tiles" }); |
||||||
|
process_region($grid, $region_name, $region_page->{'*'}, $tile_page->{'*'}); |
||||||
|
} |
||||||
|
|
||||||
|
my $site_query_results = $mw->api |
||||||
|
( { |
||||||
|
action => 'query', |
||||||
|
generator => 'categorymembers', |
||||||
|
prop => 'info|revisions', |
||||||
|
gcmtitle => 'Category:Sites', |
||||||
|
gcmlimit => 'max', |
||||||
|
rvprop => 'content', |
||||||
|
inprop => 'url', |
||||||
|
} ) || croak $mw->{error}->{code} . ': ' . $mw->{error}->{details}; |
||||||
|
|
||||||
|
# say STDERR "Sites found: " . join(" ,", map { $_->{title} } @$site_pages); |
||||||
|
# say STDERR Dumper($site_query_results); |
||||||
|
foreach my $site_page_ref (values %{$site_query_results->{query}{pages}}) |
||||||
|
{ |
||||||
|
say STDERR Dumper($site_page_ref); |
||||||
|
my $site_name = $site_page_ref->{title}; |
||||||
|
say STDERR "Processing Site $site_name"; |
||||||
|
my $site_url = $site_page_ref->{canonicalurl}; |
||||||
|
my $site_content = $site_page_ref->{revisions}[0]{'*'}; |
||||||
|
my $parsed_template = MWTemplate::Parse($site_content, $site_template_name); |
||||||
|
my ($nw,$sw) = split /,/, $parsed_template->{named_params}{coords}; |
||||||
|
|
||||||
|
my $imageinfo_query_results = $mw->api({ action => 'query', |
||||||
|
prop => 'imageinfo', |
||||||
|
titles => "File:$parsed_template->{named_params}{icon}", |
||||||
|
iiprop => 'url' |
||||||
|
}) || carp $mw->{error}->{code} . ': ' . $mw->{error}->{details}; |
||||||
|
my %image_pages = %{$imageinfo_query_results->{query}{pages}}; |
||||||
|
my $image_url = (values %image_pages)[0]{imageinfo}[0]{url}; |
||||||
|
|
||||||
|
my $pin = HexGrid::Pin->new |
||||||
|
( |
||||||
|
name => $site_name, |
||||||
|
id => "${site_name}_pin", |
||||||
|
icon => $image_url, |
||||||
|
link => $site_url, |
||||||
|
description => $parsed_template->{named_params}{abstract} |
||||||
|
); |
||||||
|
# say STDERR Dumper($pin); |
||||||
|
$grid->get_tile_at($nw, $sw)->pin($pin); |
||||||
|
} |
||||||
|
|
||||||
|
say wrap_in_html($grid); |
||||||
|
|
||||||
|
sub process_region($grid, $region_name, $region_spec, $tiles) |
||||||
|
{ |
||||||
|
my $region = $grid->make_region($region_name); |
||||||
|
my $parsed_template = MWTemplate::Parse($region_spec, $region_template_name); |
||||||
|
$region->{defaults}{colour} = $parsed_template->{named_params}{colour}; |
||||||
|
my $image_info = $mw->api({ action => 'query', |
||||||
|
prop => 'imageinfo', |
||||||
|
titles => "File:$parsed_template->{named_params}{background}", |
||||||
|
iiprop => 'url' |
||||||
|
}) || carp $mw->{error}->{code} . ': ' . $mw->{error}->{details}; |
||||||
|
$region->{defaults}{image} = []; |
||||||
|
foreach my $page (values %{$image_info->{query}{pages}}) |
||||||
|
{ |
||||||
|
push @{$region->{defaults}{image}}, $page->{imageinfo}[0]{url}; |
||||||
|
} |
||||||
|
|
||||||
|
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 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; |
||||||
|
} |