#!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 no
+ne)
# 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 listin
+g 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+$li
+ne*$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" po
+ints="';
  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 + $oa
+ngle), 
                   $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";
}
[download]