# -*- perl -*-
# MainCell.pm $Id: MainCell.pm,v 1.9.2.2 2000/01/30 13:56:23 jens Exp $
# (C) Copyright Jens G Jensen <jens@argaeus.ma.rhul.ac.uk>
# This file is part of epsmerge and is distributed under GNU GPL

package MainCell;

use strict;
use Options;
use Cell;

use vars ('@ISA');

@ISA = ('Cell');


# Input: reference to list of Cells (one for each page)
sub new {
    my $class = shift;
    my $opt = Options->new();

    # begin width and height stuff
    # It is said: two ways to bound box; from without (specified by user)
    # or within (by packing cells).
    my ($w, $h) = ($opt->getopts('ph') || 0, $opt->getopts('pw') || 0);
    if( $w == 0 || $h == 0 ) {
	my $paper = $opt->getopts('p');
	($w, $h) = @$paper;
    }
    if( $opt->getopts('stack') ) {
	$w = $h = 0;					# calculated from within instead
    }
    # end width and height stuff

    my $self = Cell->new( $opt->getopts('o'), scalar localtime(), 'MainCell', $w, $h);
    $self->{cont} = shift;

    bless $self, $class;
    return $self;
}


# Arguments:
#	1. A CompositeCell reference corresponding to the page to display;
#	2. The page number (as in 1 ... #pages);
#	3. Ref to procedure array;
#	4. Ref to DSC hash (described in a comment in Driver::new), see
#	   also _write() below.
# Called from: MainCell::write
# Returns:
#	error message if error occured.
sub _write {
    my ($self, $cell, $page, $procs, $dsc) = @_;
    my $opt = Options->new();
    if( $page == 1 || !$opt->getopts('ps')) {
	if( $opt->getopts('ps') ) {
	    print "%!PS-Adobe-3.0\n";
	}
	else {
	    print "%!PS-Adobe-3.0 EPSF-3.0\n";
	}
	my @dim = $self->dim();
	$self->{'atend'} = ! @dim || $dim[0] == 0 || $dim[1] == 0
	  if ! defined $self->{'atend'};
	if( $self->{'atend'} ) {
	    print "%%BoundingBox: (atend)\n";
	}
	else {
	    printf "%%%%BoundingBox: %d %d %d %d\n", 0, 0, @dim;
	}
	printf "%%%%Creator: (epsmerge %s)\n", $opt->getopts('v');
	print "%%CreationDate: ", scalar localtime, "\n";
	if(defined $ENV{USER}) {
	    if(defined $ENV{HOSTNAME}) {
		print "%%For: $ENV{USER} at $ENV{HOSTNAME}\n";
	    }
	    else {
		print "%%For: $ENV{USER}\n";
	    }
	}
	printf "%%%%Title: (%s)\n", $opt->getopts('o');
	print "%%Orientation: ", $opt->getopts('O') eq 'L' ? "Landscape\n" : "Portrait\n";
	if( $opt->getopts('ps') ) {
	    printf "%%%%Pages: %d\n", scalar @{$self->{cont}};
	    print "%%PageOrder: Ascend\n";
	}
	print "LanguageLevel ", $dsc->{'language'}, "\n"
	    if( $dsc->{'language'} > 0 );
	# In the following bareblock we list supplied resources...
	$self->write_dsc_line( '%%DocumentSuppliedResources:', $dsc->{'supplied'} );
	# ...and now the needed resources
	$self->write_dsc_line( '%%DocumentNeededResources:', $dsc->{'needed'} );

	print "%%EndComments\n";
	# write prolog
	print "%%BeginProlog\n";
	foreach (@$procs) { print; }
	print "%%EndProlog\n";
    }
    if( $opt->getopts('ps') ) {
	printf "%%%%Page: %d %d\n", $page, $page;
    }

print <<SETUP;
0 setgray 0 setlinecap 1 setlinewidth
0 setlinejoin 10 setmiterlimit
[ ] 0 setdash newpath
SETUP
# if( $self->{cont}->getresource('LanguageLevel:') >= 2 ) {
# print "false setoverprint false setstrokeadjust\n"
# }


    my ($w, $h) = $self->dim();
    my ($lmar, $tmar, $bmar, $rmar) = $opt->getopts('lmar', 'tmar', 'bmar', 'rmar');
    # rotate image if we print in landscape mode
    if( $opt->getopts('O') eq 'L' ) {
	printf "%d 0 translate 90 rotate\n", $w;
	my $val = $cell->write( $lmar, $bmar, $h-$rmar, $w-$tmar );
	return $val if $val;
    }
    else {
	my $val = $cell->write( $lmar, $bmar, $w-$rmar, $h-$tmar );
	return $val if $val;
    }
    if( $self->{'atend'} ) {
	my @dim = $cell->dim();
	if( ! @dim ) {
	    return "MainCell::write: couldn't (or didn't) get a boundingbox for files";
	}
	# probably get the largest one
	if( !defined $self->{'maxdim'} ) {
	    $self->{'maxdim'} = \@dim;
	}
	else {
	    $self->{'maxdim'}->[0] = $self->{'maxdim'}->[0] > $dim[0] ? $self->{'maxdim'}->[0] : $dim[0];
	    $self->{'maxdim'}->[1] = $self->{'maxdim'}->[1] > $dim[1] ? $self->{'maxdim'}->[1] : $dim[1];
	}
    }

    # unrotate image if in landscape mode (coordinate system being
    # preserved by save/restore pair)
    if( $opt->getopts('O') eq 'L' ) {
	printf "-90 rotate %d 0 translate\n", $w;
    }

    print "showpage\n" if $opt->getopts('print') || $opt->getopts('ps');
    if( ! $opt->getopts('ps') || $page == @{$self->{cont}} ) {
	if( $self->{'atend'}) {
	    my @dim;
	    if( defined $self->{'maxdim'} ) { @dim = @{$self->{'maxdim'}}; }
	    else { @dim = $cell->dim(); }
	    if( ! @dim ) {
		return "MainCell::write: couldn't (or didn't) get a boundingbox for files";
	    }
	    print "%%Trailer\n";
	    printf "%%%%BoundingBox: 0 0 %d %d\n", @dim;
	}
	print "%%EOF\n";
    }
    return;
}



# Arguments: ref to array of procs, ref to array of dsc
# Called from: Driver::write
# Returns: error message if error arose
sub write {
    my ($self, $procs, $dsc) = @_;
    my @indx;			# index part of filename for multi-file
    my $opt = Options->new();
    my @pages = @{$self->{'cont'}};

    if( $opt->getopts('ps') eq 'default' ) {
	$opt->setopts( ps =>
		       $opt->getopts('o') =~ /\.eps$/i ? 0 : 1 );
    }

    # create filename for writing multiple eps files
    if( ! $opt->getopts('ps') && @pages > 1 ) {
	my $o = $opt->getopts('o');
	return "Can't write multiple files to stdout; see docs for details\n"
	    if( $o eq 'stdout' );
	my ($i, $m);
	for( $i = 1, $m = 10; $m < @pages; ++$i, $m *= 10) { }
	# $m is now log10(@pages) rounded up
	my ($name, $ext);
	if( $o =~ /^(.*)(\.e?ps)$/ ) {
	    $name = $1; $ext = $2;
	}
	else {
	    $name = $o; $ext = '.eps';
	}
	$name .= '-';
	my @tmp = split //, $name;
	@indx = ( scalar @tmp, $i );
	$o = $name . ( '0' x $i ) . $ext;
	$opt->setopts( o => $o );
    }

    # select output except if printing to several files (done below instead)
    if( $opt->getopts('o') ne 'stdout' ) {
	if( $opt->getopts('ps') ) {
	    open(OUTFILE, ">" . $opt->getopts('o'))
		or return "Cannot open output file " . $opt->getopts('o') . " for writing\n";
	    select OUTFILE;
	}
    }
    else {
	select STDOUT;
    }

    my $page;
    for($page = 1; @pages; ++$page) {
	unless( $opt->getopts('ps') ) {
	    # opening new OUTFILE closes previous OUTFILE
	    open(OUTFILE, ">" . $opt->getopts('o'))
		or return "Cannot open output file " . $opt->getopts('o') . " for writing\n";
	    select OUTFILE;
	}
	my $msg = $self->_write(shift @pages, $page, $procs, $dsc);
	return $msg if $msg;
	if( @indx ) {
	    # update filename
	    my $o = $opt->getopts('o');
	    ++ substr( $o, $indx[0], $indx[1] );
	    $opt->setopts( o => $o );
	}
    }
    close(OUTFILE) if $opt->getopts('o') ne 'stdout';
    return;
}

sub write_stuff {
    my ($self, $what, $stuff) = @_;
    my ($k, $v);
    while( each %$stuff ) {
	# Now find the original file and copy it from that
	my ($fname, $beg, $end) = @$v;
	if( !open(FILE, "<$fname") || !seek(FILE, $beg, 0) ) {
	    Options->new()->getopts('-io-')->message("Cannot reopen $fname", 'E');
	    return;
	}
	print "Begin$what: $k\n";
	while( tell FILE < $end ) {
	    $_ = <FILE>;
	    next if /^%%/;
	    s/(^|\W)showpage(\W|$)/$1$2/g;	# same as in Eps
	    print;
	}
	print "End$what\n";
    }
}

1;