#!/usr/local/bin/perl
# U.S. letter paper, half inch margins.
$urx = $paperx = 612; $xmarge = 72 / 2;
$ury = $papery = 792; $ymarge = 72 / 2;
$outpoints=10;
$pagepoints=12;
$tryfact = 1.1;

$bigdir = ".";
$litdir = ".";

$ismaps{"-cernmap"} = "rect (%s,%s) (%s,%s) %s\n";
$ismaps{"-ncsamap"} = "rect %s %s,%s %s,%s\n";

($progname = $0) =~ s/.*\///;
sub usage {
	local($mess) = @_;
print STDERR <<EOS;
$progname: $mess
Usage: $progname [ -ps pointsize ] [ -tiles n ] [ -prefix prefix ] filename
Take a chart produced by chart(1) and break it into overlapping tiles.
Tiles go into files named prefixnn.ps, where prefix is taken from filename,
unless -prefix.  Either -ps or -tiles may be used to set the pointsize
and number of tiles.

	-ps points	Output pointsize (default $outpoints)

	-tiles n	Produce <= n tiles.

	-prefix pref	Set tile filename prefix.

	-cernmap urlbase	ISMAP files prefixmap.html and prefix.map,
	-ncsamap urlbase	using URLs urlbase/prefixnn.html.
	-litdir dir	Directory containing little GIF files.
	-bigdir dir	Directory containing big GIF files.

	filename	The chart PostScript file to tile; it must be named.
EOS
	exit 1;
}

while($arg = shift) {
	push(@ARGV, $arg), last if $arg !~ /^-/;
	$outpoints = shift, next if $arg eq "-ps";
	$outpoints = shift, next if $arg eq "-p";
	$tartiles = shift, next if $arg eq "-tiles";
	$prefix = shift, next if $arg eq "-prefix";
	$prefix = shift, next if $arg eq "-f";
	$ismap = "$arg", $urlbase = shift, next if $arg eq "-cernmap";
	$ismap = "$arg", $urlbase = shift, next if $arg eq "-ncsamap";
	$bigdir = shift, next if $arg eq "-bigdir";
	$litdir = shift, next if $arg eq "-litdir";
	$printlinesflag++, next if $arg eq "-l";
	&usage("Unknown option: $arg");
}
$filename = $arg;
$filename || &usage("Filename argument is required.");
$prefix || ($prefix = $filename) =~ s/\.[^\.]*$//;

$incomments = 1;
$inprolog = 0;
while (<>) {
	if ($incomments) {
		next if /^%!/;
		if (/^%%BoundingBox:/) {
			chop;
			($tag, $llx, $lly, $urx, $ury) = split;
			next;
		}
		$title = $1, next if /^%%Title: (.*)$/;
		$incomments = 0, $inprolog = 1, next if /^$/;
		$incomments = 0, $inprolog = 1, next if /^%%EndComments/;
		push(@comments, $_);
		next;
	}
	if ($inprolog) {
		$inprolog = 0, next if /^%%EndSetup/;
		$pointsize = $1, next if /^\/pointsize ([0-9\.]+) def/;
		$psxmin = $1, next if /^\/psxmin ([0-9\.]+) def/;
		$psymin = $1, next if /^\/psymin ([0-9\.]+) def/;
		$psxmax = $1, next if /^\/psxmax ([0-9\.]+) def/;
		$psymax = $1, next if /^\/psymax ([0-9\.]+) def/;
		next;
	}
	next unless /^\/B[0-9]/;
#/B434 { 157.858 95.719 20.2525 1.80224 Cw BX } def
	($name, $lbrack, $x, $y, $w, $h) = split;
	$right = $x + $w;
	$l2r{$x} = $right if $right > $l2r{$x};
}

$rightadj = $pointsize / 5;
sub byval { $a <=> $b; }
foreach $left (sort byval keys %l2r) {
	push(@lefts, $left);
	$right = $l2r{$left} + $rightadj;
	push(@rights, $right);
	print STDERR "\t$left\t$right\n" if $printlinesflag;
}

if ($tartiles) {
	$lastpoints = $pointsize; $outpoints = $pointsize;
	for(;;) {
		if ($outpoints > 10) { $outpoints = int($outpoints) + 1; }
		elsif ($outpoints > 6) {$outpoints = (int($outpoints * 2)+1)/2;}
		elsif ($outpoints > 4) {$outpoints = (int($outpoints * 4)+1)/4;}
		else { $outpoints *= $tryfact; }
#print STDERR "$outpoints\n";
		&initscale;
		$tottiles = &showtheboxes(-1);
		if ($tottiles > $tartiles) {
			$outpoints = $lastpoints;
			last;
		}
		$lastpoints = $outpoints;
	}
}

#print STDERR "A $outpoints points, $tottiles tiles\n";
&initscale;
$tottiles = &showtheboxes(-1);
#print STDERR "B $outpoints points, $tottiles tiles\n";
&printheader(0);
&printlines if $printlinesflag;

&showtheboxes(0);
&catfile;
&showtheboxes(0);
&showtheboxes(1);
close(STDOUT);
exit(0);

sub initscale {
	$tilescale = $outpoints / $pointsize;
	$tilewid = $paperx / $tilescale;
	#$xstep = ($paperx - ($xmarge * 2)) / $tilescale;
	$xstep = ($urx - llx) / $tilescale;
	$tileht = $papery / $tilescale;
	$ystep = ($papery - ($ymarge * 2)) / $tilescale;
	
	$yht = $ury - $lly;
	$yhtadj = $yht - (($ymarge * 2) / $tilescale);
	$yhtadj = $yht;
	$ysperc = $yhtadj / $ystep;
	$nysperc = int($ysperc);
#print STDERR "papery $papery ymarge $ymarge tilescale $tilescale lly $lly ury $ury\n";
#print STDERR "yht $yht yhtadj $yhtadj ystep $ystep ysperc $ysperc nysperc $nysperc\n";
	$ystep = ($yhtadj / ($nysperc + 1));
	$ystep = ((($yht + (($ymarge * 2) / $tilescale)) - $tileht) / $nysperc);
	#print STDERR "ystep $ystep\n";
}

sub printheader {
	local($tileno) = @_;
	&setfile($tileno) if $prefix;
	print <<EOS;
%!PS-Adobe-3.0 EPSF-3.0
%%BoundingBox: 0 0 $paperx $papery
EOS
	print "%%Title: $tottiles tiles of $title\n" if !$tileno;
	print "%%Title: tile $tileno of $tottiles for $title\n" if $tileno;
	print @comments;
	print <<EOS;
%%EndComments
0 0 moveto 0 792 rlineto 612 0 rlineto 0 -792 rlineto closepath clip
20 dict begin
/realshowpage { showpage } bind def
/showpage { } def
EOS

	printf "/pagepoints %.4g def\n", $pagepoints;
	printf "/tilewid %.4g def\n", $tilewid;
	printf "/tileht %.4g def\n", $tileht;
	printf "/stbyml %.4g def\n", $ymarge;
	printf "/stbym %.4g def\n", $ymarge / $tilescale;
	printf "/stbxml %.4g def\n", $xmarge;
	printf "/stbxm %.4g def\n", $xmarge / $tilescale;
	print <<EOS;

/stbromfont { /Times-Roman findfont pagepoints scalefont setfont } def
/showthebox {
	gsave
	newpath
	/stbhue exch def /stby exch def /stbx exch def
	stbhue 0.8 0.8 sethsbcolor 1 setlinewidth 
% the box
	stbx stby moveto
	0 tileht rlineto tilewid 0 rlineto 0 tileht neg rlineto closepath stroke
% margin corners
	stbhue 0.6 0.6 sethsbcolor 2 setlinewidth 
	stbx stbxm add stby stbym add moveto currentpoint
	stbxm 0 rlineto stroke moveto 0 stbym rlineto stroke
%
	stbx stbxm add stby tileht add stbym sub moveto currentpoint
	stbxm 0 rlineto stroke moveto 0 stbym neg rlineto stroke
%
	stbx tilewid add stbxm sub stby tileht add stbym sub moveto currentpoint
	stbxm neg 0 rlineto stroke moveto 0 stbym neg rlineto stroke
%
	stbx tilewid add stbxm sub stby stbym add moveto currentpoint
	stbxm neg 0 rlineto stroke moveto 0 stbym rlineto stroke
%
	0 setgray 0 setlinewidth
	1 setgray 0 setlinewidth
	stbx stbxm add stby stbym add moveto currentpoint
	0 pagepoints 1.1 mul rlineto
	stbromfont ( tile 000 ) stringwidth pop dup 0 rlineto
	0 pagepoints 1.2 mul neg rlineto
	neg 0 rlineto closepath fill
	0 setgray 0 setlinewidth
	moveto stbromfont ( tile ) show 12 string cvs show
	newpath
	grestore
} def

/begatile {
	gsave
	dup scale
	/stby exch def /stbx exch def
	stbx neg stby neg translate
} def

/endatile {
	grestore
	stbxml stbyml moveto stbromfont ( tile ) show 12 string cvs show
	realshowpage
} def

EOS
}

sub tilefilename {
	local($tileno, $suffix) = @_;
	local($tilefile);
	return(sprintf("%s%02d.%s", $prefix, $tileno, $suffix));
}

sub setismap {
	local($flag) = @_;
	return if !$ismap;
	local($ismapfile, $ismaphtml, $gif);
	$ismapfile = ">$prefix.map";
	$ismaphtml = ">${prefix}map.html";
	if (!open(IS, $ismaphtml)) {
		warn "Can't open $ismaphtml";
		$ismap = "";
		return;
	}
	$gif = &tilefilename(0, "gif");
	print IS <<EOS;
<HTML>
<HEAD>
<TITLE>Image map of $tottiles tiles of $title</TITLE>
</HEAD>
<BODY>
<H3>
<IMG ALIGN=BOTTOM SRC="$litdir/$gif"
ALT="[$title]">
Image map of $tottiles tiles of $title
</H3>
EOS
	if ($ismap =~ /ncsa/) {
		print IS "<a href=\"/cgi-bin/imagemap/$prefix\">\n";
	} else {
		print IS "<a href=\"/img/$prefix.map\">\n";
	}
	print IS <<EOS;
<IMG SRC="$bigdir/$gif" ISMAP></a>
<hr>
<a href="index.html">back to main index</a>
</BODY>
</HTML>
EOS
	close(IS);
	if (!open(ISMAP, $ismapfile)) {
		warn "Can't open $ismapfile";
		$ismap = "";
		return;
	}
	print ISMAP "default $urlbase/${prefix}no.html\n";
	while ($maptile = pop(@maptiles)) {
		($x, $y, $tileno) = split("\t", $maptile);
		&doismap($x, $y, $tileno);
	}
	close(ISMAP);
}

sub saveismap {
	local($x, $y, $tileno) = @_;
	return if !$ismap;
	push(@maptiles, join("\t", $x, $y, $tileno));
}

sub doismap {
	local($x, $y, $tileno) = @_;
	return if !$ismap;
	local($tilefile, $url, $turx, $tury, $formurl);
	$turx = $x + $tilewid; $tury = $y + $tileht;
	$y = $papery - $y; $tury = $papery - $tury;
	$x = int($x); $y = int($y);
	$turx = int($turx); $tury = int($tury);
	$tilefile = &tilefilename($tileno, "html");
	$url = "$urlbase/$tilefile";
	$formurl = $ismaps{$ismap};
	printf ISMAP $formurl, $url, $x, $tury, $turx, $y if $ismap =~ /ncsa/;
	printf ISMAP $formurl, $x, $tury, $turx, $y, $url if $ismap =~ /cern/;
}

sub showtheboxes {
	local($which) = @_;
	local($y, $tileno);
	if ($which > 0) {
		$date=`date`; chop($date);
		print <<EOS;
72 2 div 792 72 2 div sub pagepoints add moveto stbromfont 
($tottiles tiles in $outpoints point $date) show
realshowpage end
EOS
	}
	$tileno = 0;
	for ($y = ($ury - $tileht) + ($ymarge / $tilescale),
	$yc = $nysperc + 1; $yc--; $y -= $ystep) {
		$tileno = &showxboxes($y, $tileno, $which);
	}
	if ($which > 0 && $ismap) { &setismap; }
	return($tileno);
}

sub showxboxes {
	local($y, $tileno, $which) = @_;
	local($x, $xnext, $doright); # , $hue);
	for($x = $llx; $x < $urx;) {
		++$tileno;
#print STDERR "tile $tileno\n";
		if ($which > 0) {
			&dofile($x, $y, $tileno);
			&saveismap($x, $y, $tileno);
		} elsif ($which == 0) {
			$hue += 0.777;
			$hue -= 1 if $hue > 1;
			printf "%d %.4g %.4g %.4g showthebox\n",
				$tileno, $x, $y, $hue;
		}
		$xnext = $x + $xstep;
#print STDERR "$x\t$xnext\t$urx\n";
		if ($xnext >= ($urx - ($xmarge/$tilescale))) {
			return($tileno);
		}
		$doright = 0;
		for $right (@rights) {
			if (($right > $x) && ($right <= $xnext)){
				$doright = $right;
			}
		}
		if ($doright) { $x = $doright; } else { $x = $xnext; }
	}
	return($tileno);
}

sub printlines {
	if (!$linesprinted++) {
		printf "/lly %.4g def\n", $lly;
		printf "/ury %.4g def\n", $ury;
		print <<EOS;
/lineleft {
	/llarg exch def
1 0 0 setrgbcolor llarg lly moveto llarg ury lineto stroke
} def
/lineright {
	/llarg exch def
0 0 1 setrgbcolor llarg lly moveto llarg ury lineto stroke
} def
EOS
	}
	print <<EOS;

gsave
0 1 0 setrgbcolor
0 $lly moveto $urx $lly lineto stroke
0 $ury moveto $urx $ury lineto stroke
EOS
	foreach $left (@lefts) {
		$right = $l2r{$left};
		printf "%.4g lineleft ", $left;
		printf "%.4g lineright\n", $right;
	}
	print "0 0 0 setrgbcolor grestore\n";
}

sub dofile {
	local($x, $y, $tileno) = @_;
	&printheader($tileno);
	printf "%.4g %.4g %.4g begatile\n", $x, $y, $tilescale;
	&catfile;
	print "$tileno endatile end\n";
}

sub setfile {
	local($tileno) = @_;
	$tilefile = &tilefilename($tileno, "ps");
	close(STDOUT);
	unlink($tilefile);
	open(STDOUT, ">$tilefile") || die "Can't open >$tilefile";
}

sub catfile {
	if ($prefix) {
		close(STDOUT);
		system "cat $filename >>$tilefile";
		open(STDOUT, ">>$tilefile") || die "Can't open >>$tilefile";
		return;
	}
	print "($filename) run\n";
}