1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
require 5.005;
use strict; # Time-stamp: "2001-04-24 01:50:43 MDT"
use RTF::Writer 1.01;
=head1 NAME
demo_writer.pl -- a lame sample program for outputting RTF
=head1 SYNOPSIS
Read the source of this program.
It's ejumucational.
=head1 DESCRIPTION
One of my many superpowers is writing Perl programs that read lexical
databases, chew them up, and spit out a tidily formatted
dictionary, in RTF.
Why RTF? Just convenience -- I happened to know a
bit about RTF, and I didn't know TeX. (And XML+XSL didn't
exist at the time.) For ages I wrote (and rewrote, anew each time)
completely ad-hoc code to
spit out RTF. But after a few years of having to consult the icky
I<RTF Specification> to remember how to turn on page numbering,
or emit a useful prolog, I decided to write RTF::Writer, to
simplify these tasks.
This program, demo_writer.pl, is just an example program that
uses RTF::Writer to emit RTF. The RTF it happens to emit, is
a miniature lexicon file, based an a miniature lexical
database as input.
See also L<RTF::Writer|RTF::Writer> and
L<RTF::Cookbook|RTF::Cookbook>.
=head1 AUTHOR
Sean M. Burke, sburke@cpan.org
=cut
my $nl = "
";
my @records = split("\n\n", q{
\hw toc
\en tap
\en knock
\pos n.m.
\hw lys
\pos n.m.
\en lily
\en knock
\hw fltrir
\pos v.itr.
\en to wilt
\en for a flower or beauty to fade
\en for a plant to wither
\hw mort
\pos adj.
\en dead
\xref mourir
\hw emporter
\pos v.tr.
\en to take a person or thing [somewhere]
\en to take [out/away/etc.] or carry [away] a thing
\hw toquer
\pos v.itr.
\en to tap
\en to knock
\hw trotter
\pos v.itr.
\en to trot
\en to scurry
\hw souris
\pos n.f.
\en mouse
\semantic_field animals
});
#------------------------------------------------------------------------
{
# A private class for lexicon entries:
package _SMB::Lexicon::Entry;
sub get ($) {
my $x = $_[0]->{$_[1]} || [];
return @$x if wantarray;
return join '', @$x;
}
}
#------------------------------------------------------------------------
# Init records:
foreach my $r (@records) {
my %hash;
foreach my $l (grep m/\S/, split "\n", $r) {
if($l =~ m/^\\(\w+)\s+(.+)/s) {
# print "<$1> <$2>\n";
push @{$hash{$1} ||= []}, $2;
} else {
die "Line <$l> is bonkers";
}
}
$r = bless(\%hash, '_SMB::Lexicon::Entry') if scalar keys %hash;
}
{
my $nil = [''];
@records =
# Actually we'd really want to use Sort::ArbBiLex instead
sort {
# Sort according to the (first) headword
lc( ($a->{'hw'} || $nil )->[0] ) cmp
lc( ($b->{'hw'} || $nil )->[0] )
}
grep ref($_), @records;
}
my $rtf = RTF::Writer->new_to_file('lex_out.rtf');
$rtf->prolog;
$rtf->number_pages("Lexicon, p.");
$rtf->paragraph(\'\sa400\fs44\scaps', "Sample Lexicon",);
#------------------------------------------------------------------------
# Write out each record:
foreach my $r (@records) {
next unless ref $r;
# use Data::Dumper; print Dumper($r), "\n\n";
my @stuff;
$rtf->printf( \'{\pard\li300\fi-150\plain\fs24' );
my $hw = $r->get('hw');
my $pos = $r->get('pos');
if($pos) {
$rtf->printf(
\'{\fs30\b\lang1036\noproof %s}{\i (%s)} \endash ',
$hw || '??', $pos
);
} else {
$rtf->printf(
\'{\fs30\b\lang1036 %s} \emdash ',
$hw || '??'
);
}
$rtf->print(join '; ', $r->get('en'));
$rtf->printf( \"\\par}\n\n" );
}
$rtf->paragraph(\'\sb400',
sprintf("--\n%d entries. Generated %s by \xAB%s\xBB",
scalar(@records),
scalar(localtime),
$0 || '??',
)
);
exit;
|
