#!perl
#
# mapmaker v1.1
# reads a file with lines of format:
#   nnnn A000000-0 NSG
# or
#   Jd aaaa bbbb cccc xxxx
# or
#   RZ nnnn
#   AZ nnnn
# where nnnn is a hex map coordinate (0101 through 0810), A000000-0 is a UPP,
# NSG indicates Naval Scout or Gas Giant (omit or replace with . if none)
# and d is a single digit followed by a list of hex coordinates.
#
# It then draws a TAS form 6 with systems plotted and decorated with
# X-boat paths drawn.
#
# Revision 1.0 07-09-2007 bjm   Initial release
# Revision 1.1 08-09-2007 bjm   Adds listings, better option handling, help
# Revision 1.2 08-09-2007 bjm   System, sector, subsector names

use strict;
use warnings;

use Getopt::Long;
Getopt::Long::Configure ("bundling");

# set this to get colour zones and listings
our $COLOUR = 0;
our $LISTINGS = 0;
our $HELP = 0;
our $side = 40;
my $rv = GetOptions ("colour|color|c" => \$COLOUR,
		     "listing|l" => \$LISTINGS,
		     "help|h" => \$HELP,
		     "side|s=i" => \$side,
    );
if ($HELP) {
  print STDERR "Usage: mapmaker [-l] [-c] [-s n] [-h]\n";
  print STDERR "       -l --listing    List system stats\n";
  print STDERR "       -c --colour     Use colour for zones and listing bars\n";
  print STDERR "       -s integer      Set hex side length to integer\n";
  print STDERR "       -h --help       Print this message\n";
  exit;
}

#set these to control size
our $factor = 1.732;

#calc size of map
our $total_width = $side * 12.5;
our $total_height = $side * $factor * 10.5;

#calc hex info
our $sheight = $side * $factor / 2;
our $swidth = $side/2;
our $width = $side;

#jump dashes
our @jumpdash = (
  "none",
  "none",
  "1%,1%",
  "3%,1%",
  "3%,1%,1%,3%" );

# names
our $sector;
our $subsector;

printmap();

sub printmap {
  print header();
  print frame();
  for (0..9) {
    print tophalf($_);
    print bottomhalf($_);
  }
  print tophalf(10);
  print number();

  my @drawstuff;
  my @worldlist;
  while (<>) {
    chomp;
    s/^\s+//;
    next if /^\s+$/;
    next if /^#/;  
    /^\d/ && do { push @drawstuff, world($_); push @worldlist, $_; };
    /^J/ && unshift @drawstuff, jump($_);
    /^(R|A)Z/ && unshift @drawstuff, zone($_);
    /^Sector/i && do { (undef,$sector) = split ' '; };
    /^Subsector/i && do { (undef,$subsector) = split ' ';};
  }
  print "<g>\n";
  for (@drawstuff) { print; }
  print "</g>\n";

  if ($LISTINGS) {
    print "<g>\n";
    print listworlds(@worldlist);
    print "</g>\n";
  }
  
  print footer();
}

sub listworlds {
  my @w = @_;

  my $margin = $total_width + $side;
  my $topmargin = $side;
  my $line=0;
  my $fsz = $side/4;
  my $lsz = $side/3;
  my $list;
  my $subsecfontcolor;
  my $secfontcolor;

  if ($sector) {
    $secfontcolor = 'black';
  } else {
    $secfontcolor = '#dddddd';
    $sector = "Uknown";
  }

  if ($subsector) {
    $subsecfontcolor = 'black';
  } else {
    $subsecfontcolor = '#dddddd';
    $subsector = "Unknown";
  }

  $list .= '<text font-size="' . $fsz*2 .
        '" fill="' . $secfontcolor . 
	'" x="' . $margin .
	'" y="' . $topmargin .
	'">' . $sector . ' sector</text>' . "\n";

  $topmargin+= $fsz*2;

  $list .= '<text font-size="' . $fsz*2 .
      '" fill="' . $subsecfontcolor . 
      '" x="' . $margin .
      '" y="' . $topmargin .
      '">' . $subsector . ' subsector</text>' . "\n";
  $topmargin+= $fsz*3;

  $list .= '<g font-size="' . $side/4 . '">' . "\n";
  for (@w) {
    if ($line % 2) {
      $list .= '<rect x="' . ($margin-$fsz) .
	  '" y="' . ($topmargin+$line*$lsz-$lsz/1.5) .
	  '" height="' . ($lsz) .
	  '" width="' . $side*11 . '" ';
      if ($COLOUR) {
	$list.= 'fill="#ccffcc" ';
      } else {
	$list.= 'fill="#cccccc" ';
      }
      $list .= 'stroke="none" />' . "\n";
    }
    my ($loc,$upp,$nsg,$rest) = split ' ';
    my (@nsg) = split //, $nsg;
    $list .= '<text x="' . $margin . '" y="' . ($topmargin+$line*$lsz) . '">';  
    $list .= "$loc";
    $list .= '</text>' . "\n";

    $list .= '<text x="' . ($margin+$side) . '" y="' . ($topmargin+$line*$lsz) . '">';  
    $list .= "$upp";
    $list .= '</text>' . "\n";
    my $nsgsp=0;
    for (@nsg) {
      unless ($_ eq '.') {
	$list .= '<text x="' . ($margin+$side*3+$nsgsp*($side/4)) .
	    '" y="' . ($topmargin+$line*$lsz) . '">';  
	$list .= "$_";
	$list .= '</text>' . "\n";
      }
      $nsgsp++;
    }
    if ($rest) {
      $list .= '<text fill="black" x="' . ($margin+$side*5) .
	  '" y="' . ($topmargin+$line*$lsz) . '">';  
      $list .= $rest;
      $list .= '</text>' . "\n";
    
    } else {
      $list .= '<text fill="#dddddd" x="' . ($margin+$side*5) .
	  '" y="' . ($topmargin+$line*$lsz) . '">';  
      $list .= "system name";
      $list .= '</text>' . "\n";
    }
    $line++;
  }
  $list .= '</g>' . "\n";
  return $list;
}

sub center_of {
  my $coord = shift;
  my $c = substr($coord,0,2) + 0;
  my $r = substr($coord,2,2) + 0;
  my $x = $side + (($c-1) * $side * 1.5);
  my $y = ($c % 2) ? ($r-1) * $side * $factor + ($side * $factor /2):
                     ($r-1) * $side * $factor + ($side * $factor);
  return ($x,$y);
}

sub zone {
  my $data = shift;
  my ($z, $loc) = split ' ', $data;
  my $zone = substr($z,0,1);
  my %c = ('R' => 'red', 'A' => '#bbbb00');
  my %zd = ('R' => "none", 'A' => "3%,1%");

  my ($x, $y) = center_of($loc);
  my $f;
  if ($COLOUR) { $f = $c{$zone}; } else { $f = 'white'; }
  return '<circle fill="' . $f . '" stroke="black" stroke-dasharray="'.
      $zd{$zone} . '" stroke-width="' . $side/20 . '" cx="'. $x .
      '" cy="'. $y . '" r="' . $side/1.6 . '" />' . "\n";
}

sub jump {
  my $data = shift;
  my ($j, @jumps) = split ' ', $data;
  my $jt = substr($j,1,1) + 0;
  my $s = $side/20;
  my $out = '<polyline fill="none" stroke="black" stroke-dasharray="' .
    $jumpdash[$jt] . '" stroke-width="' . $s . '" points="';
  for (@jumps) {
    my ($x,$y) = center_of($_);
    $out .= "$x,$y ";
  }
  $out .= '" />' . "\n";
  return $out;
}

sub world {
  my $data = shift;
  my ($loc,$world,$dec,$rest) = split ' ', $data;
  my $sp = substr($world,0,1);
  my $sz = substr($world,1,1);
  my ($x, $y) = center_of($loc);
  my $output;

  # world dot
  if ($sz) { 
    $output .= '<circle stroke-width="3" stroke="white" fill="black"
            cx="' . $x . '" cy="' . $y . '"
            r="' . $side/6 . '" />' . "\n";
  } else {
    $output .= '<g stroke="white" stroke-width="1" >';
    for (0..6) {
      $output .= '<circle stroke="white" fill="black"
            cx="' . ($x+(rand()*$side/3) - $side/6) . 
            '" cy="' . ($y+(rand()*$side/3) - $side/6) . '"
            r="' . $side/25 . '" />' . "\n";
    }
    $output .= '</g>' . "\n";
  }

  # sp
  $output .= '<text x="' . $x . '" y="' . ($y+$side/2) . 
            '" font-size="' . $side/3 .
            '" fill="black" stroke="none" text-anchor="middle">' . $sp . '</text>' . "\n";

  # decorations
  if ($dec =~ /N/i) {
    my $nx = $x - ($side/3);
    my $ny = $y - ($side/3);
    $output .= star($nx,$ny);
  };
  if ($dec =~ /S/i) {
    my $nx = $x + ($side/3);
    my $ny = $y - ($side/3);
    $output .= triangle($nx, $ny);
  };
  if ($dec =~ /G/i) {
    my $nx = $x - ($side/3);
    my $ny = $y + ($side/3);
    $output .= '<g>
    <circle stroke="white" fill="white" cx="' . $nx . '" cy="' . $ny . '"
            r="' . $side/10 . '" />
    <circle stroke="black" fill="black" cx="' . $nx . '" cy="' . $ny . '"
            r="' . $side/16 . '" />
    </g>' . "\n";
  };

  return $output;
      
}

sub triangle {
  my ($x,$y) = @_;
  my $triangle = '<polygon fill="black" stroke="white" stroke-width="1" points="';
  for (star_coords($side/10, 0, 3)) {
    my $px = $x + $_->[0];
    my $py = $y + $_->[1];
    $triangle .= "$px,$py ";
  }
  $triangle .= '" />' . "\n";
  return $triangle;

}

sub star {
  my ($x,$y) = @_;
  my $star = '<polygon fill="black" stroke="white" stroke-width="1" points="';
  for (star_coords($side/10, $side/20, 5)) {
    my $px = $x + $_->[0];
    my $py = $y + $_->[1];
    $star .= "$px,$py ";
  }
  $star .= '" />' . "\n";
  return $star;
}

sub star_coords {
  my $r1 = shift;
  my $r2 = shift;
  my $points = shift;
  my $pi = 3.14159;
  my $pangle = 2*$pi/$points;
  my $sangle = $pi/$points;
  my $oangle = $pi/-2;
  my @coords;
  for (0..($points-1)) {
    push @coords, [$r1 * cos($pangle * $_ + $oangle),
                   $r1 * sin($pangle * $_ + $oangle)];
    if ($r2) { push @coords, [$r2 * cos(($pangle * $_) + $sangle + $oangle), 
                   $r2 * sin(($pangle * $_) + $sangle + $oangle)]};
  }
  return @coords;
}

sub number {
  my $t;
  my $f = $side/5;
  for my $c (1..8) {
    for my $r (1..10) {
      my $n = sprintf("%02d%02d",$c,$r);
      my $x = $side + (($c-1) * $side * 1.5);
      my $y = ($c % 2) ? ($r-1) * $side * $factor + (0.2 * $side) :
                         ($r-1) * $side * $factor + $sheight + (0.2 * $side);
      $t .= '<text x="' . $x . '" y="' . $y . 
            '" font-size="' . $f .
            '" fill="black" text-anchor="middle">' . $n . '</text>' . "\n";
    }
  }
  return $t;
}

sub frame {
  my $h = $total_height;
  my $w = $total_width;
  return '<polyline fill="white" stroke="black" stroke-width="4" ' .
         'points="0,0 ' 
         . $w . ',0 '
         . $w . ',' . $h .
         ' 0,' . $h .
         ' 0,0" />' . "\n";
}

sub half {
  my ($row, $top) = @_;
  my $ly = ($row * 2 * $sheight ) + $sheight;
  my $line =  '<polyline fill="none" stroke="black" stroke-width="1" ' .
         'points="';
  my $x; my $y;
  for (0..3) {
    $x = $_ * $side * 3;
    $y = $ly;
    $line .= "$x,$y ";
    $x += $swidth; $y = ($top) ? $y - $sheight : $y + $sheight;
    $line .= "$x, $y ";
    $x += $width;
    $line .= "$x, $y ";
    $x += $swidth; $y = ($top) ? $y + $sheight : $y - $sheight;
    $line .= "$x, $y ";
    $x += $width;
    $line .= "$x, $y ";
  }
  $x += $swidth; $y = ($top) ? $y - $sheight : $y + $sheight;
  $line .= "$x,$y" . '" />';
  return $line;
}  

sub tophalf {
  return half(shift,1);
}

sub bottomhalf {
  return half(shift,0);
}

sub header {
  my $h = $total_height+5;
  my $w;
  if ($LISTINGS) {
    $w = $total_width*2;
  } else {
    $w = $total_width+5;
  }
  return '<?xml version="1.0" standalone="no"?>
    <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" 
       "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
    <svg width="'
    . $w .
    'px" height="'
    . $h .
    'px" version="1.1" xmlns="http://www.w3.org/2000/svg">
      <desc>Subsector Map Grid</desc>' . "\n";
}

sub footer {
  return '</svg>' . "\n";
}


##</code><code>##

#!perl
#
# subsector v1.0
# generates a random subsector in mapmaker format.  Default occurence
# is 4+ but can be set on the command line.  Can be piped to mapmaker
# or to a file for modification, storage, and addition of X-boat paths.
#
# Revision 1.1 08-09-2007 bjm Fixed law level trouble

use strict;
use warnings;

our $occ = shift || 4;  # stars occur on a 4+ on 1d6
our @spt = qw(A A A B B C C D E E X);
our @nbt = qw(. . . . . . N N N N N);
our @sbt = qw(. . . . . S S S S S S);
our @ggt = qw(G G G G G G G G . . .);
our %sptl = ('A' => 6, 'B' => 4, 'C' => 2, 'D' => 0, 'E' => 0, 'X' => -4);
our @sztl = (2,2,1,1,1,0,0,0,0,0,0,0,0,0,0,0);
our @attl = (1,1,1,1,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1);
our @hytl = (0,0,0,0,0,0,0,0,0,1,2);
our @potl = (0,1,1,1,1,1,0,0,0,2,4);
our @gvtl = (1,0,0,0,0,1,0,0,0,0,0,0,0,-2,0,0,0,0,0,0);

for my $c (1..8) {
  for my $r (1..10) {
    if (d6()+1 >= $occ) {
      my $loc = sprintf("%02d%02d", $c, $r);
      my $sp = $spt[d6()+d6()];          # starport lookup
      my $sz = d6() + d6();              # size
      my $at = d6() + d6() - 5 + $sz;    # atmosphere
      if ($at < 0) { $at = 0; }
      my $hy = d6() + d6() - 5 + $at;    # hydrographics
      if ($sz == 0) {
	$hy = 0;
      } elsif ($at < 2 || $at > 9) {
	$hy -= 4;
      }
      if ($hy < 0) { $hy = 0; }
      if ($hy > 10) { $hy = 10; }
      my $po = d6() + d6();               # population
      my $gv = d6() + d6() - 5 + $po;     # government 
      if ($gv < 0) { $gv = 0; }
      my $ll = d6() + d6() - 5 + $gv;     # law level
      if ($ll < 0) { $ll = 0; }
      my $tl = d6() + 1                      # tech level
	  + $sptl{$sp}
          + $sztl[$sz]
	  + $attl[$at]
	  + $hytl[$hy]
	  + $potl[$po]
	  + $gvtl[$gv];
      my $upp = $sp                             # generate UPP
	  . phex($sz) . phex($at) . phex($hy)
	  . phex($po) . phex($gv) . phex ($ll)
	  . '-' . phex($tl);
      my $nsg;                                  # naval base?
      if ($sp eq 'A' || $sp eq 'B') {
	$nsg = $nbt[d6() + d6()];
      } else {
	$nsg = '.';
      }
      my $sbv = d6() + d6();              # scout base?
      if ($sp eq 'E' || $sp eq 'X') {
	$sbv = 0;
      } elsif ($sp eq 'A') {
	$sbv += -3;
      } elsif ($sp eq 'B') {
	$sbv += -2;
      } elsif ($sp eq 'C') {
	$sbv += -1;
      }
      if ($sbv < 0) { $sbv = 0; }
      $nsg .= $sbt[$sbv];
      $nsg .= $ggt[d6() + d6()];
      print "$loc $upp $nsg\n";
      
    }
  }
}

sub phex {
    my $n = shift;
    return 0 if ($n < 0);
    return $n if ($n < 10);
    return chr($n + ord('A') - 10);
}

sub d6 {
  return int(rand(6));
}