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, "#line 1 \"$src\"\n";
  20 while (defined(my $line = <SRC>)) {
  21   if ($line =~ /^\#code\s+(\S.+)$/) {
  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   }
  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   }
  39   elsif ($line =~ /^\#\/code$/) {
  40     $save_code
  41       or do { warn "$src:$.:#/code without #code\n"; ++$failed; next; };
  42
  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";
  49     push @out, "#line $code_line \"$src\"\n";
  50     push @out, byte_samples(@code);
  51     push @out, "  }\n", "  else {\n"
  52       if $cond;
  53     push @out, "#undef IM_EIGHT_BIT\n";
  54     push @out, "#line $code_line \"$src\"\n";
  55     push @out, double_samples(@code);
  56     push @out, "  }\n"
  57       if $cond;
  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;
 101     s/\bIM_SUFFIX\((\w+)\)/$1_8/g;
 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;
 123     s/\bIM_SUFFIX\((\w+)\)/$1_double/g;
 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
 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
 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
 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
 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