The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

use File::Path;
use Gimp;
use Gimp::Fu;
use Gimp::Util;
use strict;
use warnings;

#$Gimp::verbose = 1;

sub get_guides {
  my $image = shift;
  my %orientation2guidepos2guide;
  for (my $i = 0; $i = $image->find_next_guide($i); ) {
    $orientation2guidepos2guide{
      $image->get_guide_orientation($i)
    }->{
      sprintf "%5d", $image->get_guide_position($i)
    } = $i;
  }
  \%orientation2guidepos2guide;
}

# Generates an ordered list of all existing (x) guides.
sub get_orientguides {
  my ($orientation2guidepos2guide, $orient) = @_;
  my $gp2g = $orientation2guidepos2guide->{$orient};
  map { $gp2g->{$_} } sort keys %$gp2g;
}

# Duplicate, crop and save the image fragment.
sub dosel {
  my ($image, $savepath, $imgpath, $imgbasename, $extension, $l,$r,$t,$b, $i,$j) = @_;
#    $filename =~ m/^(.*)\.[^\.]*$/ ;
  my $imgname = "$imgbasename-$i-$j.$extension";
  my $tmpimage = $image->duplicate;
  # print "Cropping from $l to $r, $t to $b\n";
  $tmpimage->crop($r-$l, $b-$t, $l, $t);
  # Make sure that gif and jpg are of proper type before proceeding.
  # I could move this outside the dosel for performance improvement,
  # but then it would end up changing the user's image, which may
  # not be desired/expected.
  $tmpimage->image_convert_indexed(0,0,255,0,0,"NULL")
    if $extension eq "gif" and !($tmpimage->get_layers)[0]->is_indexed;
  $tmpimage->image_convert_rgb
    if $extension eq "jpg" and !($tmpimage->get_layers)[0]->is_rgb;
  $tmpimage->Gimp::Fu::save_image("$savepath$imgpath$imgname","$savepath$imgpath$imgname");
  $tmpimage->delete;
  return "$imgpath$imgname"; # what I want printed in html
}

# HTML Table Generation Functions
sub html_table_start {
  my ($fn,$cellpadding,$cellspacing,$border,$capitalize_tags) = @_;
  my $str = $capitalize_tags ?
"<TABLE CELLSPACING=$cellspacing CELLPADDING=$cellpadding BORDER=$border>\n" :
"<table cellspacing=$cellspacing cellpadding=$cellpadding border=$border>\n" ;
  print $fn $str;
}

sub html_table_row_start {
  my ($fn, $capitalize_tags) = @_;
  my $str = $capitalize_tags ? "\t<TR>\n" : "\t<tr>\n";
  print $fn $str;
}

sub html_table_entry {
  my ($fn, $imgname, $width, $height, $capitalize_tags) = @_;
  my $str = $capitalize_tags ?
"\t\t<TD><IMG ALT=\" \" SRC=\"$imgname\" WIDTH=\"$width\" HEIGHT=\"$height\"></TD>\n" :
"\t\t<td><img alt=\" \" src=\"$imgname\" width=\"$width\" height=\"$height\"></td>\n";
  print $fn $str;
}

sub html_table_row_end {
  my ($fn, $capitalize_tags) = @_;
  my $str = $capitalize_tags ? "\t</TR>\n" : "\t</tr>\n";
  print $fn $str;
}

sub html_table_end {
  my ($fn, $capitalize_tags) = @_;
  my $str = $capitalize_tags ? "</TABLE>\n":"</table>\n";
  print $fn $str;
}

podregister {
  my $o2gp2g = get_guides($image);
  my @vert = get_orientguides($o2gp2g, &Gimp::ORIENTATION_VERTICAL);
  my @horz = get_orientguides($o2gp2g, &Gimp::ORIENTATION_HORIZONTAL);
  die __"Abort: no horizontal or vertical guides found.\n" unless @vert + @horz;
  Gimp->progress_init("Perl-o-Tine");
  my $progress_increment = 1/( (scalar(@horz)+1) * (scalar(@vert)+1) );
  my $progress = 0.0;
  # (Debugging info for the guide functions)
  # print @vert, " LEN = ", scalar(@vert), "\n";
  # print @horz, " LEN = ", scalar(@horz), "\n";
  # foreach $guide (@vert) {
  #   print $image->get_guide_position($guide), "\n";
  # }
  # Correctly format paths and filenames
  map { $_ .= "/" unless m/\/$/; } ($savepath, $imgpath);
  $imgpath = "" unless $separate;
  mkpath($savepath . $imgpath);
  open FILE, ">$savepath$htmlname" or die "Couldn't open $savepath$htmlname: $!\n";
  my $top=0;
  html_table_start(\*FILE,0,$cellspacing,0,$capitalize_tags);
  for (my $i=0; $i<=scalar(@horz); $i++) {
    my $bot = ($i>$#horz) ? $image->height : $image->get_guide_position($horz[$i]);
    html_table_row_start(\*FILE, $capitalize_tags);
    my $left=0;
    for (my $j=0; $j<=scalar(@vert); $j++) {
      my $right = ($j>$#vert) ? $image->width : $image->get_guide_position($vert[$j]);
      # protect against 0 width/height guide selections
      if ($left!=$right && $top!=$bot) {
        # perform cropping, table entry
        my $imgname = dosel($image, $savepath, $imgpath, $imgbasename, $extension, $left, $right, $top, $bot, $i, $j);
        html_table_entry(\*FILE, $imgname, $right-$left, $bot-$top, $capitalize_tags);
      }
      $left = $right + $cellspacing;
      $progress += $progress_increment;
      Gimp->progress_update ($progress);
    }
    html_table_row_end(\*FILE, $capitalize_tags);
    $top = $bot + $cellspacing;
  }
  html_table_end(\*FILE, $capitalize_tags);
  return;
};
exit main;
__END__

=head1 NAME

perlotine - Guillotine implemented in perl, with html output

=head1 SYNOPSIS

<Image>/Filters/Web/Perl-o-tine...

=head1 DESCRIPTION

Add guides to an image.  Then run this.  It will cut along the guides,
and give you the html to reassemble the resulting images.

=head1 PARAMETERS

  [PF_FILE, "savepath", "The path to export the HTML to",$ENV{HOME}],
  [PF_STRING, "htmlname", "Filename to export","perlotine.html"],
  [PF_STRING, "imgbasename", "What to call the images","perlotine"],
  [PF_RADIO,  "extension", "The format of the images: (gif, jpg, png)", "gif", [gif => "gif", jpg => "jpg", png => "png"]],
  [PF_TOGGLE, "separate", "Use a separate directory for images",0],
  [PF_STRING, "imgpath", "The path to export the images to, relative to the Save Path", "images/"],
  [PF_TOGGLE, "capitalize_tags", "Capitalize HTML tags", 0],
  [PF_SPINNER, "cellspacing", "Add space between the table elements", 0, [0,15,1]],

=head1 IMAGE TYPES

*

=head1 HISTORY

  <sjburges@gimp.org>
  This is tigert's request.  I suppose it'll be useful to those that do
  this sort of thing.  Personally I'll probably only run it to test and
  put up a demo image.

  Since updated a couple times by others, and intgrated by me:

  Bruce Miller                              (fixed to accomdate 1.1.x changes)
  Brendon and Wendy Humphrey <brendy@swipnet.se> (progress bar, nice comments)

  Tuomas Kuosmanen <tigert@gimp.org>
  Fixed some things to make this work with cvs gimp. Fixed calls to
  gimp_get_guide_orientation() (guide types that changed from
  GUIDE_VERTICAL to VERTICAL and horizontal, respectively.  Should
  work now). Also convert to indexed parameters changed, fixed them too.

  <sjburges@gimp.org>
  Added changes to make progess bar work for images with only horizontal
  or vertical guides.  This was fixed at one time, I forget who did that.
  Somehow it got broke again ;(

  Added File::Path; for making the directory if it doesn't already exist.

  12/13/03: fixed tigert's fix to use ORIENTATION_VERTICAL rather
	    than VERTICAL

  If you have more additions, etc please don't hesitate to send them in!

=head1 AUTHOR

Seth Burgess <sjburges@gimp.org>

=head1 DATE

1999-03-19

=head1 LICENSE

Distributed under the same terms as Gimp-Perl.