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;
[download]