
# BGP.pm
# Jan Pazdziora adelton@fi.muni.cz

# This file has Plain old documentation (POD) included. Use
# pod2text BGP.pm to extract it into plain text.

=head1 DESCRIPTION

Module BGP implements basic algorithms for dealing with TeX-like
box-glue-penalty model of typesetting.

The main parent class is BGP (stands for box-glue-penalty). It
provides generic methods that other classes may inherit if they do not
want to specify their own.

Next methods are HBox and VBox that allow horizontal and vertical
stacking of other objects and form objects of them. HGlue and VGlue
implement glues -- stretchable and shrinkable spaces. Class Space is
a shortname for a space in given font.

Penalty is the value to be addes to the badness function in case
breakpoint at the penalty is chosen.

Class Word packs letters of given font. It also uses information about
kerning pairs and ligatures.

List is a generic class for making a list (array) of objects.

Breakpoint, Breaking and Paragraph build open interface to typesetting
algorithms, namely optimum fit line breaking.

=cut

# #################################################
# BGP -- Box-glue-penaly -- parent of other classes
#
package BGP;
sub new
	{
	my $class = shift;
	my $self = { };
	bless $self, $class;
	}

$DEBUG = 0;
sub DEBUG
	{
	return $DEBUG unless defined $_[0];
	return ($_[0] <= $DEBUG ? 1 : 0);
	}

sub print	{ ref shift };

sub compute_max
	{
	my ($self, $function) = (shift, shift);
	my $value = undef;
	my $object;
	for $object (@{$self->{'items'}})
		{
		my $objvalue = $object->$function();
		if ((not defined $value) or ($objvalue > $value))
			{ $value = $objvalue; }
		}
	$value;
	}

@FUNCTION_TO_ZERO = qw( is_glue is_box is_penalty is_word penalty );
@FUNCTIONS_IN_HASH = qw( width height depth shrink stretch );
sub AUTOLOAD
	{
	my $self = shift;
	my $function = $AUTOLOAD;
	if (DEBUG)
		{
		print STDERR "Function $function in $self (BGP::AUTOLOAD)\n"
			unless $function =~ /::DESTROY$/;
		}
	$function =~ s/^.*:://;

	return 0 if grep { $_ eq $function} @FUNCTION_TO_ZERO;
	if (grep { $_ eq $function} @FUNCTIONS_IN_HASH)
		{
		print STDERR "Autoloaded $function for $self\n" if DEBUG;
		if (defined $self->{$function})
			{ return $self->{$function}; }
		return 0;
		}
	return '' if ($function eq 'text');
	return '' if ($function eq 'display' or $function eq 'pdisplay');
	return () if ($function eq 'hyphen');
	die "Function $function not found in $self (BGP::AUTOLOAD)";
	}

# ######################
# HBox -- horizontal box
#
package HBox;
@ISA = qw( BGP );
sub DEBUG { HBox->SUPER::DEBUG(); }
sub new
	{
	my ($class, @args) = @_;
	my $self = $class->SUPER::new;
	push @{$self->{'items'}}, @args;
	$self;
	}
sub width
	{
	my $self = shift;
	return $self->{'width'} if defined $self->{'width'};
	my $width = 0;
	my $object;
	for $object (@{$self->{'items'}})
		{ $width += $object->width(); }
	$self->{'width'} = $width;
	}
sub AUTOLOAD
	{
	my $self = shift;
	my $function = $AUTOLOAD;
	$function =~ s/^.*:://;
	print STDERR "Function $function in $self (HBox::AUTOLOAD)\n" if DEBUG;
	if ($function eq 'height' or $function eq 'depth')
		{ return $self->compute_max($function); }
	elsif ($function eq 'is_box')
		{ return 1; }
	else
		{
		$function = 'BGP::' . $function;
		print STDERR "Calling function $function in $self\n" if DEBUG;
		return $self->$function();
		}
	}
sub display
	{
	my $self = shift;
	my $object;
	for $object (@{$self->{'items'}})
		{ $object->display(@_); }
	}
sub pdisplay
	{
	my ($self, $out) = (shift, shift);
	my $object;
	$out->push();
	$self->display($out, @_);
	$out->pop();
	}

# #####################
# VBox -- vertical box
#
package VBox;
@ISA = qw(BGP);
sub new
	{
	my ($class, @args) = @_;
	my $self = SUPER::new $class;
	push @{$self->{'items'}}, @args;
	$self;
	}
sub width
	{
	my $self = shift;
	return $self->{'width'} if defined $self->{'width'};
	$self->{'width'} = $self->compute_max('width');
	}
sub height
	{
	my $self = shift;
	return $self->{'height'} if defined $self->{'height'};
	my $object;
	my $height = 0;
	for $object (@{$self->{'items'}})
		{
		$height += $object->height();
		$height += $object->depth();
		}
	$height -= $self->depth();
	$height;
	}
sub depth
	{
	my $self = shift;
	return $self->{'depth'} if defined $self->{'depth'};
	$self->{'depth'} = 0;
	my $last = $#{$self->{'items'}};
	$self->{'depth'} = $self->{'items'}[$last]->depth()
		if (@{$self->{'items'}});
	$self->{'depth'};
	}
sub is_box	{ 1; }
sub display
	{
	my ($self, $out) = (shift, shift);
	$self->pdisplay($out, @_);
	return unless @{$self->{'items'}};
	$out->hskip($#{$self->{'items'}}->width());
	}
sub pdisplay
	{
	my ($self, $out) = (shift, shift);
	return unless @{$self->{'items'}};
	$out->push();
	$out->vskip(- $self->height() + ${$self->{'items'}}[0]->height());
	my $index = 0;
	while ($index < $#{$self->{'items'}})
		{
		${$self->{'items'}}[$index]->pdisplay();
		last unless defined ${$self->{'items'}}[$index + 1];
		$out->vskip(${$self->{'items'}}[$index]->depth() +
			${$self->{'items'}}[$index + 1]->height());
		$index++;
		}
	$out->pop();
	}
# ####################################################
# HGlue -- horizontal stretchable and shrinkable space
#
package HGlue;
@ISA = qw(BGP);
sub new
	{
	my $other = shift;
	my $class = (ref $other) || $other;
	my $self = [ ];
	bless $self, $class;
	if (ref $other)
		{ push @$self, $other->data(); }
	else
		{ push @$self, (shift or 0), (shift or 0), (shift or 0); }
	$self;
	}
sub data
	{
	my $self = shift;
	return @{$self}[0 .. 2];
	}
sub AUTOLOAD
	{
	my $self = shift;
	my $function = $AUTOLOAD;
	$function =~ s/^.*:://;
	my %TO_INDEX = ( width => 0, stretch => 1, shrink => 2 );
	if (defined $TO_INDEX{$function})
		{ return $self->[$TO_INDEX{$function}]; }
	if ($function eq 'add' or $function eq 'sub')
		{
		my $newobject = $self->new($self);
		return $newobject if (ref $_[0] and ref $_[0] ne ref $self);
		my @otherdata;
		if (ref $_[0])	{ @otherdata = shift->data(); }
		else		{ @otherdata = @_; }
		@$newobject = map { $newobject->[$_] + ($otherdata[$_] or 0) }
			(0 .. 2) if $function eq 'add';
		@$newobject = map { $newobject->[$_] - ($otherdata[$_] or 0) }
			(0 .. 2) if $function eq 'sub';
		return $newobject;
		}
	if ($function eq 'objadd')
		{
		my $object = shift;
		return $self->add($object->width(), $object->stretch(), $object->shrink());
		}
	if ($function eq 'objsub')
		{
		my $object = shift;
		return $self->sub($object->width(), $object->stretch(), $object->shrink());
		}
	return 0 if ($function eq 'height' or $function eq 'depth');
	if ($function eq 'is_glue')
		{ return 1; }
	$function = 'BGP::' . $function;
	return $self->$function(@_);
	}
sub print
	{
	my $self = shift;
	sprintf "%.2f (+%.2f -%.2f)", map { $_ / 65535; } $self->data();
	}
sub display
	{
	my ($self, $out) = (shift, shift);
	my $r = shift;
	$r = 0 unless defined $r;
	my $skip = $self->width();
	$skip += $self->stretch() * $r if $r > 0;
	$skip += $self->shrink() * $r if $r < 0;
	$out->hskip($skip);
	}
sub pdisplay
	{
	}
# ##################################################
# VGlue -- vertical stretchable and shrinkable space
#
package VGlue;
@ISA = qw(HGlue);
sub new	{ shift->SUPER::new(@_); }
sub width	{ 0; }
sub AUTOLOAD
	{
	my $self = shift;
	my $function = $AUTOLOAD;
	$function =~ s/^.*:://;
	$function = 'width' if $function eq 'height';
	$function = 'HGlue::' . $function;
	return $self->$function(@_);
	}
sub display
	{
	my ($self, $out) = (shift, shift);
	my $r = shift;
	$r = 0 unless defined $r;
	my $skip = $self->height();
	$skip += $self->stretch() * $r if $r > 0;
	$skip += $self->shrink() * $r if $r < 0;
	$out->vskip($skip);
	}
# ########################
# Space -- interword space
#
package Space;
@ISA = qw(HGlue);
sub new
	{
	my ($class, $font) = @_;
	HGlue->SUPER::new($font->space(), $font->space_stretch(),
		$font->space_shrink());
	}
# ##################################
# Penalty -- to direct line-breaking
#
package Penalty;
@ISA = qw(BGP);
sub new
	{
	my $class = shift;
	my $self = SUPER::new $class;
	$self->{'penalty'} = shift or 0;
	$self;
	}
sub penalty
	{
	my $self = shift;
	$self->{'penalty'};
	}
sub print
	{
	my $self = shift;
	sprintf "%dp", $self->penalty();
	}
sub is_penalty	{ 1; }

# ######################################
# Word -- stores one word of active font
#
package Word;
@ISA = qw(BGP);
sub new
	{
	my $class = shift;
	my $self = SUPER::new $class;
	( @{$self}{'text', 'font'} ) = (shift, shift);
	$self;
	}
sub is_word	{ 1; }
sub text	{ shift->{'text'}; }
sub font	{ shift->{'font'}; }
sub print	{ shift->text(); }
sub AUTOLOAD
	{
	my $self = shift;
	my $function = $AUTOLOAD;
	$function =~ s/^.*:://;
	if (grep { $_ eq $function} qw( width height depth ))
		{
		return $self->{$function} if (defined $self->{$function});
		@{$self}{ qw( width height depth ) }
			= $self->{'font'}->word_dimensions($self->{'text'});
		return $self->{$function};
		}
	if ($function eq 'is_box')
		{ return 1; }
	$function = 'BGP::' . $function;
	return $self->$function(@_);
	}

use TeX::Hyphen;
my $hyp;
my $HYPHEN_FILE = "/packages/share/tex/lib/tex/latex2e/csbase/czhyphen.tex";
sub hyphen
	{
	my $self = shift;
	unless (defined $self->{'hyphens'})
		{
		$hyp = new TeX::Hyphen $HYPHEN_FILE unless defined $hyp;
		$self->{'hyphens'} = [ ];
		my $text = $self->{'text'};
		if ($text =~ /^\w/)
			{
			$text =~ s/\W.*$//s;
			push @{$self->{'hyphens'}}, $hyp->hyphenate($text);
			}
		}
	return @{$self->{'hyphens'}};
	}

sub display
	{
	my ($self, $out) = (shift, shift);
	$out->word($self->text());
	}
sub pdisplay
	{
	my ($self, $out) = (shift, shift);
	$out->push();
	$out->word($self->text());
	$out->pop();
	}
# #####################################
# List -- horizontal and vertical lists
#
package List;
@ISA = qw( BGP );

sub new
	{
	my $class = shift;
	my $self = [];
	bless $self, $class;
	}
sub push	{ my $self = shift; push @$self, @_; }
sub pop		{ my $self = shift; pop @$self; }
sub get
	{
	my ($self, $num) = (shift, shift);
	$self->[$num];
	}
sub last	{ my $self = shift; $#{$self}; }
sub items	{ my $self = shift; @$self; }
sub is_empty	{ my $self = shift; not scalar(@$self); }

# ##################################
# Breakpoint -- breakpoint of a list
#
package Breakpoint;
sub new
	{
	my $class = shift;
	my %param = @_;
	my $self = { %param };
	bless $self, $class;
	}
sub get
	{
	my ($self, $objnum) = @_;
	$objnum = $self->objnum() unless (defined $objnum);
	$self->par()->get($objnum) if (defined $objnum);
	}

my @BREAKPOINT_ITEMS = qw( prev objnum subnum par glue prev total demerits bp
	totalbp hyphen height depth );
sub AUTOLOAD
	{
	my $self = shift;
	my $function = $AUTOLOAD;
	$function =~ s/^.*:://;
	if (grep {$_ eq $function} @BREAKPOINT_ITEMS)
		{ return $self->{$function}; }
	die "Method $function not defined in $self";
	}
sub line	{ shift->{'line'}; }
sub starting_glue
	{
	my $self = shift;
	my $object;
	my $total = new HGlue;
	my $number = $self->objnum();
	return $total unless ($number);
	while (($object = $self->get($number)) and ($object->is_glue()))
		{
		$total = $total->objadd($object);
		$number++;
		}
	$total;
	}
sub start
	{
	my $self = shift;
	my $prev = $self->prev();
	my $number = 0;
	if (defined $prev) { $number = $prev->objnum(); }
	return $number unless ($number);
	while (($object = $self->get($number)) and ($object->is_glue()))
		{ $number++; }
	$number;	
	}
sub end
	{
	my $self = shift;
	return $self->objnum() if ref $self->get() eq 'Penalty';
	return $self->objnum() if $self->objnum() >= 0;
	0;
	}
sub print_ident
	{
	my $self = shift;
	my $out = $self->objnum();
	$out .= "[" . $self->hyphen() . "]" if defined $self->hyphen();
	$out;
	}
sub display
	{
	my $self = shift;
	my $out = shift;
	my $r = $self->{'r'};
	my $start = $self->start();
	my $end = $self->end();
	my $prev = $self->prev();
	if ($self->prev() and $self->prev()->hyphen())
		{
		if ($start == $end and $self->get($end)->is_word()
			and $self->hyphen())
			{
			new Word(substr($self->get($end)->text(),
				$self->prev()->hyphen(), $self->hyphen())
					. '-',
			$self->get($end)->font())->display($out);
			return;
			}
		new Word(substr($self->get($start)->text(),
			$self->prev()->hyphen()),
			$self->get($start)->font())->display($out);
		$start++;
		}
	while ($start < $end)
		{
		$self->get($start)->display($out, $r);
		$start++;
		}
	if ($self->get($end)->is_word() and $self->hyphen())
		{
		new Word(substr($self->get($end)->text(), 0, $self->hyphen())
			. '-', $self->get($end)->font())->display($out);
		}
	else
		{ $self->get($end)->display($out, $r); }
	}
sub is_glue	{ 0; }

# #####################################
# Breaking -- breaks hlist in paragraph
#
package Breaking;
$DEBUG = 1;
sub DEBUG
	{
	return $DEBUG unless defined $_[0];
	return ($_[0] <= $DEBUG ? 1 : 0);
	}
sub HYPHENPENALTY { 60; }
sub new
	{
	my $class = shift;
	my $self = {};
	bless $self, $class;
	my $par = shift;
	$self->{'par'} = $par;
	my %params = @_;
	@{$self}{ keys %params } = values %params;

	my $leftskip = $params{'leftskip'};
	my $rightskip = $params{'rightskip'};
	my $leftrightskip = $leftskip->add($rightskip);
	my @line_glues = ();

	my @done = ();
	my @active = ();

	print STDERR "Start breaking.\n";

	push @active, new Breakpoint('par' => $par, 'glue' => new HGlue,
		'objnum' => 0, 'total' => new HGlue,
		'bp' => 0, 'totalbp' => 0, 'line' => 0,
		'tempdepth' => undef, 'tempheight' => undef,
		'height' => 0, 'depth' => 0);

	my $objtotalglue = new HGlue;	# glue from start to the
					# beginning of current object
	my $totalglue = new HGlue;	# glue from start
					# | words go up to hyp|-
	my $breakglue = new HGlue;	# glue from start to break
					# | words go up to hyp-|

	my ($hyphen, $prevhyphen) = (undef, 0);
	my @hyphens = ();

	my $num_of_elements = scalar ($par->items());

	my $objnum = 0;
	my $object = $par->get(0);
	my $prevobject = undef;

	my ($tempheight, $tempdepth);

	while ($objnum < $num_of_elements)
		{
		if (DEBUG() and $object->is_glue())
			{ print STDERR ' '; }
		if (DEBUG() and $object->is_word())
			{
			my $endhyp = $hyphen;
			$endhyp = length $object->text() unless defined $endhyp;
			$endhyp -= $prevhyphen;
			print STDERR substr $object->text(), $prevhyphen, $endhyp;
			}
		unless (($object->is_penalty() and $object->penalty() < 1000)
			or ($object->is_glue() and ref $prevobject
				and $prevobject->is_box())
			or ($object->is_word() and defined $hyphen))
			{
			next;
			}
		my ($mintotalbp, $minbreak);
		my $textout = '';
		my %chosen = ();
		my $active;
		for $active (@active)
			{
			my $actobj = $active->get();
			my $upthere = $breakglue->sub($active->total())->sub($active->starting_glue());

			$active->{'tempheight'} = $tempheight if (not defined $active->{'tempheight'} or $tempheight > $active->{'tempheight'});
			$active->{'tempdepth'} = $tempdepth if (not defined $active->{'tempdepth'} or $tempdepth > $active->{'tempdepth'});

			my $myline = $active->line() + 1;

			if (not defined $line_glues[$myline])
				{ $line_glues[$myline] = $leftrightskip->sub(new HGlue $self->line_length($myline)); }

			my $diffglue = $upthere->add($line_glues[$myline]);
			# print STDERR "\ndiffglue: ", $diffglue->print(), "\n";
			my $diff = $diffglue->width();
			my $r = 100;
			if ($diffglue->stretch() and $diff < 0)
				{ $r = - $diff / $diffglue->stretch(); }
			elsif ($diffglue->shrink() and $diff >= 0)
				{ $r = - $diff / $diffglue->shrink(); }
			elsif ($diff > 0)
				{ next; }
			my $penalty = $object->penalty();
			my $bp = 100 * (abs($r) * $r * $r + $penalty);
			$bp += $params{'hyphenpenaltyvalue'} if defined $hyphen;
			my $totalbp = $bp + $active->totalbp();

			if ($r < -1 or $penalty <= -1000)
				{
				$textout .= sprintf "  %% remove %s: diff %.2f, r %.2f\n", $active->print_ident(), $diff / 65536, $r if DEBUG(20);
				while (1)
					{
					last if (scalar(@active) == 1);
					my $move = shift @active;
					push @done, $move;
					last if ($move == $active);
					}
				}
			if ($r >= -1 and $bp < 300 and (not defined $chosen{$myline} or $chosen{$myline}->totalbp() > $totalbp))
				{
				$chosen{$myline} = new Breakpoint('par' => $par,
					'objnum' => $objnum,
					'prev' => $active,
					'glue' => $upthere,
					'total' => $totalglue->new(),
					'r' => $r,
					'bp' => $bp,
					'totalbp' => $totalbp, 
					'line' => $myline,
					'height' => $active->{'tempheight'},
					'depth' => $active->{'tempdepth'},
					);
				$chosen{$myline}->{'hyphen'} = $hyphen if defined $hyphen;
				$textout .= sprintf "  -> %s: diff %s, r %.2f, totalbp %.2f, l $myline\n", $active->print_ident(), $diffglue->print(), $r, $totalbp if DEBUG();
				}
			}
		if (DEBUG() and $textout ne '')
			{
			my $id = $objnum;
			$id .= '[' . $hyphen . ']' if defined $hyphen;
			print STDERR '-' if defined $hyphen;
			printf STDERR "\n  %s: total %s\n%s", $id, $breakglue->print(), $textout;
			}
		if (keys %chosen)
			{
			push @active, @chosen{ sort keys %chosen };
			for ( sort keys %chosen )
				{
				print STDERR "  * push into active via ", $chosen{$_}->prev()->print_ident(), "\n" if DEBUG;
				}
			}
		($tempheight, $tempdepth) = (undef, undef);
		}
	continue
		{
		unless (@hyphens)
			{
			if (DEBUG() and defined $hyphen and $object->is_word())
				{ print STDERR substr $object->print(), $hyphen; }
			$totalglue = $objtotalglue = $breakglue
				= $objtotalglue->objadd($object);

			$tempheight = $object->height() if (not defined
				$tempheight or $object->height() > $tempheight);
			$tempdepth = $object->depth() if (not defined
				$tempdepth or $object->depth() > $tempdepth);
			
			$prevobject = $object;
			++$objnum;
			last unless $objnum < $num_of_elements;
			$object = $par->get($objnum);

			@hyphens = ();
			$hyphen = undef;
			$prevhyphen = 0;
			@hyphens = $object->hyphen();
			}
		if (@hyphens)
			{
			$prevhyphen = $hyphen if defined $hyphen;
			$hyphen = shift @hyphens;
			my $word = new Word(substr($object->text(), 0, $hyphen) . '-', $object->font());
			$breakglue = $objtotalglue->objadd($word);
			$totalglue = $objtotalglue->objadd($object)->objsub(new Word(substr($object->text(), $hyphen), $object->{'font'}));
			$tempheight = $word->height() if (not defined
				$tempheight or $word->height() > $tempheight);
			$tempdepth = $word->depth() if (not defined
				$tempdepth or $word->depth() > $tempdepth);
			}
		# print STDERR "tempheight: $tempheight, tempdepth: $tempdepth\n";
		}

	print STDERR "Done breaking.\n";
	push @done, @active;

	my ($object, $lastobjnum);
	$self->{'line_results'} = {};
	for $object (reverse @done)
		{
		$lastobjnum = $object->objnum() if not defined $lastobjnum;
		last if $object->objnum() != $lastobjnum;
		my $line = $object->line();
		$self->{'line_results'}{$line} = $object if not defined $self->{'line_results'}{$line};
		if ($object->totalbp() < $self->{'line_results'}{$line}->totalbp())
			{ $self->{'line_results'}{$line} = $object; }
		$self->{'bestbreak'} = $object if (not defined $self->{'bestbreak'} or $object->totalbp() < $self->{'bestbreak'}->totalbp());
		}
	if (defined $self->{'looseness'})
		{
		my $loos = $self->{'looseness'};
		my $bestline = $self->{'bestbreak'}->line();
		print STDERR "Looseness defined ($loos)\n";
		while ($loos)
			{
			if (defined $self->{'line_results'}{$bestline + $loos})
				{
				$self->{'bestbreak'} = $self->{'line_results'}{$bestline + $loos};
				last;
				}
			$loos = ( $loos > 0 ? $loos - 1 : $loos + 1 );
			}
		}
	push @{$self->{'done'}}, @done;
	return $self;
	}

sub line_length
	{
	my ($self, $num) = (shift, shift);
	return $self->{'hsize'} unless defined $self->{'lengths'};
	if ($num > scalar($#{$self->{'lengths'}}))
		{ $num =  $#{$self->{'lengths'}}; }
	return $self->{'lengths'}[$num];
	}
sub lines
	{
	my $self = shift;
	$self->{'bestbreak'}->line();
	}
sub gimme_breaks
	{
	my $self = shift;
	my $object = $self->{'bestbreak'};
	my @out = ();
	while ($object->prev())
		{
		push @out, $object;
		$object = $object->prev();
		}
	reverse @out;
	}

# #########################################
# Paragraph -- contains hlist and Breakings
#
package Paragraph;
sub new
	{
	my $class = shift;
	my $self = {};
	bless $self, $class;
	my $list = $self->{'list'} = new List;
	my $parindent = shift;
	$list->push( new HGlue $parindent ) if defined $parindent;
	$self;
	}
sub break
	{
	my $self = shift;
	my %params = InParse::default_settings();
	my %inparams = @_;
	for (keys %inparams)
		{ $params{$_} = $inparams{$_}; }
	my $id = join ';', map { "$_:$params{$_}"; } sort keys %params;
	if (not defined $self->{'done'}{$id})
		{ $self->{'done'}{$id} = new Breaking($self, %params); }
	else
		{ print STDERR "Breaking found in cache\n"; }
	return $self->{'done'}{$id};
	}
sub break_items
	{
	my $self = shift;
	my $breaking = $self->break(@_);
	return $breaking->gimme_breaks();
	}
sub AUTOLOAD
	{
	my $self = shift;
	my $function = $AUTOLOAD;
	$function =~ s/^.*:://;
	$self->{'list'}->$function(@_);
	}
sub is_glue { 0; }

# ############################
# InParse -- parsing the input
# ############################

package InParse;

use FileHandle;
use BGP;
use Font::TFM;

sub pt { $_[0] * 65536; }
sub in { $_[0] * 65536 * 72.27; }
sub cm { $_[0] * 65536 * 7227 / 254; }

$HSIZE = cm(9.8);
$VSIZE = cm(12.4);

$PARINDENTSKIP = cm(0.45);
$PARINDENT= new HGlue( $PARINDENTSKIP );
$PARFILLSKIP = new HGlue( 0, 10 * $HSIZE );
$LEFTSKIP = new HGlue( 0 );
$RIGHTSKIP = new HGlue( 0 );

$BASELINESKIP = new VGlue( pt(12.5) );
# $PARSKIP = new VGlue( 0 );
$TOPSKIP = new VGlue(pt(10));
# $MAXDEPTH = pt(4);

$BREAK = new Penalty(-1000);
$NOBREAK = new Penalty(1000);

$DEFAULTFONT = new Font::TFM "csr10";
# $HYPHENPENALTYVALUE = 60;
$HYPHENPENALTYVALUE = 0;

die "Error loading csr10" unless defined $DEFAULTFONT;

%DEFAULTS = ('hsize' => $HSIZE, 'vsize' => $VSIZE,
	'parindent' => $PARINDENT, 'parindentskip' => $PARINDENTSKIP,
	'baselineskip' => $BASELINESKIP,
	'looseness' => 0,
	'parfillskip' => $PARFILLSKIP, 'defaultfont' => $DEFAULTFONT,
	'nobreak' => $NOBREAK, 'break' => $BREAK,
	'leftskip' => $LEFTSKIP, 'rightskip' => $RIGHTSKIP,
	'hyphenpenaltyvalue' => $HYPHENPENALTYVALUE,
	'topskip' => $TOPSKIP);
sub default_settings	{ return %DEFAULTS; }
sub default_setting	{ return $DEFAULTS{$_[0]}; }

$LAST_OPEN = '';
$DEBUG = 0;
sub DEBUG	{ $LAST_OPEN->debug(); }
sub debug
	{
	my $self = shift;
	return $self->{'debug'} unless (@_);
	return ( $_[0] <= $self->{'debug'} ? 1 : 0 );
	}

sub new
	{
	my ($class, $file) = (shift, shift);
	my $self = {};
	bless $self, $class;
	$self->{'file'} = $file;
	$self->{'fh'} = new FileHandle $file;
	$self->{'debug'} = $DEBUG;
	my %defaults = default_settings();
	@$self{ keys %defaults } = values %defaults;
	$LAST_OPEN = $self;
	return $self if defined $self->{'fh'};
	}
sub get_vertical_token
	{
	my $self = shift;
	my $odd_eq = 1;
	local ($/) = "";
	local ($_);
	if ($self->{'input_line'})
		{ $_ = $self->{'input_line'}; }
	else
		{ $_ = $self->{'fh'}->getline(); }
	s/^\s+//g;
	return if (/^__END__/ or /^\\bye/);

	my $par = new Paragraph();
	$par->push( $self->parindent() );
	print STDERR '    ' if DEBUG;

	while ($_)
		{
		if (s/^~/ /) { $par->push( $self->nobreak() ); }
		elsif (s/^"//)
			{
			if ($odd_eq % 2)
				{
				$par->push( new Word ',', $self->defaultfont());
				$par->push( $self->nobreak() );
				$par->push( new HGlue(- $self->defaultfont()->space() / 5) );
				$par->push( new Word ',', $self->defaultfont());
				}
			else
				{
				$par->push( new Word '`', $self->defaultfont());
				$par->push( $self->nobreak() );
				$par->push( new HGlue(- $self->defaultfont()->space() / 5) );
				$par->push( new Word '`', $self->defaultfont());
				}
			$odd_eq++;
			}
		elsif (s/^\s+//)
			{
			$par->push(new Space $self->defaultfont());
			print STDERR ' ' if DEBUG;
			}
		elsif (s/^(\w+[^~"\s]*)//)
			{
			$par->push(new Word $+, $self->defaultfont());
			print STDERR $+ if DEBUG;
			}
		else
			{
			s/^([^~"\w\s]+)//;
			$par->push(new Word $+, $self->defaultfont());
			print STDERR $+ if DEBUG;
			}
		}
	print STDERR "\n" if DEBUG;

	while ($par->get($par->last())->is_glue())
		{ $par->pop(); }
	$par->push( $self->nobreak() );
	$par->push( $self->parfillskip() );
	$par->push( $self->break() );
	$self->{'input_line'} = $_;
	$par;
	}
sub read
	{
	my $self = shift;
	my $vlist = new List;
	my $in_token;
	while ($in_token = $self->get_vertical_token())
		{
		$vlist->push($in_token);
		print STDERR "Paragraph done.\n" if DEBUG;
		}
	$vlist;
	}
sub AUTOLOAD
	{
	my $self = shift;
	my $function =  $AUTOLOAD;
	$function =~ s/^.*:://;
	if (defined $self->{$function})
		{
		$self->{$function} = shift if defined $_[0];
		return $self->{$function};
		}
	die "Method $function not found in $self";
	}

1;

__END__

# This is the start of the testing program

#!/usr/bin/perl -w

use strict;
use BGP;
use TeX::DVI;

print STDERR "Start program.\n";

# Create parsing object
my $input = new InParse '-';

# Read all paragraphs into one long vertical list
my $vlist = $input->read();

# Exit if there is nothing to do.
exit if $vlist->is_empty();

# Create the output module
my $dvi = new TeX::DVI('btput.dvi');
$dvi->preamble();

my ($startparindex, $parindex) = (0, 0);
my ($startlineindex, $lineindex) = (0, 0);
my $numofitems = scalar($vlist->items());

my $looseness = 1;
while ($parindex < $numofitems)
	{
	my ($parindex, $lineindex) = ($startparindex, $startlineindex);

	# start testing new page
	my @page_list = ();

	# skip glues
	while ($parindex < $numofitems and $vlist->get($parindex)->is_glue())
		{ $parindex++; $lineindex = 0; }
	last unless $parindex < $numofitems;
	
	$dvi->begin_page();
	$dvi->font($dvi->font_def($InParse::DEFAULTFONT));

	my $vsizeglue = new VGlue(InParse::default_setting('vsize'))->sub(new VGlue(0, InParse::pt(10), InParse::pt(3)));

	my $total_page_glue = new VGlue( 0 );
	my ($min_bp, $min_break_par, $min_break_line);
	my $prevdepth = 0;
	my $prevglue = InParse::default_setting('topskip');

TEST_PAGE:
	while ($parindex < $numofitems)
		{
		#$looseness = 0;
		#$looseness = 1 if $parindex == 1;
		my @breaks = $vlist->get($parindex)->break_items('looseness' => $looseness);
		while (defined $breaks[$lineindex])
			{
			my $height = $breaks[$lineindex]->height();
			my $prevskip = new VGlue($prevglue->data())->sub(new VGlue($prevdepth)->add(new VGlue($height)));

			$total_page_glue = $total_page_glue->add($prevdepth);
			$total_page_glue = $total_page_glue->add($prevskip);
			$total_page_glue = $total_page_glue->add(new VGlue($height));

			my $diffglue = $total_page_glue->sub($vsizeglue);
			my $diff = $diffglue->height();
			my $r = 100;
			if ($diffglue->stretch() and $diff < 0)
				{ $r = - $diff / $diffglue->stretch(); }
			elsif ($diffglue->shrink() and $diff >= 0)
				{ $r = - $diff / $diffglue->shrink(); }
			my $penalty = 0;
			my $bp = 100 * (abs($r) * $r * $r + $penalty);

			print STDERR "total_page_glue: ", $total_page_glue->print(), "\n";
			printf STDERR "diffglue: %s, r: %.2f, bp: %.2f\n", $diffglue->print(), $r, $bp;
			if (not defined $min_bp or ($bp <= $min_bp and
				$r >= -1))
				{
				$min_bp = $bp;
				$min_break_par = $parindex;
				$min_break_line = $lineindex;
				printf STDERR "min_bp: %.2f, min_break_par: $min_break_par, min_break_line: $min_break_line\n", $min_bp;
				}
			if ($r < -1)
				{
				print STDERR "Overfull page, jumping back\n";
				last TEST_PAGE;
				}
				
			push (@page_list, $prevskip);
			push (@page_list, $breaks[$lineindex]);

			$prevglue = InParse::default_setting('baselineskip');
			$prevdepth = $breaks[$lineindex]->depth();
			$lineindex++;
			}
		$parindex++;
		$lineindex = 0;
		}
	my $item;
	for $item (@page_list)
		{
		if ($item->is_glue())
			{ $item->display($dvi); }
		else
			{
			$dvi->vskip($item->height());
			$dvi->push();
			$item->display($dvi);
			$dvi->pop();
			$dvi->vskip($item->depth());
			}
		}
	
	$dvi->end_page();

	$startparindex = $min_break_par;
	$startlineindex = $min_break_line + 1;
	{
	#$looseness = 0;
	#$looseness = 1 if $parindex == 1;
	if (not defined (($vlist->get($startparindex)->break_items('looseness' => $looseness))[$startlineindex]))
		{
		$startlineindex = 0;
		$startparindex++;
		}
	}
	}

$dvi->postamble();

print STDERR "Stop program.\n";

