view release on metacpan or  search on metacpan

script/traveller  view on Meta::CPAN

#!/usr/bin/perl
# Copyright (C) 2009-2021  Alex Schroeder <alex@gnu.org>
# 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 <http://www.gnu.org/licenses/>.

# 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);