package Uwp2;
my @hex = ( 0..9, 'A'..'H', 'J'..'N', 'P'..'Z' );
my %dec = ();
{
my $i=0;
$dec{ $_ } = $i++ for @hex;
}
my @gg = ( 0, 0, 0, 0, 1, 1, 1, 2, 2, 3, 4, 5 );
my @ab = ( 3, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0 );
my %zone = ( 'G' => 'Green', 'A' => 'Amber', 'R' => 'Red' );
sub world
{
my ($name, $uwp, $bases, $popmult, $orbits) = @_;
my ($starport, $size, $atmosphere, $hydrosphere, $population, $gove
+rnment, $law, $tl)
= $uwp =~ /(\w)(\w)(\w)(\w)(\w)(\w)(\w)-(\w)/;
if ( $starport eq '' )
{
$starport = 'X';
$size = int(rand(10));
$atmosphere = int(rand(2)*rand(2));
$hydrosphere = int(rand(2)*rand(2));
$population = 0;
$government = 0;
$law = 0;
$tl = 0;
$uwp = $starport . $size . $atmosphere . $hydrosphere . '000-0';
}
return
{ 'planet' =>
[
{ 'name' => $name },
{ 'uwp' => $uwp },
{ 'pop mult' => $popmult },
{ 'bases' => $bases },
{ 'orbits' => $orbits },
]};
}
sub star
{
my $class = shift;
my $type = shift;
my $name = shift;
my $orbits = shift;
return
{ 'star' =>
[
{ 'name' => $name },
{ 'class' => $class },
{ 'type' => $type },
{ 'orbits' => $orbits },
]
};
}
sub gasGiant
{
my $size = ( 'S', 'L' )[int(rand(2))];
my $uwp = 'X' . $size . 'H' . 'H' . '000-0';
my $bases = shift;
my $orbits = shift;
return
{ 'gas giant' =>
[
{ 'name' => shift },
# { 'diameter' => 50000 * int(rand(3)+1) },
{ 'uwp' => $uwp },
{ 'bases' => $bases },
{ 'orbits' => $orbits },
]};
}
sub asteroid
{
my $name = shift;
my $uwp = shift || 'X000000-0';
my $bases = shift;
my $popmult = shift;
return
{ 'asteroid' =>
[
{ 'name' => $name },
# { 'diameter' => shift || (10 * int(rand(10)) + 100 * int(rand(
+2) * rand(2))) },
{ 'uwp' => $uwp },
{ 'pop mult' => $popmult },
{ 'bases' => $bases },
{ 'theta' => shift || int(rand(365)) },
]};
}
sub asteroidBelt
{
my $catalogued = shift || [ &asteroid( 'alpha' ), &asteroid( 'beta'
+ ) ];
return
{ 'asteroid belt' =>
[
{ 'name' => shift },
{ 'catalog' => $catalogued },
]};
}
sub decode
{
$_ = shift;
s/,/ /g; # turn commas into spaces
return ()
unless /^\s*(\S.*\S)\s*(\d\d\d\d)\s(\w{7}-\w)\s+(\w)?(.*)$/;
my $name = $1;
my $hex = $2;
my $uwp = $3;
my $bases = $4;
srand( $hex + ord( $name ) + 1 );
my @tok = split( ' ', $5 );
shift @tok until $tok[0] =~ /^(A|R|\d?G|\d\d\d)$/; # skip trade c
+odes
my $zone = 'G';
$zone = shift @tok if $tok[0] =~ /^(A|R)$/; # Zone
$zone = $zone{$zone};
my ($p, $b, $g );
if ( $tok[0] =~ /^(\d)(\d)(\d)$/ ) # PBG
{
$p = $1;
$b = $2;
$g = $3;
shift @tok;
}
else
{
$g = $tok[0] =~ /(\d)?G/ || $gg[ rand(@gg) ];
shift @tok if $tok[0] =~ /G/;
$b = $ab[ rand(@ab)+$g ];
$p = int(rand(9)+1);
}
my $mainworld;
my @ss;
if ($uwp =~ /^.0/)
{
$mainworld = &asteroid( $name, $uwp, $bases, $p );
@ss = ( &asteroidBelt( $mainworld ) );
}
else
{
$mainworld = &world( $name, $uwp, $bases, $p ) if $uwp =~ /^
+.[^0]/;
@ss = ( $mainworld );
}
splice @ss, rand(@ss), 0, &asteroidBelt() for 1..$b;
splice @ss, rand(@ss), 0, &gasGiant() for 1..$g;
splice @ss, rand(@ss), 0, &world() for 1..2+rand(6)+rand(6)
+-$b-$g;
my $allegiance = shift @tok if $tok[0] =~ /^\w\w$/; # allegiance
my @stars = ();
my @xboat = ();
push @stars, &star( shift @tok, shift @tok )
while @tok && $tok[0] !~ /:/; # stars
push @stars, &star() unless @stars;
unshift @ss, shift @stars;
splice @ss, 1, 0, shift @stars if @stars && rand() > 0.3;
splice @ss, rand(@ss+1), 0, shift @stars foreach @stars;
$tok[0] =~ s/://;
push @xboat, shift @tok
while @tok && $tok[0] =~ /^\d\d\d\d$/; # xboat
my $mainSystem =
[
{'name' => $name },
{'mainworld' => $mainworld },
{'zone' => $zone },
{'allegiance' => $allegiance },
{'xboat' => \@xboat },
{'system' => \@ss },
];
return
{
$hex =>
{
'main system' => $mainSystem
}
};
}
1;