File Coverage

script/traveller

Criterion	Covered	Total	%
statement	34	39	87.1
branch	0	4	0.0
condition			n/a
subroutine	12	13	92.3
pod			n/a
total	46	56	82.1

#!/usr/bin/perl
# Copyright (C) 2009-2021  Alex Schroeder
# Copyright (C) 2020       Christian Carey
#
# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU 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 General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with
# this program. If not, see .

# Use the library matching the installation location of the script being called.
use FindBin;
use lib "$FindBin::Bin/../lib";

package Traveller;
use Traveller::Subsector;
use Traveller::Mapper::Classic::MPTS;
use Traveller::Mapper::Classic;
use Traveller::Mapper;
use Traveller::Util qw(flush);
use Modern::Perl;
use Mojolicious::Lite;
use POSIX qw(INT_MAX);
use utf8;

get '/' => sub {
  my $c = shift;
  $c->redirect_to('main');
};

get '/random' => sub {
  my $c = shift;
  my $id = int(rand(INT_MAX));
  $c->redirect_to($c->url_for('uwp', size => 'subsector', rules => 'mgp', id => $id));
};

get '/random/:size' => [size => ['subsector', 'sector']] => sub {
  my $c = shift;
  my $size = $c->param('size');
  my $id = int(rand(INT_MAX));
  $c->redirect_to($c->url_for('uwp', size => $size, rules => 'mgp', id => $id));
};

get '/random/:size/:rules' => [size => ['subsector', 'sector']] => sub {
  my $c = shift;
  my $size = $c->param('size');
  my $rules = $c->param('rules');
  my $density = $c->param('density');
  my $id = int(rand(INT_MAX));
  $c->redirect_to($c->url_for('uwp', size => $size, rules => $rules, id => $id)->query(density => $density));
} => 'random';

get '/:id' => [id => qr/\d+/] => sub {
  my $c = shift;
  my $id = $c->param('id');
  $c->redirect_to($c->url_for('uwp', size => 'subsector', rules => 'mgp', id => $id));
};

get '/uwp/:id' => [id => qr/\d+/] => sub {
  my $c = shift;
  my $id = $c->param('id');
  $c->redirect_to($c->url_for('uwp', size => 'subsector', rules => 'mgp', id => $id));
};

get '/uwp/:size/:id' => [size => ['subsector', 'sector']] => [id => qr/\d+/] => sub {
  my $c = shift;
  my $size = $c->param('size');
  my $id = $c->param('id');
  $c->redirect_to($c->url_for('uwp', size => $size, rules => 'mgp', id => $id));
};

get '/uwp/:size/:rules/:id' => [size => ['subsector', 'sector']] => [id => qr/\d+/] => sub {
  my $c = shift;
  my $size = $c->param('size');
  my $rules = $c->param('rules');
  my $id = $c->param('id');
  my $density = $c->param('density') || 50;
  srand($id);
  if ($size eq 'sector') {
    my $uwp = subsector()->init(32, 40, $rules, $density/100)->str;
    $c->render(template => 'uwp-sector', id => $id, rules => $rules, uwp => $uwp, density => $density);
  } else {
    my $uwp = subsector()->init(8, 10, $rules, $density/100)->str;
    $c->render(template => 'uwp', id => $id, rules => $rules, uwp => $uwp, density => $density);
  }
  flush();
} => 'uwp';

any '/edit' => sub {
  my $c = shift;
  my $uwp = $c->param('map');
  $c->render(template => 'edit', uwp => Traveller::Mapper::example(), size => 'subsector', rules => 'mgp', id => '');
} => 'main';

get '/edit/:id' => [id => qr/\d+/] => sub {
  my $c = shift;
  my $id = $c->param('id');
  $c->redirect_to($c->url_for('edit', size => 'subsector', rules => 'mgp', id => $id));
};

get '/edit/:size/:id' => [size => ['subsector', 'sector']] => [id => qr/\d+/] => sub {
  my $c = shift;
  my $size = $c->param('size');
  my $id = $c->param('id');
  $c->redirect_to($c->url_for('edit', size => $size, rules => 'mgp', id => $id));
};

get '/edit/:size/:rules/:id' => [size => ['subsector', 'sector']] => [id => qr/\d+/] => sub {
  my $c = shift;
  my $size = $c->param('size');
  my $rules = $c->param('rules');
  my $id = $c->param('id');
  my $density = $c->param('density');
  srand($id);
  if ($size eq 'sector') {
    my $uwp = subsector()->init(32, 40, $rules, $density)->str;
    $c->render(template => 'edit-sector', id => $id, rules => $rules, uwp => $uwp);
  } else {
    my $uwp = subsector()->init(8, 10, $rules, $density)->str;
    $c->render(template => 'edit', id => $id, rules => $rules, uwp => $uwp);
  }
  flush();
} => 'edit';

# → see any '/map' below!
# get '/map' => sub {
#   my $c = shift;
#   $c->render(template => 'map_all', uwp => Traveller::Mapper::example(), size => 'subsector', rules => 'mgp');
# };

get '/map/:id' => [id => qr/\d+/] => sub {
  my $c = shift;
  my $id = $c->param('id');
  $c->redirect_to($c->url_for('map_all', size => 'subsector', rules => 'mgp', id => $id));
};

get '/map/:size/:id' => [size => ['subsector', 'sector']] => [id => qr/\d+/] => sub {
  my $c = shift;
  my $size = $c->param('size');
  my $id = $c->param('id');
  $c->redirect_to($c->url_for('map_all', size => $size, rules => 'mgp', id => $id));
};

get '/map/:size/:rules/:id' => [size => ['subsector', 'sector']] => [id => qr/\d+/] => sub {
  my $c = shift;
  my $size = $c->param('size');
  my $rules = $c->param('rules');
  my $id = $c->param('id');
  my $wiki = $c->param('wiki');
  my $density = $c->param('density') || 50;
  srand($id);
  my $map = mapper($rules);
  my $uwp;
  if ($size eq 'sector') {
    $uwp = subsector()->init(32, 40, $rules, $density/100)->str;
  } else {
    $uwp = subsector()->init(8, 10, $rules, $density/100)->str;
  }
  my $url = $c->url_for('uwp', size => $size, rules => $rules, id => $id);
  $url = $url->query(density => $density) if $density and $density != 50;
  $map->initialize($uwp, $wiki, $url);
  $map->communications();
  $map->trade();
  flush();
  $c->render(text => $map->svg, format => 'svg');
} => 'map_all';

any '/map' => sub {
  my $c = shift;
  my $wiki = $c->param('wiki');
  my $trade = $c->param('trade');
  my $uwp = $c->param('map') || Traveller::Mapper::example();
  my $size = $c->param('size') || 'subsector';
  my $rules = $c->param('rules') || 'mgp';
  my $source;
  if (!$uwp) {
    my $id = int(rand(INT_MAX));
    srand($id);
    $uwp = subsector()->init(8, 10, $rules)->str;
    $source = $c->url_for('uwp', id => $id);
  }
  my $map = mapper($rules);
  $map->initialize($uwp, $wiki, $source);
  $map->communications();
  $map->trade();
  flush();
  if ($trade) {
    $c->render(text => $map->text, format => 'txt');
  } else {
    $c->render(text => $map->svg, format => 'svg');
  }
} => 'map';

get '/help' => sub {
  my $c = shift;
  my $classic = $c->param('classic');
  my $mpts = $c->param('mpts');
  $c->render(classic => $classic, mpts => $mpts);
};

sub subsector {
  return Traveller::Subsector->new;
}

sub mapper {
  my $rules = shift;
  if ($rules eq 'mpts') {
    return Traveller::Mapper::Classic::MPTS->new;
  } elsif ($rules eq 'ct') {
    return Traveller::Mapper::Classic->new;
  } else {
    return Traveller::Mapper->new;
  }
}

app->start;

__DATA__