#!/usr/bin/perl -w
use strict;

# make_gores.pl
#
# Given a raw PPM image which is the cylindrical projection map of a
# sphere (a planet, etc), creates an interrupted sinusoidal gore map,
# suitable for printing, cutting out, and bending into a paper globe.
#
# Mitchell Charity <mcharity@vendian.org>
# http://www.vendian.org/mncharity/dir3/planet_globes/
#
# Copyright (c) 2003 Mitchell Charity.  All rights reserved.  This
# library is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
# 2003-Dec-15 23:37:26

sub fail {
    print STDERR "Error: ",$_[0],"\n" if @_;
    die "
Usage: $0 in.ppm out.ppm number-of-gores [optional-background-R G B]

    in.ppm should be a PNM (portable anymap) PPM (portable pixmap)
      in _raw_ format.  Ie, the file should begin with \"P6\".
      If parsing the header fails, remove any comments.

    number-of-gores should be something like 12, 16, 18, or 24.

    RGB values are 0-255.  White is 255 255 255.

    http://www.vendian.org/mncharity/dir3/planet_globes/
";
}

my @default_white_background = (255,255,255);
push(@ARGV,@default_white_background) if @ARGV == 3;
&fail() if @ARGV != 6;
my($infile,$outfile,$number_of_gores,@backgroundRGB) = @ARGV;
&fail("Input file not found") if !-e $infile;
&fail("number-of-gores should be a small integer, like 8 or 24")
    if $number_of_gores !~ /^\d+$/ || $number_of_gores < 1;
map{&fail("RGB values should be 0-255") if $_ < 0 || $_ > 255;} @backgroundRGB;

open(IN,"<$infile") or &fail("Unable to open input file \"$infile\": $!");
binmode(IN);
open(OUT,">$outfile") or &fail("Unable to open output file \"$outfile\": $!");
binmode(OUT);

my $in = do{local $/;<IN>};
close(IN);

my $ppm_re = qr/^(P6\s+(?:\#[^\n]*\n)*\s*(\d+)\s+(\d+)\s+(\d+)\s)/;
my($header,$width,$height,$depth) = $in =~ /$ppm_re/;

&fail("Input isn't PNM PPM (portable pixmap) - doesn't start with \"P6\".")
    if $in !~ /^P6/;
&fail("My halfhearted attempt to parse the input file's header FAILED.")
    if !defined $depth;
&fail("This program only works on 1 byte samples (3 byte pixels).")
    if $depth > 255;

my $out = $header . (sprintf("%c%c%c",@backgroundRGB)x($width*$height));

my $offset = length($header);
&gore($number_of_gores);
print OUT $out; close OUT;

exit(0);


sub get {
    my($x,$y)=@_;
    unpack("CCC",substr($in, ($offset+($x*3)+($y*$width*3)), 3));
}
sub set {
    my($x,$y,@color)=@_;
    substr($out, ($offset+($x*3)+($y*$width*3)), 3) = pack("CCC",@color);
}

sub gore {
   my($n_gores)=@_;

   my $gore_w = $width  / $n_gores;
   my $gore_h = $height / 2;
   my $gore_half_w = $gore_w / 2;

   my $gore_h_top = rint($gore_h);
   my $gore_h_bot = $height - $gore_h_top;

   my @x_breakpoints;
   for(my $i = 0; $i < ($n_gores * 2); $i++) {
       my $x = $i * $gore_half_w;
       $x = rint($x);
       push(@x_breakpoints, $x);
   }
   my $w_leftmost = $x_breakpoints[1] - $x_breakpoints[0];
   push(@x_breakpoints,$width);
   push(@x_breakpoints,$width + $w_leftmost);

   for(my $i = 0; $i < $n_gores; $i++) {
       my $x0 = shift @x_breakpoints;
       my $x1 = shift @x_breakpoints;
       my $x2 = $x_breakpoints[0];
       my $x3 = $x_breakpoints[1];
       my $w0 = $x1 - $x0;
       my $w1 = $x2 - $x1;
       my $w2 = $x3 - $x2;
       my($BLx,$BLw) = ($x0,$w0);
       my($BRx,$BRw) = ($x1,$w1);

       &draw_half_gore($in,$x0,0,$w0,$gore_h_top,$out,$x0,0, 'TL');
       print STDERR ".";
       &draw_half_gore($in,$x1,0,$w1,$gore_h_top,$out,$x1,0, 'TR');
       print STDERR ".";
       &draw_half_gore($in,$BLx,$gore_h_top,$BLw,$gore_h_bot,$out,$BLx,$gore_h_top, 'BL');
       print STDERR ".";
       &draw_half_gore($in,$BRx,$gore_h_top,$BRw,$gore_h_bot,$out,$BRx,$gore_h_top, 'BR');
       print STDERR ",";
   }
   print STDERR "\n";
}

sub draw_half_gore {
    my($in,$x,$y,$w,$h,$out,$outx,$outy,$quarter) = @_;
    my $tipattop  = $quarter =~ /T/;
    my $tipatleft = $quarter =~ /R/;
    for(my $row = 0; $row < $h; $row++) {
	my $from_tip = ($tipattop ? ($h - $row) : ($row + 1));
	my $row_w = &rint($w * cos($from_tip / $h * (3.14159265/2)));
	$row_w = 1 if $row_w == 0;
	my $col_spread = $w / $row_w;
	my $col_offset = $tipatleft ? 0 : ($w - $row_w);
	for(my $col = 0; $col < $row_w; $col++) {
	    my $ix = $x + int($col * $col_spread);
	    my $ox = $outx + $col_offset + $col;
	    my $iy = $y + $row;
	    my $oy = $outy + $row;
	    set($ox,$oy,get($ix,$iy));
	}
    }
}

sub sgn  ($) { $_[0] >= 0 ? 1 : -1 }
sub rint ($) { my $f = $_[0]; my $r = int($f);
	       $r += sgn($f) if abs($f - $r) >= 0.5;
	       $r; }

sub copy_in_to_out_for_timing {
    for(my $i=0;$i<$width;$i++) {
	for(my $j=0;$j<$height;$j++) {
	    set($i,$j,get($i,$j));
	}
    }
}

__END__