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.
