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.