view release on metacpan or  search on metacpan

lib/Game/TextMapper/Traveller.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::Traveller - generate Traveller subsector maps

=head1 DESCRIPTION

This generates subsector maps suitable for the Traveller game in its various
editions. Trade and communication routes are based on starports, bases, and
trade codes and jump distance; the potential connections are then winnowed down
using a minimal spanning tree.

=head1 METHODS

=cut

package Game::TextMapper::Traveller;
use Game::TextMapper::Log;
use Modern::Perl '2018';
use List::Util qw(shuffle max any);
use Mojo::Base -base;
use Role::Tiny::With;
use Game::TextMapper::Constants qw($dx $dy);
with 'Game::TextMapper::Schroeder::Hex';

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

has 'rows' => 10;
has 'cols' => 8;
has 'digraphs';

=head2 generate_map

This method takes no arguments. Subsectors are always 8×10.

=cut

sub generate_map {
  my $self = shift;
  $self->digraphs($self->compute_digraphs);
  # coordinates are an index into the system array
  my @coordinates = (0 .. $self->rows * $self->cols - 1);
  my @randomized =  shuffle(@coordinates);
  # %systems maps coordinates to arrays of tiles
  my %systems = map { $_ => $self->system() } grep { roll1d6() > 3 } @randomized; # density
  my $comms = $self->comms(\%systems);
  my $tiles = [map { $systems{$_} || ["empty"] } (@coordinates)];
  return $self->to_text($tiles, $comms);
}

# Each system is an array of tiles, e.g. ["size-1", "population-3", ...]
sub system {
  my $self = shift;
  my $size = roll2d6() - 2;
  my $atmosphere = max(0, roll2d6() - 7 + $size);
  $atmosphere = 0 if $size == 0;
  my $hydro = roll2d6() - 7 + $atmosphere;
  $hydro -= 4 if $atmosphere < 2 or $atmosphere >= 10;
  $hydro = 0 if $hydro < 0 or $size < 2;
  $hydro = 10 if $hydro > 10;
  my $population = roll2d6() - 2;
  my $government = max(0, roll2d6() - 7 + $population);
  my $law = max(0, roll2d6() - 7 + $government);
  my $starport = roll2d6();
  my $naval_base = 0;
  my $scout_base = 0;
  my $research_base = 0;
  my $pirate_base = 0;
  my $tech = roll1d6();
  if ($starport <= 4) {
    $starport = "A";
    $tech += 6;
    $scout_base = 1 if roll2d6() >= 10;
    $naval_base = 1 if roll2d6() >= 8;
    $research_base = 1 if roll2d6() >= 8;
  } elsif ($starport <= 6)  {
    $starport = "B";
    $tech += 4;
    $scout_base = 1 if roll2d6() >=  9;