lib/Imager/Preprocess.pm

   1 package Imager::Preprocess;
   2 use strict;
   3 require Exporter;
   4 use vars qw(@ISA @EXPORT $VERSION);
   5 use Getopt::Long;
   6 use Text::ParseWords;
   7
   8 @EXPORT = qw(preprocess);
   9 @ISA = qw(Exporter);
  10
  11 $VERSION = "1.001";
  12
  13 sub preprocess {
  14   unshift @ARGV, grep /^-/, shellwords($ENV{IMAGER_PREPROCESS_OPTS})
  15     if $ENV{IMAGER_PREPROCESS_OPTS};
  16   my $skip_lines = 0;
  17   GetOptions("l" => \$skip_lines)
  18     or usage();
  19   my $keep_lines = !$skip_lines;
  20
  21   my $src = shift @ARGV;
  22   my $dest = shift @ARGV
  23     or usage();
  24
  25   open SRC, "< $src"
  26   or die "Cannot open $src: $!\n";
  27
  28   my $cond;
  29   my $cond_line;
  30   my $save_code;
  31   my @code;
  32   my $code_line;
  33   my @out;
  34   my $failed;
  35
  36   push @out,
  37     "#define IM_ROUND_8(x) ((int)((x)+0.5))\n",
  38     "#define IM_ROUND_double(x) (x)\n",
  39     "#define IM_LIMIT_8(x) ((x) < 0 ? 0 : (x) > 255 ? 255 : (x))\n",
  40     "#define IM_LIMIT_double(x) ((x) < 0.0 ? 0.0 : (x) > 1.0 ? 1.0 : (x))\n";
  41   push @out, "#line 1 \"$src\"\n" if $keep_lines;
  42   while (defined(my $line = <SRC>)) {
  43     if ($line =~ /^\#code\s+(\S.+)$/) {
  44       $save_code
  45         and do { warn "$src:$code_line:Unclosed #code block\n"; ++$failed; };
  46
  47       $cond = $1;
  48       $cond_line = $.;
  49       $code_line = $. + 1;
  50       $save_code = 1;
  51     }
  52     elsif ($line =~ /^\#code\s*$/) {
  53       $save_code
  54         and do { warn "$src:$code_line:Unclosed #code block\n"; ++$failed; };
  55
  56       $cond = '';
  57       $cond_line = 0;
  58       $code_line = $. + 1;
  59       $save_code = 1;
  60     }
  61     elsif ($line =~ /^\#\/code\s*$/) {
  62       $save_code
  63         or do { warn "$src:$.:#/code without #code\n"; ++$failed; next; };
  64
  65       if ($cond) {
  66         push @out, "#line $cond_line \"$src\"\n" if $keep_lines;
  67         push @out, "  if ($cond) {\n";
  68       }
  69       push @out,
  70         "#undef IM_EIGHT_BIT\n",
  71         "#define IM_EIGHT_BIT 1\n",
  72         "#undef IM_FILL_COMBINE\n",
  73         "#define IM_FILL_COMBINE(fill) ((fill)->combine)\n",
  74         "#undef IM_FILL_FILLER\n",
  75         "#define IM_FILL_FILLER(fill) ((fill)->f_fill_with_color)\n";
  76       push @out, "#line $code_line \"$src\"\n" if $keep_lines;
  77       push @out, byte_samples(@code);
  78       push @out, "  }\n", "  else {\n"
  79         if $cond;
  80       push @out,
  81         "#undef IM_EIGHT_BIT\n",
  82         "#undef IM_FILL_COMBINE\n",
  83         "#define IM_FILL_COMBINE(fill) ((fill)->combinef)\n",
  84         "#undef IM_FILL_FILLER\n",
  85         "#define IM_FILL_FILLER(fill) ((fill)->f_fill_with_fcolor)\n";
  86       push @out, "#line $code_line \"$src\"\n" if $keep_lines;
  87       push @out, double_samples(@code);
  88       push @out, "  }\n"
  89         if $cond;
  90       push @out, "#line ",$.+1," \"$src\"\n" if $keep_lines;
  91       @code = ();
  92       $save_code = 0;
  93     }
  94     elsif ($save_code) {
  95       push @code, $line;
  96     }
  97     else {
  98       push @out, $line;
  99     }
 100   }
 101
 102   if ($save_code) {
 103     warn "$src:$code_line:#code block not closed by EOF\n";
 104     ++$failed;
 105   }
 106
 107   close SRC;
 108
 109   $failed
 110     and die "Errors during parsing, aborting\n";
 111
 112   open DEST, "> $dest"
 113     or die "Cannot open $dest: $!\n";
 114   print DEST @out;
 115   close DEST;
 116 }
 117
 118 sub byte_samples {
 119   # important we make a copy
 120   my @lines = @_;
 121
 122   for (@lines) {
 123     s/\bIM_GPIX\b/i_gpix/g;
 124     s/\bIM_GLIN\b/i_glin/g;
 125     s/\bIM_PPIX\b/i_ppix/g;
 126     s/\bIM_PLIN\b/i_plin/g;
 127     s/\bIM_GSAMP\b/i_gsamp/g;
 128     s/\bIM_PSAMP\b/i_psamp/g;
 129     s/\bIM_SAMPLE_MAX\b/255/g;
 130     s/\bIM_SAMPLE_MAX2\b/65025/g;
 131     s/\bIM_SAMPLE_T/i_sample_t/g;
 132     s/\bIM_COLOR\b/i_color/g;
 133     s/\bIM_WORK_T\b/int/g;
 134     s/\bIM_Sf\b/"%d"/g;
 135     s/\bIM_Wf\b/"%d"/g;
 136     s/\bIM_SUFFIX\((\w+)\)/$1_8/g;
 137     s/\bIM_ROUND\(/IM_ROUND_8(/g;
 138     s/\bIM_ADAPT_COLORS\(/i_adapt_colors(/g;
 139     s/\bIM_LIMIT\(/IM_LIMIT_8(/g;
 140     s/\bIM_RENDER_LINE\(/i_render_line(/g;
 141     s/\bIM_FILL_COMBINE_F\b/i_fill_combine_f/g;
 142   }
 143
 144   @lines;
 145 }
 146
 147 sub double_samples {
 148   # important we make a copy
 149   my @lines = @_;
 150
 151   for (@lines) {
 152     s/\bIM_GPIX\b/i_gpixf/g;
 153     s/\bIM_GLIN\b/i_glinf/g;
 154     s/\bIM_PPIX\b/i_ppixf/g;
 155     s/\bIM_PLIN\b/i_plinf/g;
 156     s/\bIM_GSAMP\b/i_gsampf/g;
 157     s/\bIM_PSAMP\b/i_psampf/g;
 158     s/\bIM_SAMPLE_MAX\b/1.0/g;
 159     s/\bIM_SAMPLE_MAX2\b/1.0/g;
 160     s/\bIM_SAMPLE_T/i_fsample_t/g;
 161     s/\bIM_COLOR\b/i_fcolor/g;
 162     s/\bIM_WORK_T\b/double/g;
 163     s/\bIM_Sf\b/"%f"/g;
 164     s/\bIM_Wf\b/"%f"/g;
 165     s/\bIM_SUFFIX\((\w+)\)/$1_double/g;
 166     s/\bIM_ROUND\(/IM_ROUND_double(/g;
 167     s/\bIM_ADAPT_COLORS\(/i_adapt_fcolors(/g;
 168     s/\bIM_LIMIT\(/IM_LIMIT_double(/g;
 169     s/\bIM_RENDER_LINE\(/i_render_linef(/g;
 170     s/\bIM_FILL_COMBINE_F\b/i_fill_combinef_f/g;
 171   }
 172
 173   @lines;
 174 }
 175
 176 sub usage {
 177   die <<EOS;
 178 Usage: perl -MImager::Preprocess -epreprocess [-l] infile outfile
 179   -l don't produce #line directives
 180   infile - input file
 181   outfile output file
 182
 183 See perldoc Imager::Preprocess for details.
 184 EOS
 185 }
 186
 187 1;
 188
 189 __END__
 190
 191 =head1 NAME
 192
 193 =for stopwords preprocessor
 194
 195 Imager::Preprocess - simple preprocessor for handling multiple sample sizes
 196
 197 =head1 SYNOPSIS
 198
 199   /* in the source: */
 200   #code condition true to work with 8-bit samples
 201   ... code using preprocessor types/values ...
 202   #/code
 203
 204   # process and make #line directives
 205   perl -MImager::Preprocess -epreprocess foo.im foo.c
 206
 207   # process and no #line directives
 208   perl -MImager::Preprocess -epreprocess -l foo.im foo.c
 209
 210 =head1 DESCRIPTION
 211
 212 This is a simple preprocessor that aims to reduce duplication of
 213 source code when implementing an algorithm both for 8-bit samples and
 214 double samples in Imager.
 215
 216 Imager's C<Makefile.PL> currently scans the F<MANIFEST> for F<.im>
 217 files and adds Makefile files to convert these to F<.c> files.
 218
 219 The beginning of a sample-independent section of code is preceded by:
 220
 221   #code expression
 222
 223 where I<expression> should return true if processing should be done at
 224 8-bits/sample.
 225
 226 You can also use a #code block around a function definition to produce
 227 8-bit and double sample versions of a function.  In this case #code
 228 has no expression and you will need to use IM_SUFFIX() to produce
 229 different function names.
 230
 231 The end of a sample-independent section of code is terminated by:
 232
 233   #/code
 234
 235 #code sections cannot be nested.
 236
 237 #/code without a starting #code is an error.
 238
 239 The following types and values are defined in a #code section:
 240
 241 =over
 242
 243 =item *
 244
 245 IM_GPIX(C<im>, C<x>, C<y>, C<&col>)
 246
 247 =item *
 248
 249 IM_GLIN(C<im>, C<l>, C<r>, C<y>, C<colors>)
 250
 251 =item *
 252
 253 IM_PPIX(C<im>, C<x>, C<y>, C<&col>)
 254
 255 =item *
 256
 257 IM_PLIN(C<im>, C<x>, C<y>, C<colors>)
 258
 259 =item *
 260
 261 IM_GSAMP(C<im>, C<l>, C<r>, C<y>, C<samples>, C<chans>, C<chan_count>)
 262
 263 These correspond to the appropriate image function, eg. IM_GPIX()
 264 becomes i_gpix() or i_gpixf() as appropriate.
 265
 266 =item *
 267
 268 IM_ADAPT_COLORS(C<dest_channels>, C<src_channels>, C<colors>, C<count>)
 269
 270 Call i_adapt_colors() or i_adapt_fcolors().
 271
 272 =item *
 273
 274 IM_FILL_COMBINE(C<fill>) - retrieve the combine function from a fill
 275 object.
 276
 277 =item *
 278
 279 IM_FILL_FILLER(C<fill>) - retrieve the fill_with_* function from a fill
 280 object.
 281
 282 =item *
 283
 284 IM_SAMPLE_MAX - maximum value for a sample
 285
 286 =item *
 287
 288 IM_SAMPLE_MAX2 - maximum value for a sample, squared
 289
 290 =item *
 291
 292 IM_SAMPLE_T - type of a sample (i_sample_t or i_fsample_t)
 293
 294 =item *
 295
 296 IM_COLOR - color type, either i_color or i_fcolor.
 297
 298 =item *
 299
 300 IM_WORK_T - working sample type, either int or double.
 301
 302 =item *
 303
 304 IM_Sf - format string for the sample type, C<"%d"> or C<"%f">.
 305
 306 =item *
 307
 308 IM_Wf - format string for the work type, C<"%d"> or C<"%f">.
 309
 310 =item *
 311
 312 IM_SUFFIX(identifier) - adds _8 or _double onto the end of identifier.
 313
 314 =item *
 315
 316 IM_EIGHT_BIT - this is a macro defined only in 8-bit/sample code.
 317
 318 =back
 319
 320 Other types, functions and values may be added in the future.
 321
 322 =head1 AUTHOR
 323
 324 Tony Cook <tonyc@cpan.org>
 325
 326 =cut