Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Roff done as an OO exercise

by talexb (Canon)
on Feb 07, 2002 at 16:58 UTC ( #143922=perlcraft: print w/ replies, xml ) Need Help??

   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.

Comment on Roff done as an OO exercise
Download Code
Re: Roff done as an OO exercise
by demerphq (Chancellor) on Jan 21, 2005 at 08:53 UTC

    Itd be nice if you included a bit of an explanation as to how roff works so we can use it to understand the code a little better. If you arent familiar with the input stream being processed its difficult to asses the code reading it. :-)

    ---
    demerphq

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlcraft [id://143922]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (7)
As of 2014-09-23 09:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (216 votes), past polls