http://www.perlmonks.org?node_id=143922

   1: #!/usr/bin/perl -w
   2: 
   3: #  This entire file copyright (c) 2002 T. Alex Beamish. All rights
   4: #  reserved.  This program is free software; you can redistribute it
   5: #  and/or modify it under the same terms as Perl itself.
   6: 
   7: 
   8: #  Document object. Coded February 6-7, 2002. This first version has
   9: #  everything in one object. Future versions will pass data down to lower
  10: #  levels as required, going from Document to Page to Column, as the
  11: #  object model matures.
  12: #
  13: #  T. Alex Beamish, TAB Software -- 7 February 2002
  14: 
  15: package Document;
  16: 
  17: #  Code to execute roff commands are stored in a code reference hash
  18: #  as anonymous subroutines.
  19: 
  20: my %LocalCommands =
  21: (
  22:   br => sub 		#  Break the current line
  23:   { 
  24:     my $Self = shift;
  25: 
  26:     _FlushLine ( $Self );
  27:   },
  28: 
  29:   bl => sub 		#  Insert [n|1] blank lines
  30:   { 
  31:     my $Self = shift; 
  32:     my $Args = shift;
  33: 
  34:     if ( $Args eq "" ) { $Args = 1; }
  35:     if ( $Self->{ LINE_AOHR }->[ -1 ]->{ data } eq "" )
  36:     {
  37:       $Args -= 1;
  38:     }
  39:     
  40:     _FinishLine ( $Self );
  41: 
  42:     for ( 1..$Args )
  43:     {
  44:       _StartLine (  $Self );
  45:       _FinishLine ( $Self );
  46:     }
  47: 
  48:     _StartLine (  $Self );
  49:   },
  50: 
  51:   ce => sub 		#  Center the next [n|1] input lines
  52:   { 
  53:     my $Self = shift; 
  54:     my $Args = shift;
  55:     if ( $Args eq "" ) { $Args = 1; }
  56: 
  57:     $Self->{ CENTER_COUNT } += $Args;
  58:     $Self->{ RIGHT_COUNT }   = 0;
  59:   },
  60:     
  61:   fi => sub 		#  Enable filling between input lines
  62:   { 
  63:     my $Self = shift;
  64: 
  65:     $Self->{ FILL_FLAG } = 1;
  66:   },
  67: 
  68:   in => sub 		#  Indent by [n|0] spaces
  69:   { 
  70:     my $Self = shift; 
  71:     my $Args = shift;
  72:     if ( $Args eq "" ) { $Args = 0; }
  73: 
  74:     _FlushLine ( $Self );
  75:     $Self->{ INDENT } = $Args;
  76: 
  77:     my $AvailableSpace =
  78:       $Self->{ LINE_LENGTH } - $Self->{ INDENT };
  79:     $Self->{ LINE_AOHR }->[ -1 ]->{ size } = $AvailableSpace;
  80:   },
  81: 
  82:   ll => sub 		#  Set line length to [n|64]
  83:   { 
  84:     my $Self = shift; 
  85:     my $Args = shift;
  86:     if ( $Args eq "" ) { $Args = 64; }
  87: 
  88:     _FlushLine ( $Self );
  89:     $Self->{ LINE_LENGTH } = $Args;
  90: 
  91:     my $AvailableSpace =
  92:       $Self->{ LINE_LENGTH } - $Self->{ INDENT };
  93:     $Self->{ LINE_AOHR }->[ -1 ]->{ size } = $AvailableSpace;
  94:   },
  95:     
  96:   nf => sub 		#  Disable filling between input lines
  97:   { 
  98:     my $Self = shift;
  99: 
 100:     _FlushLine ( $Self );
 101:     $Self->{ FILL_FLAG } = 0;
 102:   },
 103: 
 104:   nj => sub 		#  Disable center and right justification
 105:   { 
 106:     my $Self = shift;
 107: 
 108:     $Self->{ CENTER_COUNT } = 0;
 109:     $Self->{ RIGHT_COUNT }  = 0;
 110:   },
 111: 
 112:   rj => sub 		#  Enable right justification for [n|1] lines
 113:   { 
 114:     my $Self = shift; 
 115:     my $Args = shift;
 116:     if ( $Args eq "" ) { $Args = 1; }
 117: 
 118:     $Self->{ RIGHT_COUNT } += $Args;
 119:     $Self->{ CENTER_COUNT } = 0;
 120:   },
 121:     
 122: );
 123: 
 124: #  INTERNAL METHODS
 125: 
 126: #  Object initialization routine
 127: 
 128: sub _Init
 129: {
 130:   my $Self = shift;
 131: 
 132:   $Self->{ LINE_LENGTH } = 72;
 133:   $Self->{ INDENT } = 0;
 134: 
 135:   $Self->{ CENTER_COUNT } = 0;
 136:   $Self->{ RIGHT_COUNT } = 0;
 137: 
 138:   $Self->{ FILL_FLAG } = 1;
 139: 
 140:   $Self->_StartLine();
 141: }
 142: 
 143: #  Start a new line. This calculates the available space based on the
 144: #  current indent and line length. Each line is stored as a hash
 145: #  containing the text on the line, the justification and the available
 146: #  space.
 147: 
 148: sub _StartLine
 149: {
 150:   my $Self = shift;
 151:   my $Text = shift;
 152:   if ( !defined ( $Text ) ) { $Text = ""; }
 153: 
 154:   my $AvailableSpace =
 155:     $Self->{ LINE_LENGTH } - $Self->{ INDENT };
 156:   my %Hash = ( data => $Text, just => "L", size => $AvailableSpace );
 157: 
 158:   push ( @{ $Self->{ LINE_AOHR } }, \%Hash );
 159: }
 160: 
 161: #  Finish a line. This takes the indent and justification information and
 162: #  pads with spaces to get the desired look.
 163: 
 164: sub _FinishLine
 165: {
 166:   my $Self = shift;
 167: 
 168:   my $ThisLineHR = $Self->{ LINE_AOHR }->[ -1 ];
 169: 
 170:   my $Indent = " " x $Self->{ INDENT };
 171:   $ThisLineHR->{ data } = $Indent . $ThisLineHR->{ data };
 172: 
 173:   if ( $ThisLineHR->{ just } eq "C" )
 174:   {
 175:     my $Length = length ( $ThisLineHR->{ data } );
 176:     my $Padding = " " x ( ( $ThisLineHR->{ size } - $Length ) / 2 );
 177: 
 178:     $ThisLineHR->{ data } = "$Indent$Padding$ThisLineHR->{ data }";
 179:   } 
 180:   elsif ( $ThisLineHR->{ just } eq "R" )
 181:   {
 182:     my $Length = length ( $ThisLineHR->{ data } );
 183:     my $Padding = " " x ( $Self->{ LINE_LENGTH } - $Length );
 184: 
 185:     $ThisLineHR->{ data } = "$Padding$ThisLineHR->{ data }";
 186:   }
 187: }
 188: 
 189: #  Flush the current line by Finishing the current one and Starting a
 190: #  new one. This routine does nothing if the line is empty.
 191: 
 192: sub _FlushLine
 193: {
 194:   my $Self = shift;
 195:   my $Text = shift;
 196: 
 197:   if ( $Self->{ LINE_AOHR }[ -1 ]->{ data } ne "" )
 198:   {
 199:     if ( !defined ( $Text ) ) { $Text = ""; }
 200: 
 201:     _FinishLine ( $Self );
 202:     _StartLine (  $Self, $Text );
 203:   }
 204: }
 205: 
 206: #  END OF INTERNAL METHODS
 207: 
 208: #  START EXTERNAL METHODS
 209: 
 210: #  Class constructor
 211: 
 212: sub new
 213: {
 214:   my $Class = shift;
 215:   my $Self = {};
 216: 
 217:   bless ( $Self, $Class );
 218:   $Self->_Init();
 219: 
 220:   return ( $Self );
 221: }
 222: 
 223: #  Process a dot command. We go with the assumption that a command is
 224: #  formed by a leading dot '.' followed by an alphanumeric command. Right
 225: #  now all commands are two letters, but they could be an arbitrary
 226: #  length. Arguments are optional and are made into "" if not defined;
 227: #  each command handles that default value in their own way.
 228: 
 229: sub Cmd
 230: {
 231:   my $Self = shift;
 232:   my $InputText = shift;
 233:   chomp ( $InputText );
 234: 
 235:   my ( $Cmd, $Args ) = $InputText =~ m/^\.(\w+)\s*(.*)$/;
 236:   if ( defined ( $LocalCommands{ $Cmd } ) )
 237:   {
 238:     if ( !defined ( $Args ) ) { $Args = ""; }
 239:     $LocalCommands{ $Cmd }->( $Self, $Args );
 240:   }
 241:   else
 242:   {
 243:     warn "Roff: Command $Cmd has not yet been implemented.";
 244:   }
 245: }
 246: 
 247: #  Add a line of text to the output.
 248: 
 249: sub AddText
 250: {
 251:   my $Self      = shift;
 252:   my $InputText = shift;
 253:   chomp ( $InputText );
 254: 
 255:   #  If there are still input lines to be centered or right justified, mark 
 256:   #  that for the current output line and decrement the counter for
 257:   #  that justification count.
 258: 
 259:   if ( $Self->{ CENTER_COUNT } > 0 )
 260:   {
 261:     $Self->{ LINE_AOHR }[ -1 ]->{ just } = "C";
 262:     $Self->{ CENTER_COUNT }--;
 263:   }
 264:   elsif ( $Self->{ RIGHT_COUNT } > 0 )
 265:   {
 266:     $Self->{ LINE_AOHR }[ -1 ]->{ just } = "R";
 267:     $Self->{ RIGHT_COUNT }--;
 268:   }
 269: 
 270:   #  Split the incoming text line into words. Check to see if the word
 271:   #  fits on the line, add it if it does, otherwise start a new line with
 272:   #  the word. This assumes that there are no words longer than the current
 273:   #  line length.
 274: 
 275:   #  Commentary: It might be more efficient to figure out how space
 276:   #  there is then grab that much of the input line (moving backwards to
 277:   #  the first word boundary). I may add that in later versions.
 278: 
 279:   foreach ( split ( / /, $InputText ) )
 280:   {
 281:     my $ThisLineHR = $Self->{ LINE_AOHR }->[ -1 ];
 282:     my $ThisLine   = $ThisLineHR->{ data};
 283: 
 284:     if ( length ( $_ ) + length ( $ThisLine ) >= $ThisLineHR->{ size } )
 285:     {
 286:       _FlushLine ( $Self, $_ );
 287:     }
 288:     else
 289:     {
 290:       if ( length ( $ThisLine ) == 0 )
 291:       {
 292:         $ThisLine = "$_";
 293:       }
 294:       else
 295:       {
 296:         $ThisLine .= " $_";
 297:       }
 298:       $Self->{ LINE_AOHR }->[ -1 ]->{ data } = $ThisLine;
 299:     }
 300:   }
 301:   
 302:   #  If we're doing the no-fill thing, flush the current line and get a new 
 303:   #  line ready.
 304: 
 305:   if ( $Self->{ FILL_FLAG } == 0 )
 306:   {
 307:     _FlushLine ( $Self );
 308:   }
 309: }
 310: 
 311: #  This routine is called at the end of the input text file to close
 312: #  off the roff procedure.
 313: 
 314: sub EndOfText
 315: {
 316:   my $Self = shift;
 317:   _FinishLine ( $Self );
 318: }
 319: 
 320: #  This routine is called to dump the result out to STDOUT.
 321: 
 322: sub Output
 323: {
 324:   my $Self = shift;
 325: 
 326:   my $LineCount = 0;
 327:   foreach ( @{ $Self->{ LINE_AOHR } } )
 328:   {
 329:     printf ( "%3d: %s\n", $LineCount++, $_->{ data } );
 330:   }
 331: }
 332: 
 333: 1;
 334: 
 335: #  Test bed for Document object.
 336: #
 337: #  T. Alex Beamish, TAB Software -- 6 February 2002
 338: 
 339: use strict;
 340: 
 341: package main;
 342: 
 343: use Document;
 344: 
 345: {
 346:   my $TestDocument = new Document;
 347:   
 348:   while (<DATA>)
 349:   {
 350:     if ( /^\./ )
 351:     {
 352:       $TestDocument->Cmd ( $_ );
 353:     }
 354:     else
 355:     {
 356:       $TestDocument->AddText ( $_ );
 357:     }
 358:   }
 359:   $TestDocument->EndOfText();
 360:   $TestDocument->Output();
 361: }
 362: 
 363: __END__
 364: 
 365: .ce 2
 366: .nf
 367: .ll 60
 368: Test Page
 369: OO PERL implementation of roff
 370: .fi
 371: .bl 
 372: .rj
 373: February 7, 2002
 374: .nj
 375: .bl
 376: The idea is to write a fairly simple roff type text formatter in the Object
 377: Oriented style, in not one but three languages, C, Perl and Java. This code
 378: would be posted on my web site as the start to a code portfolio.
 379: .bl
 380: The commands currently implemented are:
 381: .bl
 382: .in 5
 383: .nf
 384: br - break the current line
 385: bl [n|1] - insert n blank lines
 386: ce [n|1] - center the next n lines
 387: fi - fill output lines from input lines
 388: in [n|0] - indent using n spaces
 389: ll [n|64] - set line length to n
 390: nf - don't fill output lines from input lines
 391: nj - cancel right and center justification
 392: rj [n|1] - right justify the next n lines
 393: .fi
 394: .bl
 395: .in
 396: Determining what Object model to use has been tough ..
 397: right now I am planning to go with 
 398: Document -> Page -> Column to simplify things
 399: but I may decide later that I need a Paragraph/Table object
 400: so that I can make unbreakable tables and provide widow/orphan control.
 401: .bl
 402: Comments are welcome! You can reach me at
 403: talexb at tabsoft dot on dot ca.