imtoc.perl

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