summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl.straw/lib/Imager/Preprocess.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/Imager/Preprocess.pm')
-rwxr-xr-xMaster/tlpkg/tlperl.straw/lib/Imager/Preprocess.pm297
1 files changed, 297 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.straw/lib/Imager/Preprocess.pm b/Master/tlpkg/tlperl.straw/lib/Imager/Preprocess.pm
new file mode 100755
index 00000000000..f0b5be78892
--- /dev/null
+++ b/Master/tlpkg/tlperl.straw/lib/Imager/Preprocess.pm
@@ -0,0 +1,297 @@
+package Imager::Preprocess;
+use strict;
+require Exporter;
+use vars qw(@ISA @EXPORT);
+
+@EXPORT = qw(preprocess);
+@ISA = qw(Exporter);
+
+
+sub preprocess {
+ my $src = shift @ARGV;
+ my $dest = shift @ARGV
+ or usage();
+
+ open SRC, "< $src"
+ or die "Cannot open $src: $!\n";
+
+ my $cond;
+ my $cond_line;
+ my $save_code;
+ my @code;
+ my $code_line;
+ my @out;
+ my $failed;
+
+ push @out,
+ "#define IM_ROUND_8(x) ((int)((x)+0.5))\n",
+ "#define IM_ROUND_double(x) (x)\n",
+ "#define IM_LIMIT_8(x) ((x) < 0 ? 0 : (x) > 255 ? 255 : (x))\n",
+ "#define IM_LIMIT_double(x) ((x) < 0.0 ? 0.0 : (x) > 1.0 ? 1.0 : (x))\n",
+ "#line 1 \"$src\"\n";
+ while (defined(my $line = <SRC>)) {
+ if ($line =~ /^\#code\s+(\S.+)$/) {
+ $save_code
+ and do { warn "$src:$code_line:Unclosed #code block\n"; ++$failed; };
+
+ $cond = $1;
+ $cond_line = $.;
+ $code_line = $. + 1;
+ $save_code = 1;
+ }
+ elsif ($line =~ /^\#code\s*$/) {
+ $save_code
+ and do { warn "$src:$code_line:Unclosed #code block\n"; ++$failed; };
+
+ $cond = '';
+ $cond_line = 0;
+ $code_line = $. + 1;
+ $save_code = 1;
+ }
+ elsif ($line =~ /^\#\/code\s*$/) {
+ $save_code
+ or do { warn "$src:$.:#/code without #code\n"; ++$failed; next; };
+
+ if ($cond) {
+ push @out, "#line $cond_line \"$src\"\n";
+ push @out, " if ($cond) {\n";
+ }
+ push @out,
+ "#undef IM_EIGHT_BIT\n",
+ "#define IM_EIGHT_BIT 1\n",
+ "#undef IM_FILL_COMBINE\n",
+ "#define IM_FILL_COMBINE(fill) ((fill)->combine)\n",
+ "#undef IM_FILL_FILLER\n",
+ "#define IM_FILL_FILLER(fill) ((fill)->f_fill_with_color)\n";
+ push @out, "#line $code_line \"$src\"\n";
+ push @out, byte_samples(@code);
+ push @out, " }\n", " else {\n"
+ if $cond;
+ push @out,
+ "#undef IM_EIGHT_BIT\n",
+ "#undef IM_FILL_COMBINE\n",
+ "#define IM_FILL_COMBINE(fill) ((fill)->combinef)\n",
+ "#undef IM_FILL_FILLER\n",
+ "#define IM_FILL_FILLER(fill) ((fill)->f_fill_with_fcolor)\n";
+ push @out, "#line $code_line \"$src\"\n";
+ push @out, double_samples(@code);
+ push @out, " }\n"
+ if $cond;
+ push @out, "#line ",$.+1," \"$src\"\n";
+ @code = ();
+ $save_code = 0;
+ }
+ elsif ($save_code) {
+ push @code, $line;
+ }
+ else {
+ push @out, $line;
+ }
+ }
+
+ if ($save_code) {
+ warn "$src:$code_line:#code block not closed by EOF\n";
+ ++$failed;
+ }
+
+ close SRC;
+
+ $failed
+ and die "Errors during parsing, aborting\n";
+
+ open DEST, "> $dest"
+ or die "Cannot open $dest: $!\n";
+ print DEST @out;
+ close DEST;
+}
+
+sub byte_samples {
+ # important we make a copy
+ my @lines = @_;
+
+ for (@lines) {
+ s/\bIM_GPIX\b/i_gpix/g;
+ s/\bIM_GLIN\b/i_glin/g;
+ s/\bIM_PPIX\b/i_ppix/g;
+ s/\bIM_PLIN\b/i_plin/g;
+ s/\bIM_GSAMP\b/i_gsamp/g;
+ s/\bIM_SAMPLE_MAX\b/255/g;
+ s/\bIM_SAMPLE_MAX2\b/65025/g;
+ s/\bIM_SAMPLE_T/i_sample_t/g;
+ s/\bIM_COLOR\b/i_color/g;
+ s/\bIM_WORK_T\b/int/g;
+ s/\bIM_Sf\b/"%d"/g;
+ s/\bIM_Wf\b/"%d"/g;
+ s/\bIM_SUFFIX\((\w+)\)/$1_8/g;
+ s/\bIM_ROUND\(/IM_ROUND_8(/g;
+ s/\bIM_ADAPT_COLORS\(/i_adapt_colors(/g;
+ s/\bIM_LIMIT\(/IM_LIMIT_8(/g;
+ s/\bIM_RENDER_LINE\(/i_render_line(/g;
+ s/\bIM_FILL_COMBINE_F\b/i_fill_combine_f/g;
+ }
+
+ @lines;
+}
+
+sub double_samples {
+ # important we make a copy
+ my @lines = @_;
+
+ for (@lines) {
+ s/\bIM_GPIX\b/i_gpixf/g;
+ s/\bIM_GLIN\b/i_glinf/g;
+ s/\bIM_PPIX\b/i_ppixf/g;
+ s/\bIM_PLIN\b/i_plinf/g;
+ s/\bIM_GSAMP\b/i_gsampf/g;
+ s/\bIM_SAMPLE_MAX\b/1.0/g;
+ s/\bIM_SAMPLE_MAX2\b/1.0/g;
+ s/\bIM_SAMPLE_T/i_fsample_t/g;
+ s/\bIM_COLOR\b/i_fcolor/g;
+ s/\bIM_WORK_T\b/double/g;
+ s/\bIM_Sf\b/"%f"/g;
+ s/\bIM_Wf\b/"%f"/g;
+ s/\bIM_SUFFIX\((\w+)\)/$1_double/g;
+ s/\bIM_ROUND\(/IM_ROUND_double(/g;
+ s/\bIM_ADAPT_COLORS\(/i_adapt_fcolors(/g;
+ s/\bIM_LIMIT\(/IM_LIMIT_double(/g;
+ s/\bIM_RENDER_LINE\(/i_render_linef(/g;
+ s/\bIM_FILL_COMBINE_F\b/i_fill_combinef_f/g;
+ }
+
+ @lines;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Imager::Preprocess - simple preprocessor for handling multiple sample sizes
+
+=head1 SYNOPSIS
+
+ /* in the source: */
+ #code condition true to work with 8-bit samples
+ ... code using preprocessor types/values ...
+ #/code
+
+ perl -MImager -epreprocess foo.im foo.c
+
+=head1 DESCRIPTION
+
+This is a simple preprocessor that aims to reduce duplication of
+source code when implementing an algorithm both for 8-bit samples and
+double samples in Imager.
+
+Imager's Makefile.PL currently scans the MANIFEST for .im files and
+adds Makefile files to convert these to .c files.
+
+The beginning of a sample-independent section of code is preceded by:
+
+ #code expression
+
+where I<expression> should return true if processing should be done at
+8-bits/sample.
+
+You can also use a #code block around a function definition to produce
+8-bit and double sample versions of a function. In this case #code
+has no expression and you will need to use IM_SUFFIX() to produce
+different function names.
+
+The end of a sample-independent section of code is terminated by:
+
+ #/code
+
+#code sections cannot be nested.
+
+#/code without a starting #code is an error.
+
+The following types and values are defined in a #code section:
+
+=over
+
+=item *
+
+IM_GPIX(im, x, y, &col)
+
+=item *
+
+IM_GLIN(im, l, r, y, colors)
+
+=item *
+
+IM_PPIX(im, x, y, &col)
+
+=item *
+
+IM_PLIN(im, x, y, colors)
+
+=item *
+
+IM_GSAMP(im, l, r, y, samples, chans, chan_count)
+
+These correspond to the appropriate image function, eg. IM_GPIX()
+becomes i_gpix() or i_gpixf() as appropriate.
+
+=item *
+
+IM_ADAPT_COLORS(dest_channes, src_channels, colors, count)
+
+Call i_adapt_colors() or i_adapt_fcolors().
+
+=item *
+
+IM_FILL_COMBINE(fill) - retrieve the combine function from a fill
+object.
+
+=item *
+
+IM_FILL_FILLER(fill) - retrieve the fill_with_* function from a fill
+object.
+
+=item *
+
+IM_SAMPLE_MAX - maximum value for a sample
+
+=item *
+
+IM_SAMPLE_MAX2 - maximum value for a sample, squared
+
+=item *
+
+IM_SAMPLE_T - type of a sample (i_sample_t or i_fsample_t)
+
+=item *
+
+IM_COLOR - color type, either i_color or i_fcolor.
+
+=item *
+
+IM_WORK_T - working sample type, either int or double.
+
+=item *
+
+IM_Sf - format string for the sample type, C<"%d"> or C<"%f">.
+
+=item *
+
+IM_Wf - format string for the work type, C<"%d"> or C<"%f">.
+
+=item *
+
+IM_SUFFIX(identifier) - adds _8 or _double onto the end of identifier.
+
+=item *
+
+IM_EIGHT_BIT - this is a macro defined only in 8-bit/sample code.
+
+=back
+
+Other types, functions and values may be added in the future.
+
+=head1 AUTHOR
+
+Tony Cook <tony@imager.perl.org>
+
+=cut