# -*- perl -*-
# Cell.pm $Id: Cell.pm,v 1.12 1999/01/25 18:09:00 jens Exp $
# (C) Copyright Jens G Jensen <jens@arcade.mathematik.uni-freiburg.de>
# This file is part of epsmerge and is distributed under GNU GPL

package Cell;

use strict;

# Constructor parameters should be:
# 1: filename, 2: creation date (string), 3: title,
# 4: width (in points), 5: height (in points)
sub new {
    my $class = shift;
    my $self = { 'f' => $_[0], 'd' => $_[1], 'T' => $_[2], dim => [ $_[3], $_[4] ] };
    return bless $self, $class;
}

sub write {
    die "Cell::write: you should overload this method\n";
}

# Return width and height of the Cell's boundingbox
sub dim {
    my $self = shift;
    return @{$self->{'dim'}};
}

# Return the aspect ratio of the Cell
sub asprat {
    no integer;
    my $self = shift;
    my ($w, $h) = $self->dim();
    return $h / $w;
}    

# Given a new boundingbox calculate scaling parameters allowing us
# to fit into the new box.
sub getscale {
    my $self = shift;
    my @newbox = @_;
    my @dim = $self->dim();
    my ($xsc, $ysc);
    no integer;
    $xsc = ($newbox[2] - $newbox[0]) / $dim[0];
    $ysc = ($newbox[3] - $newbox[1]) / $dim[1];
    return ($xsc, $ysc);
}

# getlabel should return a label string as follows:
# T: title (must be upper case, since 't' means place-on-top)
# d: creation date
# f: filename
# F: filename, extension (if any) stripped
# i: prompt user for a string
# s: run a perl script to get a label string, script (currently) passed as the next parameter
sub getlabel {
    my $self = shift;
    $_ = shift;
    if( /[fdT]/ ) {
	return $self->{$_};
    }
    elsif( /F/ ) {
	my $fname = $self->{f};
	$fname =~ s/\.\w*$//;
	return $fname;
    }
    elsif( /i/ ) {
	if( -t STDIN && -t STDOUT ) {
	    printf STDOUT "Enter a one line label for %s: ", $self->{f};
	    my $line = <STDIN>;
	    chomp $line;
	    return $line;
	}
	print STDERR "epsmerge: Can't read labels interactively\n";
    }
    elsif( /s/ ) {
	my ($script, $n, $l) = @_;		  # get the script and the extra vars
	# make some vars available to the script:
	my $f = $self->{f};
	my $line = eval $script;
	if( $@ ) {
	    print STDERR "Label script returns error: $@\n";
	    $line = "";
	}
	chomp $line;
	return $line;
    }
    else {
	print STDERR "Warning: Unknown label option $_\n";
    }
    return "";
}


package EpsCell;

use vars ('@ISA');

@ISA = ('Cell');

use strict;
use Eps;


# Create a Cell by passing a filename of an EPS file
sub new {
    my $self = shift;
    my $eps = Eps->new( $_[0] );
    my @bbox = $eps->box();
    my $data = Cell->new($eps->getlabel('f'), $eps->getlabel('d'), $eps->getlabel('T'), $bbox[2]-$bbox[0], $bbox[3]-$bbox[1]);
    $data->{cont} = $eps;
    bless $data, $self;
}

sub write {
    my $self = shift;
    $self->{cont}->write( @_, $self->getscale( @_ ) );
}

sub labels {
    my $self = shift;
    return $self->{cont}->labels( shift );
}


package LabelDecoratorCell;

use strict;

use vars qw(@ISA $Cell_Count $Last_Script);

$Cell_Count = 0;
$Last_Script = "";

@ISA = ('Cell');

# Input: cell reference, default fontsize, input data, label script (req'd only for 's')
# (note: LabelDecoratorCell doesn't know if it's generating headers or labels)
sub new {
    my $class = shift;
    my $cont = shift;
    my $opt = Options->new();
    my $data = Cell->new( $cont->getlabel('f'), $cont->getlabel('d'), $cont->getlabel('T'), $cont->dim() );
    $data->{cont} = $cont;
    $data->{font} = $opt->getopts('fn');
    $data->{size} = shift;
    $data->{'pos'} = shift;
    if( $data->{'pos'} =~ /(\d+)$/ ) {
	$data->{size} = $1;
    }
    if( $data->{'pos'} =~ /s/ ) {		  # script required
	if( defined $_[0] ) {
	    $data->{script} = shift;
	}
	else {
	    print STDOUT "Label generating script required for ", $cont->getlabel('f'), ": ";
	    my $line = <STDIN>;
	    chomp( $line );
	    if( $line ) {
		$Last_Script = $data->{script} = $line;
	    }
	    else {
		$data->{script} = $Last_Script;
	    }
	}
    }
    $data->{num} = $Cell_Count++;
    return bless $data, $class;
}

sub write {
    my $self = shift;
    my @bbox = @_;
    my @lbox = @_;
    my $width = $bbox[2]-$bbox[0];
    $self->{text} = $self->_getlabels( $self->{'pos'} );
    my $height = @{$self->{text}} * $self->{size};
    if( $self->{'pos'} =~ /^t/ ) {
	$bbox[3] -= $height;
	$lbox[1] = $bbox[3];
    }
    else {
	$bbox[1] += $height;
	$lbox[3] = $bbox[1];
    }
    $self->_writelabels( @lbox );
    $self->{cont}->write( @bbox );
}

sub _getlabels {
    my ($self, $todo) = @_;
    $todo =~ s/^[tb]//;				  # remove top/bottom specifier if present
    $todo =~ s/\d+$//;				  # remove trailing digits
    my @todo = split //, $todo;			  # explode string into characters
    @todo = qw(F d) unless @todo;		  # some default values
    my @message = ();
    my $linenum = 0;
    foreach (@todo) {
	if( /^s$/ ) {				  # scripting?
	    push @message, $self->getlabel($_, $self->{script}, $self->{num}, $linenum++);
	}
	else {
	    push @message, $self->getlabel($_);
	}
    }
    return \@message;
}

sub _writelabels {
    my $self = shift;
    my @bbox = @_;
    $bbox[2] -= $bbox[0]; $bbox[3] -= $bbox[1];
    print <<SETUP;
gsave /$self->{font} findfont $self->{size} scalefont setfont
$bbox[0] $bbox[1] translate newpath
0 0 moveto $bbox[2] 0 rlineto 0 $bbox[3] rlineto
-$bbox[2] 0 rlineto closepath clip
SETUP
    # the baseline is assumed to be at 1/4 of the font's height;
    # this should work OK for most text fonts
    no integer;
    my $ypos = $bbox[3] - $self->{size} * 3 / 4;
    foreach( @{$self->{text}} ) {
	# Maybe escape unescaped parens in $_?
	print "(", $_, ") ";
	# Maybe this should be coded as a PS-function, but where?
	print <<CENTER;
dup stringwidth pop neg $bbox[2] add 2 div
dup 0 le { pop 0 } if $ypos moveto show
CENTER
        $ypos -= $self->{size};
    }
    print "grestore\n";
}

sub newpage {
    $Cell_Count = 0;
}

package CompositeCell;

use Options;
use vars ('@ISA');

@ISA = ('Cell');

use strict;

# Parameters: width, height, cell ref list, formatter ref.
sub new {
    my $class = shift;
    my $opt = Options->new();
    my $fname = $opt->getopts('o');
    my $data = Cell->new($fname, scalar localtime(), $fname, $_[0], $_[1]);
    $data->{form} = pop;	# get the formatter reference
    splice @_, 0, 2;		# lose dimensions
    $data->{cont} = [ @_ ];	# contents: cell references
    bless $data, $class;
    return $data;
}

sub write {
    my $self = shift;
    my @bbox = @_;
    my $opt = Options->new();
    $bbox[0] += $opt->getopts('lmar'); $bbox[1] += $opt->getopts('bmar');
    $bbox[2] -= $opt->getopts('rmar'); $bbox[3] -= $opt->getopts('tmar');
    $self->{form}->format( @bbox, $self );
}

# Data access functions
sub cells {
    my $self = shift;
    return @{$self->{cont}};
}

1;