#!/usr/bin/perl -w

#  This entire file copyright (c) 2002 T. Alex Beamish. All rights
#  reserved.  This program is free software; you can redistribute it
#  and/or modify it under the same terms as Perl itself.


#  Document object. Coded February 6-7, 2002. This first version has
#  everything in one object. Future versions will pass data down to lower
#  levels as required, going from Document to Page to Column, as the
#  object model matures.
#
#  T. Alex Beamish, TAB Software -- 7 February 2002

package Document;

#  Code to execute roff commands are stored in a code reference hash
#  as anonymous subroutines.

my %LocalCommands =
(
  br => sub 		#  Break the current line
  { 
    my $Self = shift;

    _FlushLine ( $Self );
  },

  bl => sub 		#  Insert [n|1] blank lines
  { 
    my $Self = shift; 
    my $Args = shift;

    if ( $Args eq "" ) { $Args = 1; }
    if ( $Self->{ LINE_AOHR }->[ -1 ]->{ data } eq "" )
    {
      $Args -= 1;
    }
    
    _FinishLine ( $Self );

    for ( 1..$Args )
    {
      _StartLine (  $Self );
      _FinishLine ( $Self );
    }

    _StartLine (  $Self );
  },

  ce => sub 		#  Center the next [n|1] input lines
  { 
    my $Self = shift; 
    my $Args = shift;
    if ( $Args eq "" ) { $Args = 1; }

    $Self->{ CENTER_COUNT } += $Args;
    $Self->{ RIGHT_COUNT }   = 0;
  },
    
  fi => sub 		#  Enable filling between input lines
  { 
    my $Self = shift;

    $Self->{ FILL_FLAG } = 1;
  },

  in => sub 		#  Indent by [n|0] spaces
  { 
    my $Self = shift; 
    my $Args = shift;
    if ( $Args eq "" ) { $Args = 0; }

    _FlushLine ( $Self );
    $Self->{ INDENT } = $Args;

    my $AvailableSpace =
      $Self->{ LINE_LENGTH } - $Self->{ INDENT };
    $Self->{ LINE_AOHR }->[ -1 ]->{ size } = $AvailableSpace;
  },

  ll => sub 		#  Set line length to [n|64]
  { 
    my $Self = shift; 
    my $Args = shift;
    if ( $Args eq "" ) { $Args = 64; }

    _FlushLine ( $Self );
    $Self->{ LINE_LENGTH } = $Args;

    my $AvailableSpace =
      $Self->{ LINE_LENGTH } - $Self->{ INDENT };
    $Self->{ LINE_AOHR }->[ -1 ]->{ size } = $AvailableSpace;
  },
    
  nf => sub 		#  Disable filling between input lines
  { 
    my $Self = shift;

    _FlushLine ( $Self );
    $Self->{ FILL_FLAG } = 0;
  },

  nj => sub 		#  Disable center and right justification
  { 
    my $Self = shift;

    $Self->{ CENTER_COUNT } = 0;
    $Self->{ RIGHT_COUNT }  = 0;
  },

  rj => sub 		#  Enable right justification for [n|1] lines
  { 
    my $Self = shift; 
    my $Args = shift;
    if ( $Args eq "" ) { $Args = 1; }

    $Self->{ RIGHT_COUNT } += $Args;
    $Self->{ CENTER_COUNT } = 0;
  },
    
);

#  INTERNAL METHODS

#  Object initialization routine

sub _Init
{
  my $Self = shift;

  $Self->{ LINE_LENGTH } = 72;
  $Self->{ INDENT } = 0;

  $Self->{ CENTER_COUNT } = 0;
  $Self->{ RIGHT_COUNT } = 0;

  $Self->{ FILL_FLAG } = 1;

  $Self->_StartLine();
}

#  Start a new line. This calculates the available space based on the
#  current indent and line length. Each line is stored as a hash
#  containing the text on the line, the justification and the available
#  space.

sub _StartLine
{
  my $Self = shift;
  my $Text = shift;
  if ( !defined ( $Text ) ) { $Text = ""; }

  my $AvailableSpace =
    $Self->{ LINE_LENGTH } - $Self->{ INDENT };
  my %Hash = ( data => $Text, just => "L", size => $AvailableSpace );

  push ( @{ $Self->{ LINE_AOHR } }, \%Hash );
}

#  Finish a line. This takes the indent and justification information and
#  pads with spaces to get the desired look.

sub _FinishLine
{
  my $Self = shift;

  my $ThisLineHR = $Self->{ LINE_AOHR }->[ -1 ];

  my $Indent = " " x $Self->{ INDENT };
  $ThisLineHR->{ data } = $Indent . $ThisLineHR->{ data };

  if ( $ThisLineHR->{ just } eq "C" )
  {
    my $Length = length ( $ThisLineHR->{ data } );
    my $Padding = " " x ( ( $ThisLineHR->{ size } - $Length ) / 2 );

    $ThisLineHR->{ data } = "$Indent$Padding$ThisLineHR->{ data }";
  } 
  elsif ( $ThisLineHR->{ just } eq "R" )
  {
    my $Length = length ( $ThisLineHR->{ data } );
    my $Padding = " " x ( $Self->{ LINE_LENGTH } - $Length );

    $ThisLineHR->{ data } = "$Padding$ThisLineHR->{ data }";
  }
}

#  Flush the current line by Finishing the current one and Starting a
#  new one. This routine does nothing if the line is empty.

sub _FlushLine
{
  my $Self = shift;
  my $Text = shift;

  if ( $Self->{ LINE_AOHR }[ -1 ]->{ data } ne "" )
  {
    if ( !defined ( $Text ) ) { $Text = ""; }

    _FinishLine ( $Self );
    _StartLine (  $Self, $Text );
  }
}

#  END OF INTERNAL METHODS

#  START EXTERNAL METHODS

#  Class constructor

sub new
{
  my $Class = shift;
  my $Self = {};

  bless ( $Self, $Class );
  $Self->_Init();

  return ( $Self );
}

#  Process a dot command. We go with the assumption that a command is
#  formed by a leading dot '.' followed by an alphanumeric command. Right
#  now all commands are two letters, but they could be an arbitrary
#  length. Arguments are optional and are made into "" if not defined;
#  each command handles that default value in their own way.

sub Cmd
{
  my $Self = shift;
  my $InputText = shift;
  chomp ( $InputText );

  my ( $Cmd, $Args ) = $InputText =~ m/^\.(\w+)\s*(.*)$/;
  if ( defined ( $LocalCommands{ $Cmd } ) )
  {
    if ( !defined ( $Args ) ) { $Args = ""; }
    $LocalCommands{ $Cmd }->( $Self, $Args );
  }
  else
  {
    warn "Roff: Command $Cmd has not yet been implemented.";
  }
}

#  Add a line of text to the output.

sub AddText
{
  my $Self      = shift;
  my $InputText = shift;
  chomp ( $InputText );

  #  If there are still input lines to be centered or right justified, mark 
  #  that for the current output line and decrement the counter for
  #  that justification count.

  if ( $Self->{ CENTER_COUNT } > 0 )
  {
    $Self->{ LINE_AOHR }[ -1 ]->{ just } = "C";
    $Self->{ CENTER_COUNT }--;
  }
  elsif ( $Self->{ RIGHT_COUNT } > 0 )
  {
    $Self->{ LINE_AOHR }[ -1 ]->{ just } = "R";
    $Self->{ RIGHT_COUNT }--;
  }

  #  Split the incoming text line into words. Check to see if the word
  #  fits on the line, add it if it does, otherwise start a new line with
  #  the word. This assumes that there are no words longer than the current
  #  line length.

  #  Commentary: It might be more efficient to figure out how space
  #  there is then grab that much of the input line (moving backwards to
  #  the first word boundary). I may add that in later versions.

  foreach ( split ( / /, $InputText ) )
  {
    my $ThisLineHR = $Self->{ LINE_AOHR }->[ -1 ];
    my $ThisLine   = $ThisLineHR->{ data};

    if ( length ( $_ ) + length ( $ThisLine ) >= $ThisLineHR->{ size } )
    {
      _FlushLine ( $Self, $_ );
    }
    else
    {
      if ( length ( $ThisLine ) == 0 )
      {
        $ThisLine = "$_";
      }
      else
      {
        $ThisLine .= " $_";
      }
      $Self->{ LINE_AOHR }->[ -1 ]->{ data } = $ThisLine;
    }
  }
  
  #  If we're doing the no-fill thing, flush the current line and get a new 
  #  line ready.

  if ( $Self->{ FILL_FLAG } == 0 )
  {
    _FlushLine ( $Self );
  }
}

#  This routine is called at the end of the input text file to close
#  off the roff procedure.

sub EndOfText
{
  my $Self = shift;
  _FinishLine ( $Self );
}

#  This routine is called to dump the result out to STDOUT.

sub Output
{
  my $Self = shift;

  my $LineCount = 0;
  foreach ( @{ $Self->{ LINE_AOHR } } )
  {
    printf ( "%3d: %s\n", $LineCount++, $_->{ data } );
  }
}

1;

#  Test bed for Document object.
#
#  T. Alex Beamish, TAB Software -- 6 February 2002

use strict;

package main;

use Document;

{
  my $TestDocument = new Document;
  
  while (<DATA>)
  {
    if ( /^\./ )
    {
      $TestDocument->Cmd ( $_ );
    }
    else
    {
      $TestDocument->AddText ( $_ );
    }
  }
  $TestDocument->EndOfText();
  $TestDocument->Output();
}

__END__

.ce 2
.nf
.ll 60
Test Page
OO PERL implementation of roff
.fi
.bl 
.rj
February 7, 2002
.nj
.bl
The idea is to write a fairly simple roff type text formatter in the Object
Oriented style, in not one but three languages, C, Perl and Java. This code
would be posted on my web site as the start to a code portfolio.
.bl
The commands currently implemented are:
.bl
.in 5
.nf
br - break the current line
bl [n|1] - insert n blank lines
ce [n|1] - center the next n lines
fi - fill output lines from input lines
in [n|0] - indent using n spaces
ll [n|64] - set line length to n
nf - don't fill output lines from input lines
nj - cancel right and center justification
rj [n|1] - right justify the next n lines
.fi
.bl
.in
Determining what Object model to use has been tough ..
right now I am planning to go with 
Document -> Page -> Column to simplify things
but I may decide later that I need a Paragraph/Table object
so that I can make unbreakable tables and provide widow/orphan control.
.bl
Comments are welcome! You can reach me at
talexb at tabsoft dot on dot ca.