#!/usr/local/bin/perl

# Perl/Tk version of pretty
# Julius C. Duque
# v1.1.1 2003 November 12 Wednesday
# v1.2.0 2003 November 14 Friday - Added hyphenation
# v1.3.0 2003 November 16 Sunday - Added hyphenation of overfull lines

use diagnostics;
use strict;
use warnings;
use Tk;
use Tk::Balloon;
use TeX::Hyphen;

my $INDENT_DEF = 0;
my $LWIDTH_DEF = 70;
my $VERSION = "1.3.0";
my $TITLE = "Paragraph Adjuster $VERSION";
my $AUTHOR = "Julius C. Duque";
my $indent = $INDENT_DEF;
my $newline = 1;
my $hyphenate = 1;
my $width = $LWIDTH_DEF;
my ($BOTH, $LEFT, $RIGHT, $CENTERED) = (1, 2, 3, 4);
my $format_choice = $BOTH;   # both left- and right-justified
my ($infile, $outfile) = ();

my $hyp = new TeX::Hyphen;

local $/ = "";    # paragraph mode

my $mw = new MainWindow();
drawButtons();
Tk::MainLoop();

sub processfile
{
  my $retval = 0;

  open INFILE, $infile;
  if (open OUTFILE, "> $outfile") {
    while (<INFILE>) {
      my @linein = split;
      $retval = printpar(@linein);
      last if ($retval);
      print OUTFILE "\n" if ($newline);
    }

    close INFILE;
    close OUTFILE;
  }

  printMessage("info", "OK", "File was successfully saved.")
    if (!$retval);
}

sub printpar
{
  my (@par) = @_;
  my $firstline = 0;

  while (@par) {
    $firstline++;
    my ($buffer, $word);
    my ($charcount, $wordlen) = (0, 0);
    my $linewidth = $width;

    if ($firstline == 1) {
      $linewidth -= $indent;
      print OUTFILE " " x $indent;
    }

    while (($charcount < $linewidth) and (@par)) {
      $word = shift @par;
      $buffer .= $word;
      $wordlen = length($word);
      $charcount += $wordlen;
      $buffer .= " ";
      $charcount++;
    }

    chop $buffer;
    $charcount--;

    if ($charcount == $wordlen) {
      $linewidth = $wordlen;
      my ($pos, $pre_word_len) = (0, 0);
      if ($hyphenate) {
        if ($word =~ /^([^a-zA-Z]*)([a-zA-Z-']+)([^a-zA-Z]*)$/) {
          my $pre_word = $1;
          $pre_word_len = length($pre_word);
          my $stripped_word = $2;
          $pos = hyphenate_word($stripped_word, $width);
          $pos = 0 if ($wordlen <= $width);
        }

        if ($pos) {
          $charcount = $pre_word_len + $pos;
          my $post_word = substr $word, $charcount;
          unshift(@par, $post_word);
          $buffer = substr $word, 0, $charcount;
          $buffer .= "-";
          $charcount++;
        }
      }
    }

    my $lineout = $buffer;

    if ($charcount > $linewidth) {
      my ($pos, $pre_word_len) = (0, 0);
      if ($hyphenate) {
        if ($word =~ /^([^a-zA-Z]*)([a-zA-Z-']+)([^a-zA-Z]*)$/) {
          my $pre_word = $1;
          $pre_word_len = length($pre_word);
          my $stripped_word = $2;
          my $unfilled = $linewidth - $charcount + $wordlen
            - $pre_word_len + 1;

          $pos = hyphenate_word($stripped_word, $unfilled);
        }
      }

      $charcount -= $wordlen;

      if ($pos == 0) {
        $charcount--;
        unshift(@par, $word);
      } else {
        my $post_word = substr $word, ($pre_word_len + $pos);
        unshift(@par, $post_word);
        $charcount = $charcount + $pre_word_len + $pos;
      }

      $lineout = substr $buffer, 0, $charcount;

      if ($pos) {
        $lineout .= "-";
        $charcount++;
      }
    }

    my $spaces_to_fill = $linewidth - $charcount;

    if ($format_choice == $CENTERED) {
      my $leftfill = int($spaces_to_fill/2);
      print OUTFILE " " x $leftfill;
    } elsif ($format_choice == $RIGHT) {
      print OUTFILE " " x $spaces_to_fill;
    } elsif ($format_choice == $BOTH) {
      my $tempbuf = $lineout;
      my $replacements_made = 0;

      if (@par) {
        my $reps = 1;

        while (length($tempbuf) < $linewidth) {
          last if ($tempbuf !~ /\s/);
          if ($tempbuf =~ /(\S+ {$reps})(\S+)/) {
            $tempbuf =~ s/(\S+ {$reps})(\S+)/$1 $2/;
            $replacements_made++;
            $tempbuf = reverse $tempbuf;
          } else {
            $reps++;
          }
        }
      }

      if ($replacements_made % 2 == 0) {
        $lineout = $tempbuf;
      } else {
        $lineout = reverse $tempbuf;
      }
    }

    print OUTFILE "$lineout\n";
  }
}

sub hyphenate_word
{
  my ($tword, $unfilled) = @_;
  my @hyphen_places = $hyp->hyphenate($tword);

  if (@hyphen_places) {
    @hyphen_places = reverse @hyphen_places;

    foreach my $places (@hyphen_places) {
      return $places if ($places < $unfilled - 1);
    }
  }

  return 0;
}

sub drawButtons
{
  $mw->title($TITLE);

  # Status bar widget
  my $status = $mw->Label(-width => 70, -relief => "sunken",
    -anchor => "w")->pack(-side => "bottom", -padx => 1, -pady => 1,
    -fill => "x");

  # Create balloon widget
  my $b = $mw->Balloon(-statusbar => $status);

  # Create menu bar frame
  my $menubar = $mw->Frame(-borderwidth => 4, -relief => "ridge")->
    pack(-side => "top", -fill => "x"); 

  # Create Open File button
  my $openfilebutton = $menubar->
    Button(-text => "Open File", -relief => "raised", -width => 10,
      -command => [\&fileDialog, $mw, "open"])->pack(-side => "left");

  $b->attach($openfilebutton, -msg => "Open a file to be reformatted");

  # Create Save File button
  my $savefilebutton = $menubar->
    Button(-text => "Save To File", -relief => "raised", -width => 10,
      -command => sub {
          if (defined $infile and $infile ne "") {
            fileDialog($mw, "save");
          } else {
              printMessage("warning", "OK",
                "You must open a file to reformat first.");
          }
        })->pack(-side => "left");

  $b->attach($savefilebutton,
    -msg => "Proceed with reformatting and save result to a file");

  # Create About button
  my $aboutbutton = $menubar->Button(-text => "About",
    -relief => "raised", -width => 10,
    -command => [\&printMessage, "info", "OK",
      "A Perl/Tk script created by $AUTHOR"])->pack(-side => "left");

  $b->attach($aboutbutton,
    -msg => "$TITLE created by $AUTHOR");

  # Create Quit button
  my $quitbutton = $menubar->Button(-text => "Dismiss",
    -relief => "raised", -width => 10, -command => sub { exit })->
    pack(-side => "right");

  $b->attach($quitbutton, -msg => "Quit this Perl/Tk script");

  my $both = $mw->Radiobutton(-variable => \$format_choice,
    -value => $BOTH, -text => "Both left- and right-justified")->
    pack(-side => "top", -anchor => "w");

  $b->attach($both, -msg => "Each line is left- and right-justified");

  my $left = $mw->Radiobutton(-variable => \$format_choice,
    -value => $LEFT, -text => "Left-justified")->pack(-side => "top",
    -anchor => "w");

  $b->attach($left, -msg => "Each line is left-justified, ragged-right");

  my $right = $mw->Radiobutton(-variable => \$format_choice,
    -value => $RIGHT, -text => "Right-justified")->pack(-side => "top",
    -anchor => "w");

  $b->attach($right, -msg => "Each line is right-justified, ragged-left");

  my $centered = $mw->Radiobutton(-variable => \$format_choice,
    -value => $CENTERED, -text => "Centered")->pack(-side => "top",
    -anchor => "w");

  $b->attach($centered, -msg =>
    "Each line is equidistant from the left and right margins");

  $both->select;   # Set default to $both

  my $chknewline = $mw->Checkbutton(-variable => \$newline,
    -text => "Insert empty lines between paragraphs")->
    pack(-side => "top", -anchor => "w");

  $b->attach($chknewline,
    -msg => "Insert a blank line between two consecutive paragraphs");

  $chknewline->select;   # Set default to $newline

  my $chkhyphen = $mw->Checkbutton(-variable => \$hyphenate,
    -text => "Hyphenate")->
    pack(-side => "top", -anchor => "w");

  $b->attach($chkhyphen,
    -msg => "Hyphenate word that does not fit on a line");

  $chknewline->select;   # Set default to $hyphenate

  my $f = $mw->Frame->pack(-side => "left");

  my $l = $f->Label(-text => "Indention: ", -justify => "left");

  $b->attach($l,
    -msg => "Number of spaces at the start of every paragraph");

  Tk::grid($l, -row => 0, -column => 0);

  my $tindent = $f->Entry(-width => 2, -textvariable => \$indent,
    -justify => "right");

  $b->attach($tindent,
    -msg => "Number of spaces at the start of every paragraph");

  Tk::grid($tindent, -row => 0, -column => 1);

  $l = $f->Label(-text => "characters (default: $INDENT_DEF) ",
    -justify => "left");

  $b->attach($l,
    -msg => "Number of spaces at the beginning of each paragraph");

  Tk::grid($l, -row => 0, -column => 2);

  $l = $f->Label(-text => "Line width: ", -justify => "left");
  Tk::grid($l, -row => 1, -column => 0);
  $b->attach($l, -msg => "Maximum length of every line");

  my $tlwidth = $f->Entry(-width => 2, -textvariable => \$width,
    -justify => "right");

  $b->attach($tlwidth, -msg => "Maximum length of every line");
  Tk::grid($tlwidth, -row => 1, -column => 1);

  $l = $f->Label(-text => "characters (default: $LWIDTH_DEF)",
    -justify => "left");

  $b->attach($l, -msg => "Maximum length of every line");
  Tk::grid($l, -row => 1, -column => 2);
}

sub printMessage
{
  my ($icon, $type, $outputmsg) = @_;
  my $msg = $mw->messageBox(-icon => $icon, -type => $type,
  -title => $TITLE, -message => $outputmsg);
}

sub fileDialog {
  my ($w, $operation) = @_;
  my @types = (["Text files", [qw/.txt .doc/]],
    ["Text files", "", "TEXT"],
    ["All files", "*"]
  );

  if ($operation eq "open") {
    $infile = $w->getOpenFile(-filetypes => \@types);
  }

  if ($operation eq "save") {
      $outfile = $w->getSaveFile(-filetypes => \@types,
        -initialfile => "Untitled",
        -defaultextension => ".txt");

    processfile() if (defined $outfile and $outfile ne "");
  }
}

=head1 NAME

paradj-tk - a small Perl script that reformats lines of ASCII text so that
the resulting lines are  justified in any of the following formats:
left-justified, right-justified, centered, or both left- and
right-justified (default).

=head1 README

Paragraph Adjuster with Hyphenation (PAwH) is a small Perl script that
reformats lines of ASCII text so that the resulting lines are justified
in  any  of  the following  formats:  left-justified, right-justified,
centered, or both left- and right-justified (default). PAwH has
various  switches, most are optional, to control its output. The  only
mandatory switch is the line width. For PAwH to work properly, input
paragraphs must be separated by blank lines.

PAwH is also capable of hyphenating a word that cannot be accommodated
on a line.

=head1 DESCRIPTION

Paragraph Adjuster with Hyphenation (PAwH) is a small Perl script that
reformats lines of ASCII text so that the resulting lines are justified
in  any  of  the following  formats:  left-justified, right-justified,
centered, or both left- and right-justified (default). PAwH has
various  switches, most are optional, to control its output. The  only
mandatory switch is the line width. For PAwH to work properly, input
paragraphs must be separated by blank lines.

PAwH is also capable of hyphenating a word that cannot be accommodated
on a line.

=head1 COMMAND-LINE VERSION

This is a Perl/Tk version of the command-line paradj.pl.

=head1 PREREQUISITE

You  need Jan Pazdziora's Perl module, TeX::Hyphen, available from the
Comprehensive Perl Archive Network (CPAN), to use the hyphenation
feature. The latest is version 0.140.

For  Windows  users,  you can install TeX::Hyphen by  following  these
steps:

1. Uncompress the TeX::Hyphen module, TeX-Hyphen-0.140.tar.gz.

2.  Descend (cd) into the TeX-Hyphen-0.140/lib and copy the TeX directory
into <Perl directory>\lib. For example, if your Perl binaries are
installed on E:\Perl, copy the TeX directory into E:\Perl\lib.

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2003 Julius C. Duque <{jcduque}{at}{lycos}{dot}{com}>

This  library is free software; you can redistribute it and/or  modify
it under the same terms as the GNU General Public License.

=pod SCRIPT CATEGORIES

CPAN/Administrative
Fun/Educational

=cut