view release on metacpan or  search on metacpan

lib/Game/TextMapper/Schroeder/Archipelago.pm  view on Meta::CPAN

# Copyright (C) 2009-2021  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::Archipelago - work in progress

=head1 DESCRIPTION

This is an unfinished idea.

=cut

package Game::TextMapper::Schroeder::Archipelago;
use Game::TextMapper::Log;
use Modern::Perl '2018';
use Mojo::Base -base;
use Role::Tiny::With;
with 'Game::TextMapper::Schroeder::Base';
use List::Util qw'shuffle min max';

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

has 'bottom' => 0;
has 'top' => 10;
has 'radius' => 5;
has 'width' => 30;
has 'height' => 10;
has 'concentration' => 0.1;
has 'eruptions' => 0.03;
has 'world' => sub { { } };
has 'altitude' => sub { {} };

sub flat {
  my $self = shift;
  $log->debug("initializing altitude map");
  # initialize the altitude map; this is required so that we have a list of
  # legal hex coordinates somewhere
  for my $y (1 .. $self->height) {
    for my $x (1 .. $self->width) {
      my $coordinates = coordinates($x, $y);
      $self->altitude->{$coordinates} = 0;
      $self->world->{$coordinates} = "height0";
    }
  }
}

sub ocean {
  my $self = shift;
  $log->debug("placing ocean and water");
  for my $coordinates (sort keys %{$self->altitude}) {
    if ($self->altitude->{$coordinates} <= $self->bottom) {
      my $ocean = 1;
      for my $i ($self->neighbors()) {
	my ($x, $y) = $self->neighbor($coordinates, $i);
	my $legal = $self->legal($x, $y);
	my $other = coordinates($x, $y);
	next if not $legal or $self->altitude->{$other} <= $self->bottom;
	$ocean = 0;
      }
      $self->world->{$coordinates} = $ocean ? "ocean" : "water";
    }
  }
}

sub eruption {
  my $self = shift;
  my $cx = int $self->width * rand();
  my $cy = int $self->height * (rand() + rand()) / 2;
  $log->debug("eruption at " . $self->coordinates($cx, $cy));
  my $top = 1 + int($self->top * $cx / $self->width);
  $top-- if $top > 2 and rand() < 0.6;
  for my $coordinates (keys %{$self->altitude}) {
    my $d = $self->distance($self->xy($coordinates), $cx, $cy);
    if ($d <= $top) {
      my $h = $top - $d;