#!/usr/bin/perl -w
#
# scanpdf -- scan images and convert them to PDF format.
# Copyright (C) 2000 Sebastian Marius Kirsch <skirsch@moebius.inka.de>,
# all rights reserved.
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2 of the License, or (at your
# option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 675 Mass Ave, Cambridge, MA 02139, USA.
#

use strict;
use pdflib_pl 3.0;
use Term::ReadLine;
use FileHandle;
use IPC::Open2;
use Carp;
use Getopt::Long;

package Imgtype;

use vars qw(%imgtype);

$imgtype{png} = Imgtype->new(type => "png", extension => ".png",
		      postproc => "pnmtopng");
$imgtype{gif} = Imgtype->new(type => "gif", extension => ".gif",
		      postproc => "ppmtogif" );
$imgtype{jpeg} = Imgtype->new(type => "jpeg", extension => ".jpg",
		       postproc => "cjpeg" );
$imgtype{tiff} = Imgtype->new(type => "tiff", extension => ".tif",
		       postproc => "pnmtotiff" );

sub new () {
    my $class = shift;
    return bless { @_ }, $class;
}

sub list () {
    return sort keys %imgtype;
}

sub find () {
    my ($class_or_object, $imgtype) = (shift, shift);
    return exists($imgtype{$imgtype}) ? $imgtype{$imgtype} : undef;
}

sub AUTOLOAD () {
    my $self = shift;
    my $type = ref($self) || warn "$self is not an object.\n";
    (my $name = $Imgtype::AUTOLOAD) =~ s/.*://;
    
    if ($name eq "DESTROY") {
	return undef;
    }
    
    unless (exists $self->{$name}) {
	warn "Can't access $name field in object of class $type.\n";
    }
    if (@_) {
	return $self->{$name} = shift;
    } else {
	return $self->{$name}
    }
}

package Papersize;

use vars qw(%papersize);

$papersize{a0} = Papersize->new(name => "a0", width => 841, height => 1189);
$papersize{b0} = Papersize->new(name => "b0", width => 1000, height => 1414);
$papersize{c0} = Papersize->new(name => "c0", width => 917, height => 1297);

foreach my $series ("a", "b", "c") {
    foreach (1 .. 10) {
	$papersize{$series . $_} = 
	    Papersize->new(
			   name => $series . $_,
			   width => $papersize{$series . ($_ - 1)}->height / 2,
			   height => $papersize{$series . ($_ - 1)}->width
			   );
    }				  
}

$papersize{letter} = Papersize->new(name => "letter", width => 215.9, height => 279.4);

foreach (keys %papersize) {
    $papersize{$_ . "l"} = 
	Papersize->new(
		       name => $_ . "l",
		       width => $papersize{$_}->height,
		       height => $papersize{$_}->width
		       );
}

sub new () {
    my $class = shift;
    return bless { @_ }, $class;
}

sub list () {
    return sort keys %papersize;
}

sub find () {
    my ($class_or_object, $papersize) = (shift, shift);
    return exists($papersize{$papersize}) ? $papersize{$papersize} : undef;
}

sub AUTOLOAD () {
    my $self = shift;
    my $type = ref($self) || warn "$self is not an object.\n";
    (my $name = $Papersize::AUTOLOAD) =~ s/.*://;
    
    if ($name eq "DESTROY") {
	return undef;
    }
    
    unless (exists $self->{$name}) {
	warn "Can't access $name field in object of class $type.\n";
    }
    if (@_) {
	return $self->{$name} = shift;
    } else {
	return $self->{$name}
    }
}

package ScanPDF;

use vars qw($VERSION);

$VERSION = \"0.01";

package main;

use vars qw($tempdir %scan %commands %params @images $term $get_a_line);

sub initialize () {
    $tempdir = "/tmp";
    $0 = 'scanpdf';

    $scan{device} = "umax:/dev/scanner";
    $scan{resolution} = 300;
    $scan{mode} = "c";
    $scan{top} = 0; $scan{left} = 0; $scan{width} = 210; $scan{height} = 297; # A4 page
    $scan{output} = "";
    $scan{paperwidth} = 0;
    $scan{paperheight} = 0;
    $scan{papersize} = undef;

    if (@ARGV) {
	$scan{output} = shift(@ARGV);
    }

    $get_a_line = sub { return $term->readline($_[0]) };

    $scan{imgtype} = Imgtype->find("png");

    foreach my $param (keys %scan) {
	$params{$param} = { set => \&setparam, variable => \$scan{$param} };
    }
    
    foreach my $param (qw(top left width height)) {
	$params{$param}->{set} = \&setdim;
    }
    
    foreach my $param (qw(paperheight paperwidth)) {
	$params{$param}->{set} = \&setpaperdim;
    }

    $params{imgtype} = { set => \&setimgtype, variable => \$scan{imgtype}->type };
    $params{papersize} = { 
	set => \&setpapersize, 
	variable => $scan{papersize} ? \$scan{papersize}->name : \undef };
    
    $commands{"quit"} = { action => \&cleanup,
			  syntax => 'quit',
			  doc => 'Quit the program, writing the PDF file.' };
    $commands{"scan"} = { action => \&scan,
			  syntax => 'scan',
			  doc => 'Scan an image, according to the current settings.' };
    $commands{"set"} = { action => \&set,
			 syntax => 'set <parameter> <setting>',
			 doc => 'Set <parameter> to <setting>.' };
    $commands{"show"} = { action => \&show,
			  syntax => 'show [<parameter>]',
			  doc => 'Show the current value of <parameter>, or, if not given, of all parameters.' };
    $commands{"display"} = { action => \&display,
			     syntax => 'display <number>',
			     doc => 'Display image <number>.' };
    $commands{"images"} = { action => \&images,
			    syntax => 'images',
			    doc => 'List images.' };
    $commands{"write"} = { action => \&writepdf,
			   syntax => 'write',
			   doc => 'Write the output file.' };
    $commands{"delete"} = { action => \&deleteimg,
			    syntax => 'delete <number>',
			    doc => 'Delete image <number>.' };
    $commands{"help"} = { action => \&help,
			  syntax => 'help',
			  doc => 'Display this help screen.' };
    $commands{"macro"} = { action => \&macro,
			   syntax => 'macro <name>',
			   doc => 'Define a new macro, ended by "end".'};
    $commands{"source"} = { action => \&source,
			    syntax => 'source <file>',
			    doc => 'Read the given file, interpreting its contents as if they were given on the command line.' };

    $term = Term::ReadLine->new("scanpdf");
    ${$term->Attribs}{completion_entry_function} = ${$term->Attribs}{list_completion_function};
    ${$term->Attribs}{completion_word} = [ 
					  keys %commands, 
					  keys %params,
					  Imgtype->list,
					  Papersize->list,
					  ];

    my $home = $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($<))[7];

    foreach my $initfile ('/etc/scanpdfrc', $home . '/.scanpdfrc') {
	&source($initfile) if -f $initfile;
    }
}

&initialize;

# Hey, hello, this is the main loop!

while (defined($_ = &$get_a_line('scanpdf>'))) {
    &parse($_);
    if (not exists(${$term->Features}{"autohistory"})) {
        $term->addhistory($_) if /\S/;
    }
}

print "\n";
&cleanup;

sub parse () {
    my ($commandline) = @_;
    chomp($commandline);
    # "normalize" whitespace
    $commandline =~ s/\s+/ /g;
    # crop white space in front and aft.
    $commandline =~ s/^\s+//;
    $commandline =~ s/\s+$//;
    
    my ($command, $args) = split / /, $commandline, 2;
    if (defined($command)) {
	if (exists($commands{lc($command)})) {
	    &{$commands{lc($command)}->{action}}($args);
	} else {
	    warn "no such command: $command.\n";
	}
    }
}

sub cleanup () {
    &writepdf;

    foreach my $image (@images) {
	if (-f $image->{file}) {
	    unlink $image->{file};
	}
    }
    exit;
}

sub writepdf () {
    if ($scan{output} eq "") {
	warn "no output file given.\n"; return undef;
    }

    if (!@images) {
	warn "no input files.\n";
    }

    my ($pdffile) = $scan{output};

    my $pdf = PDF_new();
    PDF_open_file($pdf, $pdffile) or do { warn "could not open PDF file $pdffile.\n"; return undef; };

    foreach my $image (@images) {
	my $imgtype = $image->{imgtype};
	my $tempfile = $image->{file};
	my $scale = 72 / $image->{resolution};

	if ((my $pdfimage = PDF_open_image_file($pdf, $imgtype->type, $tempfile, "", 0)) != -1) {

	    $image->{width} = PDF_get_image_width($pdf, $pdfimage) * $scale / 72 * 25.4;
	    if ($image->{paperwidth}) {
		if ($image->{width} > $image->{paperwidth}) {
		    warn "image width is bigger than paper width; resizing image.";
		    $scale *= $image->{paperwidth} / $image->{width};
		} 
	    } else {
		$image->{paperwidth} = $image->{width};
	    }
	    
	    $image->{height} = PDF_get_image_height($pdf, $pdfimage) * $scale / 72 * 25.4;
	    if ($image->{paperheight}) {
		if ($image->{height} > $image->{paperheight}) {
		    warn "image height is bigger than paper height; resizing image.";
		    $scale *= $image->{paperheight} / $image->{height};
		} 
	    } else {
		$image->{paperheight} = $image->{height};
	    }

	    ($image->{llx}, $image->{lly}) = 
		&points(
		       ($image->{paperwidth} - $image->{width}) / 2, 
		       ($image->{paperheight} - $image->{height}) / 2
		       );

	    PDF_begin_page($pdf, &points($image->{paperwidth}), &points($image->{paperheight}));
	    
	    PDF_place_image(
			    $pdf, 
			    $pdfimage, 
			    $image->{llx}, 
			    $image->{lly},
			    $scale
			    );
	    PDF_close_image($pdf, $pdfimage);
	    PDF_setlinewidth($pdf, 1);
	    PDF_rect(
		     $pdf, 
		     $image->{llx}, 
		     $image->{lly}, 
		     &points(
			     $image->{width}, 
			     $image->{height}
			     )
		     );
	    PDF_closepath_stroke($pdf);
	    
	    PDF_end_page($pdf);
	}
    }
	
    PDF_close($pdf);
    PDF_delete($pdf);
}

sub tee () { 
    my ($from, $to, $count, $recvd) = (shift, shift, 0, 0);
    my $ind = (shift || '.');
    while ($recvd = read($from, my $buffer, 2**10)) {
	$count += $recvd;
	print $to $buffer;
	print $ind x int($count / 2**20);
	$count %= 2**20;
	undef $buffer;
    }
    return $recvd;
}

sub scan () {
    local %scan = %scan;

    $scan{file} = $tempdir . "/make-cover-" . $$ . "-" . scalar(@images) . $scan{imgtype}->extension;

    $scan{args} = "-d $scan{device} ";
    $scan{args} .= " -t $scan{top} -l $scan{left} -x $scan{width} -y $scan{height} ";
    $scan{args} .= " --resolution $scan{resolution} ";
    $scan{args} .= " --mode $scan{mode} ";

    STDOUT->autoflush;

    print "Scanning ";

    my ($scanout, $ppin, $ppout, $tempfile);
    foreach ($scanout, $ppin, $ppout, $tempfile) {
	$_ = FileHandle->new;
    }
    
    $scanout->open("scanimage $scan{args} |") or die "could not start scanimage process.\n";

    if (open($ppin, "|-")) {
	# parent
	if (! defined(&tee($scanout, $ppin))) {
	    die "An error occurred during scanning!\n";
	}
    } else {
	# child
	my $postproc = open2($ppout, "<&STDIN", $scan{imgtype}->postproc);
	$tempfile->open("> $scan{file}") or die "could not open temporary file $scan{file}.\n";
	if (! defined(&tee($ppout, $tempfile, '+'))) {
	    die "An error occurred during postprocessing!\n";
	}	
	if ((waitpid $postproc, 0) == -1) {
	    warn "My postprocessor ($postproc) is gone!\n";
	} else {
	    if ($? != 0) {
		if (($? >> 8) != 0) {
		    warn "postprocessor exited with status " . ($? >> 8) . "\n";
		} elsif (($? & 255) != 0) {
		    warn "postprocessor got killed by signal " . ($? & 255) . "\n";
		} else {
		    die "postprocessor failed: $!\n";
		}
	    }
	};
	$tempfile->close;
	$ppout->close;
	exit $?;
    }
    
    $scanout->close; 
    if ($? != 0) {
	if (($? >> 8) != 0) {
	    warn "scan process exited with status " . ($? >> 8) . "\n";
	} elsif (($? & 255) != 0) {
	    warn "scan process got killed by signal " . ($? & 255) . "\n";
	} else {
	    die "scan process failed: $!\n";
	}
    }

    $ppin->close;

    if (-s $scan{file}) {
	push @images, { %scan };
    }

    print "\n";
}

sub images () {
    my ($number, $image) = (0, {});

format IMAGES_TOP =
no.  type res  width x height   file
------------------------------------------------------------------------
.

format IMAGES =
@>>> @>>> @>>> @>>>> x @<<<<< @ @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$number, $image->{imgtype}->type, $image->{resolution}, $image->{width}, $image->{height}, $image->{mode}, $image->{file}
.


    my $old_format_name = $~;
    my $old_format_top_name = $^;
    
    STDOUT->format_name("IMAGES");
    STDOUT->format_top_name("IMAGES_TOP");
    STDOUT->format_lines_left(0);
    STDOUT->format_formfeed("");

    foreach $image (@images) {
	write;
	$number++;
    }

    STDOUT->format_name($old_format_name);
    STDOUT->format_top_name($old_format_top_name);

}

sub is_image () {
    my ($imageno) = @_;
    $imageno += 0;

    if ($imageno !~ /^\d+$/) {
	warn "$imageno is not an image number!\n";
	return undef;
    } elsif (defined($images[$imageno])) {
	return $imageno;
    } else {
	warn "image $imageno does not exist!\n";
	return undef;
    }
}

sub display () {
    if (defined(my $imageno = &is_image(shift))) {
	system("display " . $images[$imageno]->{file} . " &");
    }
}

sub deleteimg () {
    if (defined(my $imageno = &is_image(shift))) {
	unlink $images[$imageno]->{file};
	splice @images, $imageno, 1;
    }
}

sub show () { 
    my ($param) = @_;
    
    if ($param) {
	if ( exists($params{$param}) ) {
	    if (${$params{$param}->{variable}}) {
		print "$param = ${$params{$param}->{variable}}\n";
	    } 
	} else {
	    warn "no such parameter: $param.\n";
	} 
    } else {
	foreach $param (sort keys %params) { &show($param); }
    }
}

sub set () {
    if (! defined($_[0])) { &show; return undef; }

    my ($param, $setting) = split / /, $_[0], 2;

    if (exists($params{$param})) {
	if (defined($setting)) {
	    &{$params{$param}->{set}}($params{$param}->{variable}, $setting);
	} else {
	    &show($param);
	}
    } else {
	warn "no such parameter: $param.\n";
    }
}

sub setparam () {
    my ($param, $setting) = @_;
    $$param = $setting;
}

sub setimgtype () {
    my ($param, $setting) = @_;
    $setting = lc($setting);

    my $imgtypes = join '|', Imgtype->list;

    if ($setting =~ /($imgtypes)/) {
	$scan{imgtype} = Imgtype->find($setting);
	$params{imgtype}->{variable} = \$scan{imgtype}->type;
    } else {
	warn "no such image type: $setting.\n";
    }
}

sub setpapersize () {
    my ($param, $setting) = @_;
    $setting = lc($setting);

    my $papersizes = join '|', Papersize->list;

    if ($setting =~ /($papersizes)/) {
	$scan{papersize} = Papersize->find($setting);
	$params{papersize}->{variable} = \$scan{papersize}->name;
	$scan{paperheight} = $scan{papersize}->height;
	$scan{paperwidth} = $scan{papersize}->width;
    } else {
	warn "no such paper size: $setting.\n";
    }
}

sub setdim () {
    my ($param, $setting) = @_;

    my ($value, $unit) = ($setting =~ /(\d+)\s*([a-zA-Z]*)/);
    $unit = lc($unit);

    my %units = ( in => 25.4, cm => 10, pt => 25.4/72, '' => 1 );
    my $units = join '|', keys %units;

    if ($unit =~ /($units)/) {
	$value *= $units{$unit};
    } else {
	warn "unknown unit: $unit\n";
	return undef;
    }
    
    $$param = $value;
}

sub setpaperdim () {
    my ($param, $setting) = @_;
    if (&setdim($param, $setting)) {
	undef $scan{papersize};
    }
}

sub points () {
    return map { $_ / 25.4 * 72 } @_;
}

sub help () {
    foreach my $command (sort keys %commands) {
	print $commands{$command}->{syntax}, "\n";
	print "\t", $commands{$command}->{doc}, "\n";
    }
}

sub macro () {
    my ($macroname) = @_;
    my @macro = ();
    my $old_minline;

    if (defined($commands{$macroname})) {
	warn "command $macroname is already defined.\n";
	return undef;
    }
    
    if ( exists( ${$term->Features}{"autohistory"} ) ) {
        $old_minline = $term->MinLine(undef());
    }

    while (chomp($_ = &$get_a_line("macro $macroname>"))) {
	last if /^\s*end/;
	push @macro, $_;
    }
    
    if ( exists( ${$term->Features}{"autohistory"} ) ) {
        $term->MinLine($old_minline);
    }

    $commands{$macroname} = {
	action => sub {
	    foreach my $line (@macro) {
		&parse($line);
	    }
	},
	syntax => "$macroname",
        doc => "user-defined macro:\n\t" . join("\n\t", @macro)
    };

    push @{${$term->Attribs}{completion_word}}, $macroname;

    return $commands{$macroname};
}

sub source () {
    my ($file) = @_;
    if (-f $file) {
	if (my $filehandle = FileHandle->new("< ". $file)) {
	    local $get_a_line = sub { return <$filehandle> };
	    while ($_ = &$get_a_line) {
		&parse($_);
	    }
	    $filehandle->close;
	} else {
	    warn "cannot open file $file: $!\n";
	}
    } else {
	warn "file $file doesn not exist.\n";
    }
}

sub usage () {
    die <<"EOM"
scanpdf -- scan images and convert them to PDF format.
Copyright (C) 2000 Sebastian Marius Kirsch <skirsch\@moebius.inka.de>,
all rights reserved.

$0 [options] [<output file>]

options:
    -h                  this help text
    --copying           display copyright information

example:
    $0 test.pdf
EOM
}

sub copying () {
    die <<"EOM";
scanpdf -- scan images and convert them to PDF format.
Copyright (C) 2000 Sebastian Marius Kirsch <skirsch\@moebius.inka.de>,
all rights reserved.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
EOM
}

__END__

=head1 NAME

scanpdf -- scan images and convert them to PDF format.

=head1 SYNOPSIS

B<scanpdf> [B<output file>]

B<scanpdf> [B<-h|--help>]

B<scanpdf> [B<-c|--copying>]

B<scanpdf> [B<-V|--version>]

=head1 DESCRIPTION

B<THIS IS ALPHA SOFTWARE. AS OF THIS WRITING, THIS MEANS THAT EVEN I
HAVE NOT TESTED THE FULL FUNCTIONALITY YET.>

B<scanpdf> will scan images from (eg.) your flatbed scanner and convert
them to PDF format.

It has a command-line interface, the ability to process configuration
files and to write macros.

It uses scanimage to scan the actual images, the netpbm suite to convert
between the output format of scanimage and the graphics formats that can
be embedded in the PDF format, and Thomas Merz' PDFlib to produce the
PDF file.

=head1 OPTIONS

=over 4

=item B<-c, --copying>

Display legal information

=item B<-h, --help>

Display a help text.

=item B<-V, --version>

Display version information.

=back

=head1 COMMANDS

=over 4

=item B<delete> <number>

Delete the image <number>. 

Note that you can delete any image, and you
can display any image, but when you scan a new image, this will
always become the last image. You also can't shuffle the
images. (Yet. This is mostly due to the fact that I have not yet
found a pleasing syntax for this operation yet.)

=item B<display> <number>

Display image <number>. This uses C<display> from ImageMagick. 

=item B<help>

Display a help screen that will list all commands (including macros.)

=item B<images>

List the images scanned so far.

=item B<macro> <name>

Define a new macro. The prompt will change to "macro <name>>". You can
use any command in a macro that you can also use on the command
line. End the macro definition by typing "end".

=item B<scan>

Scan a new image, according to the current settings.

=item B<set> <parameter> <setting>

Set <parameter> to <setting>. If <setting> is not given, the current
value of <parameter> will be displayed. 

B<scanpdf> recognized the following units: mm (millimeters, the
default), cm (centimeters), in (inch) and pt (points). All values
will be converted to millimeters.

=item B<show> [<parameter>]

Show the current value of <parameter>, or, if not given, of all
parameters.

=item B<source> <file>

Read the given file, interpreting its contents as if they were given on
the command line.

=item B<quit>

Write the PDF file and exit.

=item B<write>

Write the PDF file.

=back

=head1 PARAMETERS

=over 4

=item B<device>

The scan device (default: C<umax:/dev/scanner>)

=item B<height>

The height of the scan area (default: 297mm)

=item B<imgtype>

The image type. As of this writing, PDFlib supports JPEG, PNG, TIFF and
GIF images. (default: PNG)

=item B<left>

The displacement of the scan area to the left. (default: 0)

=item B<mode>

The scan mode. Use "l" for lineart, "g" for greyscale and "c" for
color. (default: c)

=item B<output>

The name of the output file. No default; taken from command line if supplied. 

=item B<paperheight>

The height of the page. If set to 0, the height of the image will also
be the page height. If the image is higher than the paper, the image
will be rescaled to fit the paper. (default: 0)

=item B<papersize>

The paper size. Currently, scanpdf knows the following paper sizes: ISO
A, B, and C paper (a0-a10, b0-b10, c0-c10), ISO A, B and C paper in
landscape orientation (a0l-a10l, b0l-b10l, c0l-c10l), and American
letter paper (letter). (default: unset)

=item B<paperwidth>

The width of the page. If set to 0, the width of the image will also be
the page width. If the image is wider than the paper, the image will be
rescaled to fit the paper. (default: 0)

=item B<resolution>

The resolution. (default: 300)

=item B<top>

The displacement of the scan area to bottom. (default: 0)

=item B<width>

The width of the scan area (default: 210mm)

=back

=head1 EXAMPLES

=over 4

=item 

=back

=head1 LEGAL STUFF

This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2 of the License, or (at your
option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
675 Mass Ave, Cambridge, MA 02139, USA.

=head1 NOTES

=head1 FILES

=over 4

=item F</etc/scanpdfrc>

The system-wide configuration file.

=item F<~/.scanpdfrc>

The user configuration file.

=back

=head1 SEE ALSO

L<scanimage(1)>, L<display(1)>, L<cjpeg(1)>, L<pnmtopng(1)>,
L<ppmtogif(1)>, L<pnmtotiff(1)>

=head1 BUGS

Bugs? You're talking about I<bugs>? 

=head1 AUTHOR

Sebastian Marius Kirsch E<lt>skirsch@moebius.inka.deE<gt>