view release on metacpan or  search on metacpan

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

# Copyright (C) 2009-2023  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::Alpine - generate an alpine landscape

=head1 DESCRIPTION

This fills the map with some mountains and then traces the water flow down to
the sea and off the map. With water, forests grow; but if the area remains at
the same altitude, swamps form.

Settlements are placed at random in the habitable zones, but far enough from
each other, and connected by trails.

In order to support hex and square maps, this class uses roles to implement
coordinates, neighbours, and all that. This is why you need to specify the role
before creating an instance of this class:

    return Game::TextMapper::Schroeder::Alpine
	->with_roles('Game::TextMapper::Schroeder::Hex')->new()
	->generate_map(@params);

=head1 SEE ALSO

L<Game::TextMapper::Schroeder::Base>
L<Game::TextMapper::Schroeder::Hex>
L<Game::TextMapper::Schroeder::Square>

=cut

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

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

has 'steepness';
has 'peaks';
has 'peak';
has 'peak_min';
has 'bumps';
has 'bump';
has 'bottom';
has 'arid';
has 'climate';
has 'wind';

sub place_peak {
  my $self = shift;
  my $altitude = shift;
  my $count = shift;
  my $min = shift;
  my $max = shift;
  # max altitude exactly once
  my $x = int(rand($self->width)) + 1;
  my $y = int(rand($self->height)) + 1;
  my $coordinates = coordinates($x, $y);
  $altitude->{$coordinates} = $max;
  $log->debug("placed max $max at $coordinates");
  # prepare distribution
  my @distribution;
  my $n = 1;
  for my $i (0 .. $max - $min) {
    push(@distribution, $n);
    $n *= 2;
  }
  # this is the "die size"
  $n = $distribution[$#distribution];
  $log->debug("@distribution");
  my @queue;
  # place some peaks and put them in a queue
  for (1 .. $count) {
    # try to find an empty hex
    for (1 .. 6) {
      my $x = int(rand($self->width)) + 1;
      my $y = int(rand($self->height)) + 1;
      my $coordinates = coordinates($x, $y);
      next if $altitude->{$coordinates};
      my $r = rand($n);
      $log->debug("  rolled $r");
      for my $i (0 .. $#distribution) {
        $log->debug("  $r < $distribution[$i]");
        if ($r < $distribution[$i]) {
          $altitude->{$coordinates} = $max - $i;
          $log->debug("placed $altitude->{$coordinates} at $coordinates");
          push(@queue, $coordinates);
          last;
        }
      }