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.
Back to
Craft