# -*- perl -*-
# Cropmarks.pm $Id: Cropmarks.pm,v 1.1 1999/03/27 15:09:06 jens Exp $
# (C) Copyright Jens G Jensen <jens@math.u-strasbg.fr>
# This file is part of epssplit and is distributed under GNU GPL

# The Cropmarks is a Decorator design pattern (er, except that it
# doesn't derive from a common base class).  It is just a layer slotted
# in over the Eps that writes cropmarks and labels on the image, before
# passing the pen on to the Eps file itself.

package Cropmarks;

use strict;
use Options;

# Construct this with the contents (probably an Eps)
sub new {
  my $class = shift;
  my $opt = Options->new();
  my $self = { cont => shift };
  $self->{ border } = $opt->getopts('border');
  $self->{ fs } = $opt->getopts('fs');
  return bless $self, $class;
}

sub write {
  my $self = shift;
  my ($llx, $lly, $urx, $ury, $ox, $oy, $label) = @_;
  my $b = $self->{border};
  if( $b > 0 ) {
    
    # cropmarks leave $blank points at either end blank
    my $blank = 2;
    my $length = $b-2*$blank;
    if( $length > 0 ) {
      print "0 setlinewidth\n";	# smallest physically possible of device
      printf "%d %d moveto %d %d rlineto stroke\n", $llx+$blank, $lly+$b, $length, 0;
      printf "%d %d moveto %d %d rlineto stroke\n", $llx+$b, $lly+$blank, 0, $length;
      printf "%d %d moveto %d %d rlineto stroke\n", $urx-$b, $lly+$blank, 0, $length;
      printf "%d %d moveto %d %d rlineto stroke\n", $urx-$blank, $lly+$b, -$length, 0;
      printf "%d %d moveto %d %d rlineto stroke\n", $urx-$blank, $ury-$b, -$length, 0;
      printf "%d %d moveto %d %d rlineto stroke\n", $urx-$b, $ury-$blank, 0, -$length;
      printf "%d %d moveto %d %d rlineto stroke\n", $llx+$b, $ury-$blank, 0, -$length;
      printf "%d %d moveto %d %d rlineto stroke\n", $llx+$blank, $ury-$b, $length, 0;
      print "1 setlinewidth\n";	# back to default
      
      # now do the label thing; it is assumed that the baseline is 1/4 of the height
      my $width = $urx-$llx-2*$b;
      no integer;
      my $base = $lly + 0.5*($b-$self->{fs}) + 0.25*$self->{fs};
      my $minx = $llx+$b;
      
      $label =~ s/\(/\\\(/g; $label =~ s/\)/\\\)/g;
      print <<HERE;
/Times-Roman findfont $self->{fs} scalefont setfont
($label)
dup stringwidth pop neg $width add 2 div
dup 0 le { pop 0 } if $minx add $base moveto show
HERE
}
    }

  $self->{cont}->write($llx+$b, $lly+$b, $urx-$b, $ury-$b, $ox, $oy);
}

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

sub getsize {
  my $self = shift;
  my $b = $self->{border};
  my @box = @_;
  $box[0] += $b; $box[1] += $b;
  $box[2] -= $b; $box[3] -= $b;
  return $self->{cont}->getsize(@box);
}


# Create a blank margin around the image.  This is also just a
# layer (Decorator) that lives on top of the other layers.

package Margin;

use strict;

sub new {
  my $class = shift;
  my $self = { cont => shift };
  $self->{mar} = Options->new()->getopts('mar');
  return bless $self, $class;
}

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

sub getsize {
  my $self = shift;
  my @box = @_;
  my $mar = $self->{mar};
  $box[0] += $mar; $box[1] += $mar;
  $box[2] -= $mar; $box[3] -= $mar;
  return $self->{cont}->getsize(@box);
}

sub write {
  my $self = shift;
  my @boxetc = @_;
  my $mar = $self->{mar};
  $boxetc[0] += $mar; $boxetc[1] += $mar;
  $boxetc[2] -= $mar; $boxetc[3] -= $mar;
  $self->{cont}->write(@boxetc);
}

1;