Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

comment on

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

In reply to Roff done as an OO exercise by talexb

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others rifling through the Monastery: (1)
    As of 2021-02-27 07:50 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      No recent polls found

      Notices?