[imager.git] / lib / Imager / Preprocess.pm

package Imager::Preprocess;
use 5.006;
use strict;
require Exporter;
use Getopt::Long;
use Text::ParseWords;

our @EXPORT = qw(preprocess);
our @ISA = qw(Exporter);

our $VERSION = "1.003";

sub preprocess {
  unshift @ARGV, grep /^-/, shellwords($ENV{IMAGER_PREPROCESS_OPTS})
    if $ENV{IMAGER_PREPROCESS_OPTS};
  my $skip_lines = 0;
  GetOptions("l" => \$skip_lines)
    or usage();
  my $keep_lines = !$skip_lines;

  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";
  push @out, "#line 1 \"$src\"\n" if $keep_lines;
  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" if $keep_lines;
	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" if $keep_lines;
      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" if $keep_lines;
      push @out, double_samples(@code);
      push @out, "  }\n"
	if $cond;
      push @out, "#line ",$.+1," \"$src\"\n" if $keep_lines;
      @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_PSAMP\b/i_psamp/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;
    s/\bIM_ABS\b/abs/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_PSAMP\b/i_psampf/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;
    s/\bIM_ABS\b/fabs/g;
  }

  @lines;
}

sub usage {
  die <<EOS;
Usage: perl -MImager::Preprocess -epreprocess [-l] infile outfile
  -l don't produce #line directives
  infile - input file
  outfile output file

See perldoc Imager::Preprocess for details.
EOS
}

1;

__END__

=head1 NAME

=for stopwords preprocessor

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

  # process and make #line directives
  perl -MImager::Preprocess -epreprocess foo.im foo.c

  # process and no #line directives
  perl -MImager::Preprocess -epreprocess -l 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 C<Makefile.PL> currently scans the F<MANIFEST> for F<.im>
files and adds Makefile files to convert these to F<.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(C<im>, C<x>, C<y>, C<&col>)

=item *

IM_GLIN(C<im>, C<l>, C<r>, C<y>, C<colors>)

=item *

IM_PPIX(C<im>, C<x>, C<y>, C<&col>)

=item *

IM_PLIN(C<im>, C<x>, C<y>, C<colors>)

=item *

IM_GSAMP(C<im>, C<l>, C<r>, C<y>, C<samples>, C<chans>, C<chan_count>)

These correspond to the appropriate image function, eg. IM_GPIX()
becomes i_gpix() or i_gpixf() as appropriate.

=item *

IM_ADAPT_COLORS(C<dest_channels>, C<src_channels>, C<colors>, C<count>)

Call i_adapt_colors() or i_adapt_fcolors().

=item *

IM_FILL_COMBINE(C<fill>) - retrieve the combine function from a fill
object.

=item *

IM_FILL_FILLER(C<fill>) - retrieve the fill_with_* function from a fill
object.

=item *

IM_ABS(sample) - calculate the absolute value of an IM_WORK_T value.

=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 <tonyc@cpan.org>

=cut
Commit	Line	Data
9b1ec2b8	1	package Imager::Preprocess;
ee64a81f	2	use 5.006;
9b1ec2b8 TC	3	use strict;
9b1ec2b8 TC	4	require Exporter;
93bc63ea TC	5	use Getopt::Long;
93bc63ea TC	6	use Text::ParseWords;
9b1ec2b8	7
ee64a81f TC	8	our @EXPORT = qw(preprocess);
ee64a81f TC	9	our @ISA = qw(Exporter);
9b1ec2b8	10
dcdafbb0	11	our $VERSION = "1.003";
5715f7c3	12
9b1ec2b8	13	sub preprocess {
93bc63ea TC	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
9b1ec2b8 TC	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",
93bc63ea TC	40	"#define IM_LIMIT_double(x) ((x) < 0.0 ? 0.0 : (x) > 1.0 ? 1.0 : (x))\n";
93bc63ea TC	41	push @out, "#line 1 \"$src\"\n" if $keep_lines;
9b1ec2b8 TC	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	}
9e713610	61	elsif ($line =~ /^\#\/code\s*$/) {
9b1ec2b8 TC	62	$save_code
	63	or do { warn "$src:$.:#/code without #code\n"; ++$failed; next; };
	64
	65	if ($cond) {
93bc63ea	66	push @out, "#line $cond_line \"$src\"\n" if $keep_lines;
9b1ec2b8 TC	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";
93bc63ea	76	push @out, "#line $code_line \"$src\"\n" if $keep_lines;
9b1ec2b8 TC	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";
93bc63ea	86	push @out, "#line $code_line \"$src\"\n" if $keep_lines;
9b1ec2b8 TC	87	push @out, double_samples(@code);
	88	push @out, " }\n"
	89	if $cond;
93bc63ea	90	push @out, "#line ",$.+1," \"$src\"\n" if $keep_lines;
9b1ec2b8 TC	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;
3c030abe	128	s/\bIM_PSAMP\b/i_psamp/g;
9b1ec2b8 TC	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;
dcdafbb0	142	s/\bIM_ABS\b/abs/g;
9b1ec2b8 TC	143	}
	144
	145	@lines;
	146	}
	147
	148	sub double_samples {
	149	# important we make a copy
	150	my @lines = @_;
	151
	152	for (@lines) {
	153	s/\bIM_GPIX\b/i_gpixf/g;
	154	s/\bIM_GLIN\b/i_glinf/g;
	155	s/\bIM_PPIX\b/i_ppixf/g;
	156	s/\bIM_PLIN\b/i_plinf/g;
	157	s/\bIM_GSAMP\b/i_gsampf/g;
3c030abe	158	s/\bIM_PSAMP\b/i_psampf/g;
9b1ec2b8 TC	159	s/\bIM_SAMPLE_MAX\b/1.0/g;
	160	s/\bIM_SAMPLE_MAX2\b/1.0/g;
	161	s/\bIM_SAMPLE_T/i_fsample_t/g;
	162	s/\bIM_COLOR\b/i_fcolor/g;
	163	s/\bIM_WORK_T\b/double/g;
	164	s/\bIM_Sf\b/"%f"/g;
	165	s/\bIM_Wf\b/"%f"/g;
	166	s/\bIM_SUFFIX\((\w+)\)/$1_double/g;
	167	s/\bIM_ROUND\(/IM_ROUND_double(/g;
	168	s/\bIM_ADAPT_COLORS\(/i_adapt_fcolors(/g;
	169	s/\bIM_LIMIT\(/IM_LIMIT_double(/g;
	170	s/\bIM_RENDER_LINE\(/i_render_linef(/g;
	171	s/\bIM_FILL_COMBINE_F\b/i_fill_combinef_f/g;
dcdafbb0	172	s/\bIM_ABS\b/fabs/g;
9b1ec2b8 TC	173	}
	174
	175	@lines;
	176	}
	177
93bc63ea TC	178	sub usage {
	179	die <<EOS;
	180	Usage: perl -MImager::Preprocess -epreprocess [-l] infile outfile
	181	-l don't produce #line directives
	182	infile - input file
	183	outfile output file
	184
	185	See perldoc Imager::Preprocess for details.
	186	EOS
	187	}
	188
9b1ec2b8 TC	189	1;
	190
	191	__END__
	192
	193	=head1 NAME
	194
5715f7c3 TC	195	=for stopwords preprocessor
5715f7c3 TC	196
9b1ec2b8 TC	197	Imager::Preprocess - simple preprocessor for handling multiple sample sizes
	198
	199	=head1 SYNOPSIS
	200
	201	/* in the source: */
	202	#code condition true to work with 8-bit samples
	203	... code using preprocessor types/values ...
	204	#/code
	205
93bc63ea TC	206	# process and make #line directives
	207	perl -MImager::Preprocess -epreprocess foo.im foo.c
	208
	209	# process and no #line directives
	210	perl -MImager::Preprocess -epreprocess -l foo.im foo.c
9b1ec2b8 TC	211
	212	=head1 DESCRIPTION
	213
	214	This is a simple preprocessor that aims to reduce duplication of
	215	source code when implementing an algorithm both for 8-bit samples and
	216	double samples in Imager.
	217
5715f7c3 TC	218	Imager's C<Makefile.PL> currently scans the F<MANIFEST> for F<.im>
5715f7c3 TC	219	files and adds Makefile files to convert these to F<.c> files.
9b1ec2b8 TC	220
	221	The beginning of a sample-independent section of code is preceded by:
	222
	223	#code expression
	224
	225	where I<expression> should return true if processing should be done at
	226	8-bits/sample.
	227
	228	You can also use a #code block around a function definition to produce
	229	8-bit and double sample versions of a function. In this case #code
	230	has no expression and you will need to use IM_SUFFIX() to produce
	231	different function names.
	232
	233	The end of a sample-independent section of code is terminated by:
	234
	235	#/code
	236
	237	#code sections cannot be nested.
	238
	239	#/code without a starting #code is an error.
	240
	241	The following types and values are defined in a #code section:
	242
	243	=over
	244
	245	=item *
	246
5715f7c3	247	IM_GPIX(C<im>, C<x>, C<y>, C<&col>)
9b1ec2b8 TC	248
	249	=item *
	250
5715f7c3	251	IM_GLIN(C<im>, C<l>, C<r>, C<y>, C<colors>)
9b1ec2b8 TC	252
	253	=item *
	254
5715f7c3	255	IM_PPIX(C<im>, C<x>, C<y>, C<&col>)
9b1ec2b8 TC	256
	257	=item *
	258
5715f7c3	259	IM_PLIN(C<im>, C<x>, C<y>, C<colors>)
9b1ec2b8 TC	260
	261	=item *
	262
5715f7c3	263	IM_GSAMP(C<im>, C<l>, C<r>, C<y>, C<samples>, C<chans>, C<chan_count>)
9b1ec2b8 TC	264
	265	These correspond to the appropriate image function, eg. IM_GPIX()
	266	becomes i_gpix() or i_gpixf() as appropriate.
	267
	268	=item *
	269
5715f7c3	270	IM_ADAPT_COLORS(C<dest_channels>, C<src_channels>, C<colors>, C<count>)
9b1ec2b8 TC	271
	272	Call i_adapt_colors() or i_adapt_fcolors().
	273
	274	=item *
	275
5715f7c3	276	IM_FILL_COMBINE(C<fill>) - retrieve the combine function from a fill
9b1ec2b8 TC	277	object.
	278
	279	=item *
	280
5715f7c3	281	IM_FILL_FILLER(C<fill>) - retrieve the fill_with_* function from a fill
9b1ec2b8 TC	282	object.
	283
	284	=item *
	285
dcdafbb0 AK	286	IM_ABS(sample) - calculate the absolute value of an IM_WORK_T value.
	287
	288	=item *
	289
9b1ec2b8 TC	290	IM_SAMPLE_MAX - maximum value for a sample
	291
	292	=item *
	293
	294	IM_SAMPLE_MAX2 - maximum value for a sample, squared
	295
	296	=item *
	297
	298	IM_SAMPLE_T - type of a sample (i_sample_t or i_fsample_t)
	299
	300	=item *
	301
	302	IM_COLOR - color type, either i_color or i_fcolor.
	303
	304	=item *
	305
	306	IM_WORK_T - working sample type, either int or double.
	307
	308	=item *
	309
	310	IM_Sf - format string for the sample type, C<"%d"> or C<"%f">.
	311
	312	=item *
	313
	314	IM_Wf - format string for the work type, C<"%d"> or C<"%f">.
	315
	316	=item *
	317
	318	IM_SUFFIX(identifier) - adds _8 or _double onto the end of identifier.
	319
	320	=item *
	321
	322	IM_EIGHT_BIT - this is a macro defined only in 8-bit/sample code.
	323
	324	=back
	325
	326	Other types, functions and values may be added in the future.
	327
	328	=head1 AUTHOR
	329
5b480b14	330	Tony Cook <tonyc@cpan.org>
9b1ec2b8 TC	331
9b1ec2b8 TC	332	=cut