commit
de918c767a
@ -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; |
||||
} |
||||
Loading…
Reference in new issue