]>
Commit | Line | Data |
---|---|---|
fe415ad2 TC |
1 | #!perl -w |
2 | use strict; | |
3 | ||
4 | my $src = shift; | |
5 | my $dest = shift | |
6 | or usage(); | |
7 | ||
8 | open SRC, "< $src" | |
9 | or die "Cannot open $src: $!\n"; | |
10 | ||
11 | my $cond; | |
12 | my $cond_line; | |
13 | my $save_code; | |
14 | my @code; | |
15 | my $code_line; | |
16 | my @out; | |
17 | my $failed; | |
18 | ||
19 | push @out, "#line 1 \"$src\"\n"; | |
20 | while (defined(my $line = <SRC>)) { | |
a10945af | 21 | if ($line =~ /^\#code\s+(\S.+)$/) { |
fe415ad2 TC |
22 | $save_code |
23 | and do { warn "$src:$code_line:Unclosed #code block\n"; ++$failed; }; | |
24 | ||
25 | $cond = $1; | |
26 | $cond_line = $.; | |
27 | $code_line = $. + 1; | |
28 | $save_code = 1; | |
29 | } | |
a10945af TC |
30 | elsif ($line =~ /^\#code\s*$/) { |
31 | $save_code | |
32 | and do { warn "$src:$code_line:Unclosed #code block\n"; ++$failed; }; | |
33 | ||
34 | $cond = ''; | |
35 | $cond_line = 0; | |
36 | $code_line = $. + 1; | |
37 | $save_code = 1; | |
38 | } | |
fe415ad2 TC |
39 | elsif ($line =~ /^\#\/code$/) { |
40 | $save_code | |
41 | or do { warn "$src:$.:#/code without #code\n"; ++$failed; next; }; | |
42 | ||
a10945af TC |
43 | if ($cond) { |
44 | push @out, "#line $cond_line \"$src\"\n"; | |
45 | push @out, " if ($cond) {\n"; | |
46 | } | |
47 | push @out, "#undef IM_EIGHT_BIT\n", | |
48 | "#define IM_EIGHT_BIT 1\n"; | |
fe415ad2 TC |
49 | push @out, "#line $code_line \"$src\"\n"; |
50 | push @out, byte_samples(@code); | |
a10945af TC |
51 | push @out, " }\n", " else {\n" |
52 | if $cond; | |
53 | push @out, "#undef IM_EIGHT_BIT\n"; | |
fe415ad2 TC |
54 | push @out, "#line $code_line \"$src\"\n"; |
55 | push @out, double_samples(@code); | |
a10945af TC |
56 | push @out, " }\n" |
57 | if $cond; | |
fe415ad2 TC |
58 | push @out, "#line $. \"$src\"\n"; |
59 | @code = (); | |
60 | $save_code = 0; | |
61 | } | |
62 | elsif ($save_code) { | |
63 | push @code, $line; | |
64 | } | |
65 | else { | |
66 | push @out, $line; | |
67 | } | |
68 | } | |
69 | ||
70 | if ($save_code) { | |
71 | warn "$src:$code_line:#code block not closed by EOF\n"; | |
72 | ++$failed; | |
73 | } | |
74 | ||
75 | close SRC; | |
76 | ||
77 | $failed | |
78 | and die "Errors during parsing, aborting\n"; | |
79 | ||
80 | open DEST, "> $dest" | |
81 | or die "Cannot open $dest: $!\n"; | |
82 | print DEST @out; | |
83 | close DEST; | |
84 | ||
85 | sub byte_samples { | |
86 | # important we make a copy | |
87 | my @lines = @_; | |
88 | ||
89 | for (@lines) { | |
90 | s/\bIM_GPIX\b/i_gpix/g; | |
91 | s/\bIM_GLIN\b/i_glin/g; | |
92 | s/\bIM_PPIX\b/i_ppix/g; | |
93 | s/\bIM_PLIN\b/i_plin/g; | |
94 | s/\bIM_GSAMP\b/i_gsamp/g; | |
95 | s/\bIM_SAMPLE_MAX\b/255/g; | |
96 | s/\bIM_SAMPLE_T/i_sample_t/g; | |
97 | s/\bIM_COLOR\b/i_color/g; | |
98 | s/\bIM_WORK_T\b/int/g; | |
99 | s/\bIM_Sf\b/"%d"/g; | |
100 | s/\bIM_Wf\b/"%d"/g; | |
a10945af | 101 | s/\bIM_SUFFIX\((\w+)\)/$1_8/g; |
fe415ad2 TC |
102 | } |
103 | ||
104 | @lines; | |
105 | } | |
106 | ||
107 | sub double_samples { | |
108 | # important we make a copy | |
109 | my @lines = @_; | |
110 | ||
111 | for (@lines) { | |
112 | s/\bIM_GPIX\b/i_gpixf/g; | |
113 | s/\bIM_GLIN\b/i_glinf/g; | |
114 | s/\bIM_PPIX\b/i_ppixf/g; | |
115 | s/\bIM_PLIN\b/i_plinf/g; | |
116 | s/\bIM_GSAMP\b/i_gsampf/g; | |
117 | s/\bIM_SAMPLE_MAX\b/1.0/g; | |
118 | s/\bIM_SAMPLE_T/i_fsample_t/g; | |
119 | s/\bIM_COLOR\b/i_fcolor/g; | |
120 | s/\bIM_WORK_T\b/double/g; | |
121 | s/\bIM_Sf\b/"%f"/g; | |
122 | s/\bIM_Wf\b/"%f"/g; | |
a10945af | 123 | s/\bIM_SUFFIX\((\w+)\)/$1_double/g; |
fe415ad2 TC |
124 | } |
125 | ||
126 | @lines; | |
127 | } | |
128 | ||
129 | =head1 NAME | |
130 | ||
131 | imtoc.perl - simple preprocessor for handling multiple sample sizes | |
132 | ||
133 | =head1 SYNOPSIS | |
134 | ||
135 | /* in the source: */ | |
136 | #code condition true to work with 8-bit samples | |
137 | ... code using preprocessor types/values ... | |
138 | #/code | |
139 | ||
140 | perl imtoc.perl foo.im foo.c | |
141 | ||
142 | =head1 DESCRIPTION | |
143 | ||
144 | This is a simple preprocessor that aims to reduce duplication of | |
145 | source code when implementing an algorithm both for 8-bit samples and | |
146 | double samples in Imager. | |
147 | ||
148 | Imager's Makefile.PL currently scans the MANIFEST for .im files and | |
149 | adds Makefile files to convert these to .c files. | |
150 | ||
151 | The beginning of a sample-independent section of code is preceded by: | |
152 | ||
153 | #code expression | |
154 | ||
155 | where I<expression> should return true if processing should be done at | |
156 | 8-bits/sample. | |
157 | ||
a10945af TC |
158 | You can also use a #code block around a function definition to produce |
159 | 8-bit and double sample versions of a function. In this case #code | |
160 | has no expression and you will need to use IM_SUFFIX() to produce | |
161 | different function names. | |
162 | ||
fe415ad2 TC |
163 | The end of a sample-independent section of code is terminated by: |
164 | ||
165 | #/code | |
166 | ||
167 | #code sections cannot be nested. | |
168 | ||
169 | #/code without a starting #code is an error. | |
170 | ||
171 | The following types and values are defined in a #code section: | |
172 | ||
173 | =over | |
174 | ||
175 | =item * | |
176 | ||
177 | IM_GPIX(im, x, y, &col) | |
178 | ||
179 | =item * | |
180 | ||
181 | IM_GLIN(im, l, r, y, colors) | |
182 | ||
183 | =item * | |
184 | ||
185 | IM_PPIX(im, x, y, &col) | |
186 | ||
187 | =item * | |
188 | ||
189 | IM_PLIN(im, x, y, colors) | |
190 | ||
191 | =item * | |
192 | ||
193 | IM_GSAMP(im, l, r, y, samples, chans, chan_count) | |
194 | ||
195 | These correspond to the appropriate image function, eg. IM_GPIX() | |
196 | becomes i_gpix() or i_gpixf() as appropriate. | |
197 | ||
198 | =item * | |
199 | ||
200 | IM_SAMPLE_MAX - maximum value for a sample | |
201 | ||
202 | =item * | |
203 | ||
204 | IM_SAMPLE_T - type of a sample (i_sample_t or i_fsample_t) | |
205 | ||
206 | =item * | |
207 | ||
208 | IM_COLOR - color type, either i_color or i_fcolor. | |
209 | ||
210 | =item * | |
211 | ||
212 | IM_WORK_T - working sample type, either int or double. | |
213 | ||
214 | =item * | |
215 | ||
216 | IM_Sf - format string for the sample type, C<"%d"> or C<"%f">. | |
217 | ||
218 | =item * | |
219 | ||
220 | IM_Wf - format string for the work type, C<"%d"> or C<"%f">. | |
221 | ||
a10945af TC |
222 | =item * |
223 | ||
224 | IM_SUFFIX(identifier) - adds _8 or _double onto the end of identifier. | |
225 | ||
226 | =item * | |
227 | ||
228 | IM_EIGHT_BIT - this is a macro defined only in 8-bit/sample code. | |
229 | ||
fe415ad2 TC |
230 | =back |
231 | ||
232 | Other types, functions and values may be added in the future. | |
233 | ||
234 | =head1 AUTHOR | |
235 | ||
236 | Tony Cook <tony@imager.perl.org> | |
237 | ||
238 | =cut |