1#!/usr/local/bin/perl
2
3# build-lives-rfx-plugin - Copyright G. Finch (salsaman) 2005 - 2019
4# Released under the LGPL 3 or later - see file COPYING.LGPL or www.gnu.org for details
5
6#usage : build-lives-rfx-plugin <script_file> <output_directory>
7# if <output_directory> is omitted, plugins will be generated in /tmp
8
9# if <script_file> == "-get" then the commandline parameters are interpreted as:
10# build-lives-rfx-plugin -get <section> <file>
11# and we then print the contents of section on stdout
12
13## Note: very little (if any) error checking is performed, although <define> and version must be present.
14
15########################################################
16# this will auto-generate a LiVES-Perl plugin from the info in $file
17
18my $USE_STRICT = 1;
19if ($USE_STRICT) {
20    use strict;
21}
22
23my $USE_WARNINGS = 1;
24if ($USE_WARNINGS) {
25    use warnings;
26}
27
28my $builder_version = "3.2.0";
29my $rfx_version = "1.8.3";
30my ($section, $file);
31
32if ($ARGV[0] eq "-get") {
33    $section = $ARGV[1];
34    $file = $ARGV[2];
35    my @result = &rc_read($section, $file);
36    foreach (@result) {
37	print STDOUT "$_\n";
38    }
39    exit 0;
40}
41
42$file = $ARGV[0];
43
44my $define = (&rc_read("define", $file))[0];
45if ($define eq "") {
46    print STDERR "Error  - <define> section missing from script file.\n";
47    exit 5;
48}
49
50my $plversion = substr($define, 1);
51my $plhversion = &make_ver_hash($plversion);
52
53unless ($plhversion <= &make_ver_hash($rfx_version)) {
54    print STDERR "\n\nError:  - Invalid script RFX version $version, this builder supports up to $rfx_version\n";
55    exit 4;
56}
57
58my $delim = substr($define, 0, 1);
59my $delimit = $delim;
60if ($delim =~ /^[\^\$\.\*\+\?\|\(\)\[\]\{\}\\]+/) {
61    $delim = "\\" . $delim;
62}
63
64my $plugin_name = (&rc_read("name", $file))[0];
65my $is_scrap = 0;
66
67if ($plugin_name =~ /^rfx\.[0-9]{5,}$/) {
68    $is_scrap = 1;
69}
70
71my $author_name ="";
72
73if (!$is_scrap) {
74    $author_name = (&rc_read("author", $file))[0];
75}
76
77my $lang_code = (&rc_read("language_code", $file))[0];
78my $plugin_version ="";
79my $description = "";
80my @requires = ();
81
82if (!$is_scrap) {
83    $plugin_version = (&rc_read("version", $file))[0];
84    $description = (&rc_read("description", $file))[0];
85    @requires=&rc_read("requires", $file);
86}
87
88my @params = &rc_read("params", $file);
89my @param_window = &rc_read("param_window", $file);
90
91my $properties = "0";
92my @pre = ();
93my @loop = ();
94my @post = ();
95
96if (!$is_scrap) {
97    $properties = (&rc_read("properties", $file))[0];
98    @pre = &rc_read("pre", $file);
99    @loop = &rc_read("loop", $file);
100    @post = &rc_read("post", $file);
101}
102
103my @onchange = &rc_read("onchange", $file);
104
105if (@pre || @loop || @post || @onchange) {
106    unless ($lang_code eq "240" || hex($lang_code) == 240) {
107	print STDERR "Error:  - Invalid language code for this builder !\n";
108	exit 3;
109    }
110}
111
112$properties = hex($properties) | 0x8000; # mark as built with build-plugin
113
114my $min_frames = 0;
115my $in_channels = 0;
116
117if (!$is_scrap) {
118    $min_frames = (split(/$delim/, $description))[2];
119    $in_channels = (split(/$delim/, $description))[3];
120
121    if ($min_frames == -1) {
122	$is_util = 1;
123    }
124    else {
125	$is_util = 0;
126    }
127}
128
129if (!$is_scrap && $in_channels == 0 && ($properties & 0x0004)) {
130    #batch mode generator
131    $is_batch_gen = 1;
132}
133else {
134    $is_batch_gen = 0;
135}
136
137## TODO: this is an ugly hack and needs to be removed
138if ($in_channels > 0) {
139    push(@requires, "convert");
140}
141
142#########################################################
143
144# generate into /tmp
145# LiVES will call this to generate in plugins/effects/rendered/test
146
147if (!defined($ARGV[1])) {
148    if ($^O eq "MSWin32") {
149	$prefix_dir = "C:\\";
150    } else {
151	$prefix_dir = "/tmp";
152    }
153}
154else {
155    $prefix_dir = $ARGV[1];
156}
157
158if ($^O eq "MSWin32") {
159    $plugin_file = "$prefix_dir\\$plugin_name";
160}
161else {
162    $plugin_file = "$prefix_dir/$plugin_name";
163}
164
165if (defined($DEBUG)) {
166    print STDERR "Creating plugin file $plugin_file\n";
167}
168
169########################################################
170
171open OUT, ">", "$plugin_file";
172
173print OUT "#!/usr/local/bin/perl\n\n";
174if (!$is_scrap) {
175    print OUT "#######################################################################\n";
176    print OUT "# LiVES $plugin_name plugin, version $plugin_version\n";
177    print OUT "# Compiled with Builder version $builder_version\n";
178    print OUT "# autogenerated from script by $author_name\n\n";
179    print OUT "# rendered plugins should accept:\n";
180    print OUT "# <plugin_name> version (return <plugin_name> version <version>)\n";
181    print OUT "# <plugin_name> get_define\n";
182    print OUT "# <plugin_name> get_capabilities\n";
183    print OUT "# <plugin_name> get_description (e.g. \"Edge detect|Edge detecting|1|1|\")\n";
184    print OUT "# <plugin_name> clear (clean up any plugin generated temp files)\n";
185    print OUT "# and optionally any of: \n";
186    print OUT "# <plugin_name> get_parameters\n";
187    print OUT "# <plugin_name> get_param_window\n";
188    print OUT "# <plugin_name> get_onchange\n";
189    print OUT "# <plugin_name> onchange_<when> (for any triggers, e.g. onchange_init)\n";
190    print OUT "#\n";
191    print OUT "# they must accept:\n";
192    print OUT "# <plugin_name> process <parameters>\n\n";
193    print OUT "# You should not skip any frames, if a frame is not changed you must do:\n";
194    print OUT "# `cp \$in \$out`\n";
195    print OUT "#\n";
196    print OUT "# for *non-Perl* plugins, LiVES will call:\n";
197    print OUT "# <plugin_name> process [<in2_prefix> [<in_prefix>]] <out_prefix> <out_ext> <start> <end>\n";
198    print OUT "#  <width> <height> <img_ext> <fps> [<img2_ext> <start2> <handle2>]  <parameters>\n";
199    print OUT "# you should create all output frames \$out_prefix%08d\$out_ext in numerical \n";
200    print OUT "# from start to end inclusive,\n";
201    print OUT "# using \$in_prefix%08d\$in_ext and \$in2_prefix%08d\$img2_ext as applicable.\n";
202    print OUT "# in / out images are in current dir, In2 images can be located in ../handle2 and numbered from $start2\n";
203    print OUT "# Each time calling sig_progress (see smogrify) - writes current frame number to \n";
204    print OUT "# <dir>/.status\n";
205    print OUT "# and checking for pause (test for a file of that name in current dir - if present just sleep until deleted)\n";
206    print OUT "#\n";
207    print OUT "# Any errors - \n";
208    print OUT "# write \"error|msg1|msg2|msg3|\" to .status\n";
209    print OUT "# msgn must not contain \"\\n\", but can be omitted\n\n";
210    print OUT "# after processing, you should leave no gaps in out frames, you should not resize\n";
211    print OUT "# or change the palette from RGB24 (LiVES will check and autocorrect this soon)\n\n";
212    print OUT "# Also you must implement your own: &sig_error and &sig_progress\n\n\n";
213    print OUT "#######################################################################\n\n";
214}
215
216print OUT "use POSIX;\n";
217print OUT "setlocale(LC_NUMERIC, \"C\");\n\n";
218
219print OUT "my \$command = \$ARGV[0];\n\n";
220if (!$is_scrap) {
221    print OUT "if (\$command eq \"get_capabilities\") {\n";
222    print OUT "    # capabilities is a bitmap field\n";
223    print OUT "    # 0x0001 == slow (hint to GUI)\n";
224    print OUT "    # 0x0002 == may resize (all frames to $width x $height)\n";
225    print OUT "    # 0x0004 == block mode generator\n";
226    print OUT "    # 0x8000 == reserved\n";
227    print OUT "    print \"$properties\\n\";\n";
228    print OUT "    exit 0;\n";
229    print OUT "}\n\n";
230}
231
232print OUT "if (\$command eq \"version\") {\n";
233print OUT "    print \"$plugin_name version $plugin_version : builder version $builder_version\\n\";\n";
234print OUT "    exit 0;\n";
235print OUT "}\n\n";
236
237print OUT "if (\$command eq \"get_define\") {\n";
238print OUT "    print \"$delimit$plversion\\n\";\n";
239print OUT "    exit 0;\n";
240print OUT "}\n\n";
241
242if (!$is_scrap) {
243    print OUT "if (\$command eq \"get_description\") {\n";
244    print OUT "    #format here is \"Menu entry|Action description|min_frames|number_of_in_channels|\"\n";
245    print OUT "    # min_frames == -1 indicates a special \"no processing\" effect. This allows more\n";
246    print OUT "    #general parameter windows which are not really effects (e.g. frame_calculator)\n";
247    print OUT "    print \"$description\\n\";\n";
248    print OUT "    exit 0;\n";
249    print OUT "}\n\n\n";
250}
251
252print OUT "if (\$command eq \"get_parameters\") {\n";
253print OUT "    # \"name|label|type|other fields...\"\n";
254print OUT "    # eg. print \"radius|_radius|num0|1|1|100|\";\n";
255print OUT "    # types can be numx, colRGB24, bool, string or string_list\n";
256
257foreach (@params) {
258    unless ($_ eq "") {
259	@bits = split(/$delim/);
260	# note: ARGV[0] == "process"
261	if ($bits[2] eq "string") {
262	    $bits[3] = &quotescape(&escape($bits[3]));
263	}
264	print OUT "    print \"" . join($delimit, @bits) . "$delimit\\n\";\n";
265    }
266}
267
268print OUT "    exit 0;\n";
269print OUT "}\n\n";
270print OUT "if (\$command eq \"get_param_window\") {\n";
271
272foreach (@param_window) {
273    unless ($_ eq "") {
274	$_ =~ s/\"/\\\"/g;
275	print OUT "    print \"$_$delimit\\n\";\n";
276    }
277}
278
279print OUT "    exit 0;\n";
280print OUT "}\n\n";
281
282print OUT "if (\$command eq \"get_onchange\") {\n";
283if (@onchange) {
284    &gen_onchange(0);
285}
286print OUT "    exit 0;\n";
287print OUT "}\n\n";
288
289if (!$is_scrap) {
290    print OUT "#######################################################\n\n";
291    print OUT "if (\$command eq \"process\") {\n";
292    print OUT "    # in case of error, you should do:\n";
293    print OUT "    # &sig_error(\"msg1\", \"msg2\", \"msg3\", \"msg4\"); [ msg's are optional, but must not\n";
294    print OUT "    # contain newlines (\\n) ]\n\n";
295
296    if (@requires) {
297	&gen_requires(0);
298    }
299}
300
301if (!$is_scrap) {
302    if (@params) {
303	print OUT "\n###### handle parameters #############\n";
304	print OUT "# autogenerated from get_parameters\n\n";
305
306	&gen_get_params;
307	if (!$is_scrap) {
308	    &gen_param_checks;
309	}
310    }
311
312    my $i = 0;
313    foreach my $param (@params) {
314	unless ($param eq "") {
315	    if (&param_get_type($i) eq "colRGB24") {
316		$pname=&param_get_name($i);
317		print OUT "    \$p$i = int(\$p$i);\n";
318		print OUT "    if (\$p$i > 0xFFFFFF || \$p$i < 0) {\n";
319		print OUT "        &sig_error(\"Invalid colour for $pname.\");\n";
320		print OUT "        exit 1;\n";
321		print OUT "    }\n";
322		print OUT "    \$p$i" . "_red = int(\$p$i / 65536);\n";
323		print OUT "    \$p$i" . " -= \$p$i" . "_red * 65536;\n";
324		print OUT "    \$p$i" . "_green = int(\$p$i / 256);\n";
325		print OUT "    \$p$i" . " -= \$p$i" . "_green * 256;\n";
326		print OUT "    \$p$i" . "_blue = \$p$i;\n";
327	    }
328	    $i++;
329	}
330    }
331
332    print OUT "    if (\$img_ext eq \".png\") {\n";
333    print OUT "        \$img_prefix = \"PNG32:\";\n";
334    print OUT "    } else {\n";
335    print OUT "        \$img_prefix = \"\";\n";
336    print OUT "    }\n\n";
337
338    print OUT "    if (\$out_ext eq \".png\") {\n";
339    print OUT "        \$out_prefix = \"PNG32:\";\n";
340    print OUT "    } else {\n";
341    print OUT "        \$out_prefix=\"\";\n";
342    print OUT "    }\n\n";
343
344   if ($in_channels == 2) {
345	print OUT "    unless (defined(\$img_ext2)) {\n";
346	print OUT "        \$img_ext2 = \$img_ext;\n";
347	print OUT "    }\n\n";
348
349	print OUT "    if (\$img_ext2 eq \".png\") {\n";
350	print OUT "        \$img_prefix2 = \"PNG32:\";\n";
351	print OUT "    } else {\n";
352	print OUT "        \$img_prefix2 = \"\";\n";
353	print OUT "    }\n\n";
354    }
355
356    if (@pre) {
357	&gen_array(4, @pre);
358    }
359
360    print OUT "\n";
361    print OUT "    if (\$start == 0) {\$start = 1;}\n";
362    print OUT "\n";
363
364    unless ($is_batch_gen) {
365	print OUT "\n################# loop through frames #################\n";
366
367	if ($in_channels==2) {
368	    print OUT "    \$frame2 = \$start2;\n";
369	    print OUT "    if (!(\$img_ext2 eq \$img_ext) && &location(\"convert\") eq \"\") {\n";
370	    print OUT "        &sig_error(\"'convert' is required by this plugin.\", \"Please install imagemagick and try again.\");\n";
371	    print OUT "        exit 1;\n";
372	    print OUT "    }\n\n";
373	}
374
375	print OUT "    for (\$frame = \$start; \$frame <= \$end; \$frame++) {\n";
376	print OUT "        # sig progress will update the progress bar from \$start->\$end\n";
377	print OUT "        \$name = &mkname(\$frame);\n";
378
379	unless ($in_channels == 0) {
380	    print OUT "        \$in = \"\$name\$img_ext\";\n\n";
381	    print OUT "        if (!defined(\$end) || \$end == 0) {\n";
382	    print OUT "            print STDERR \"WARNING: generator plugin did not set \$end !\";\n";
383	    print OUT "            &sig_error(\"Generator plugin did not set \$end.\");\n";
384	    print OUT "        }\n";
385	}
386
387	if ($in_channels == 2) {
388	    print OUT "        \$name2 = &mkname(\$frame2);\n";
389	    print OUT "        \$in2 = \"\$clipboard/\$name2\$img_ext2\";\n";
390	    print OUT "        unless (-f \$in2) {\n";
391	    print OUT "            # end of clipboard reached, loop back to start\n";
392	    print OUT "            \$frame2 = \$start2;\n";
393	    print OUT "            \$name2 = &mkname(\$frame2);\n";
394	    print OUT "            \$in2 = \"\$clipboard/\$name2\$img_ext2\";\n";
395	    print OUT "        }\n";
396
397	    print OUT "        unless (\$img_ext2 eq \$img_ext) {\n";
398	    print OUT "            system(\"\$convert_command \$img_prefix2\\\"\$in2\\\" \$img_prefix\\\"\$clipboard/\$name2\$img_ext\\\"\");\n";
399	    print OUT "            \$img_prefix2 = \$img_prefix;\n";
400	    print OUT "        }\n";
401	}
402
403	print OUT "        \$out = \"\$name\$out_ext\";\n\n";
404
405	if ($in_channels > 0) {
406	    print OUT "        # wait for front end to create $in\n";
407	    print OUT "        while (! -s \$in) {\n";
408	    print OUT "            sleep 1;\n";
409	    print OUT "        }\n\n";
410	    print OUT "        `flock \$in true`;\n";
411	}
412
413	if ($in_channels > 1) {
414	    print OUT "        # wait for front end to create $in2\n";
415	    print OUT "        while (! -s \$in2) {\n";
416	    print OUT "            sleep 1;\n";
417	    print OUT "        }\n\n";
418	    print OUT "        `flock \$in2 true`;\n";
419	}
420    }
421
422    print OUT "##################### the all-important bit #######################\n\n";
423
424    &gen_array(8, @loop);
425
426    print OUT "\n###################################################################\n";
427
428    unless ($is_batch_gen) {
429	if ($in_channels == 2) {
430	    print OUT "        unless (\$img_ext2 eq \$img_ext) {\n";
431	    print OUT "            unlink \$in2;\n";
432	    print OUT "        }\n";
433	    print OUT "        \$frame2++;\n";
434	}
435
436	print OUT "        for (my \$i = 0; \$i < 5; \$i++) {\n";
437	print OUT "            if (! -s \$out) {\n";
438	print OUT "                sleep 1;\n";
439	print OUT "            }\n";
440	print OUT "        }\n\n";
441	print OUT "        if (! -s \$out) {\n";
442	print OUT "            print STDERR \"Warning: effect plugin $plugin_name skipped frame \$frame !\\n\";\n";
443	print OUT "            return 1;\n";
444	print OUT "        }\n\n";
445
446	if ($in_channels==0) {
447	    print OUT "        &sig_progress(\$frame,  \$width,  \$height,  \$fps,  \$end);\n\n";
448	}
449	else {
450	    print OUT "        &sig_progress(\$frame);\n\n";
451	}
452
453	for ($i = 0; $i < @params; $i++) {
454	    unless ($params[$i] eq "") {
455		if (&param_get_type($i) eq "colRGB24") {
456		    # clamp RGB values
457		    print OUT "        if (\$p$i" . "_red > 255) {\n";
458		    print OUT "            \$p$i" . "_red = 255;\n";
459		    print OUT "        }\n";
460		    print OUT "        elsif (\$p$i" . "_red < 0) {\n";
461		    print OUT "            \$p$i" . "_red = 0;\n";
462		    print OUT "        }\n";
463		    print OUT "        if (\$p$i" . "_green > 255) {\n";
464		    print OUT "            \$p$i" . "_green = 255;\n";
465		    print OUT "        }\n";
466		    print OUT "        elsif (\$p$i" . "_green < 0) {\n";
467		    print OUT "            \$p$i" . "_green = 0;\n";
468		    print OUT "        }\n";
469		    print OUT "        if (\$p$i" . "_blue > 255) {\n";
470		    print OUT "            \$p$i" . "_blue = 255;\n";
471		    print OUT "        }\n";
472		    print OUT "        elsif (\$p$i" . "_blue < 0) {\n";
473		    print OUT "            \$p$i" . "_blue = 0;\n";
474		    print OUT "        }\n";
475		}}}
476	print OUT "        }\n";
477    }
478
479    print OUT "    return 1;\n";
480    print OUT "}\n\n\n";
481
482    print OUT "\n########## Post loop code ############\n";
483
484    print OUT "if (\$command eq \"clear\") {\n";
485
486    if (@post) {
487	print OUT "    \$start = \$ARGV[1];\n";
488	print OUT "    \$end = \$ARGV[2];\n";
489	print OUT "    \$img_ext = \$ARGV[3];\n\n";
490	&gen_array(4, @post);
491    }
492    print OUT "    exit 0;\n";
493    print OUT "}\n";
494}
495
496if (@onchange) {
497    print OUT "\n########## Triggers ############\n";
498    &gen_onchange(1);
499}
500
501close OUT;
502
503system ("chmod 755 \"$plugin_file\"");
504
505####################################3
506
507
508sub gen_requires {
509    my $type = shift;
510    print OUT "##### check requirements first #######\n";
511
512    foreach (@requires) {
513	unless ($_ eq "") {
514	    print OUT "    if (&location(\"$_\") eq \"\") {\n";
515	    if ($type == 0) {
516		print OUT "      &sig_error(\"You must install '$_' before you can use this effect.\");\n";
517	    }
518	    else {
519		print OUT "      print \"You must install '$_' before you can use this utility.\";\n";
520	    }
521	    print OUT "      exit 1;\n";
522	    print OUT "    }\n";
523	}
524    }
525}
526
527
528sub gen_get_params {
529    my $i = 0;
530    my (@bits, $type);
531    foreach (@params) {
532	unless ($_ eq "") {
533	    @bits=split (/$delim/, $_);
534	    # note: ARGV[0] == "process"
535	    $def = ($bits[3]);
536	    if ($bits[2] eq "string") {
537		$def = "\"" . &quotescape($def ). "\"";
538	    }
539	    print OUT "    unless (defined(\$ARGV[" . ($i+1 ) ."])) {\n";
540	    print OUT "      \$p$i = $def;\n";
541	    print OUT "    }\n";
542	    print OUT "    else {\n";
543	    print OUT "      \$p$i = \$ARGV[" . ($i+1) . "];\n";
544	    print OUT "    }\n";
545	    $i++;
546	}
547    }
548}
549
550
551sub gen_param_checks {
552# generate some errors if params are out of range
553# fix decimal places and booleans
554# TODO - check for valid colours
555    my ($pname, $min, $max, $type, $dp, @bits, $fix);
556    my $i = 0;
557    foreach (@params) {
558	unless ($_ eq "") {
559	    @bits = split(/$delim/);
560	    $type = $bits[2];
561	    if (substr($type, 0, 3) eq "num") {
562		$pname = $bits[0];
563		$min = $bits[4];
564		$max = $bits[5];
565		$dp = substr($type, 3);
566		$fix = 10 ** $dp;
567		if ($dp > 0) {
568		    $fix .= ".";
569		}
570		print OUT "    \$! = 0;\n";
571
572#use POSIX::strtod to account for locales LC_NUMERIC
573
574		print OUT "    if (\$p$i >= 0) {\n";
575		print OUT "        \$p$i = int(POSIX::strtod(\$p$i) * $fix + .5) / $fix;\n";
576		print OUT "    } else {\n";
577		print OUT "        \$p$i = int(POSIX::strtod(\$p$i) * $fix - .5) / $fix;\n";
578		print OUT "    }\n";
579		print OUT "    if (\$p$i < $min) {\n";
580		print OUT "       &sig_error(\"$pname must be >= $min\");\n";
581		print OUT "       exit 1;\n";
582		print OUT "    }\n";
583		print OUT "    if (\$p$i > $max) {\n";
584		print OUT "       &sig_error(\"$pname must be <= $max\");\n";
585		print OUT "       exit 1;\n";
586		print OUT "    }\n";
587	    }
588	    if ($type eq "bool") {
589		print OUT "    \$p$i = ~(~\$p$i);\n";
590	    }
591	    $i++;
592	}}
593}
594
595
596sub gen_array {
597    my ($nspaces, @array) = @_;
598    foreach (@array) {
599	print OUT " " x $nspaces . $_ . "\n";
600    }
601}
602
603
604sub rc_read {
605    # return an array value from script file
606    my ($key, $scriptfile) = @_;
607    my $string = "";
608    my (@result, $part);
609
610    unless (defined(open IN, "$scriptfile")) {
611	print STDERR "Error:  - Unable to read values from script file,  $scriptfile\n";
612	exit 2;
613    }
614    $part = 0;
615    while (<IN>) {
616	if ($_ =~ /(.*)(<\/$key>)/) {
617	    return @result;
618	}
619	if ($part == 1 || $_ =~ /(<$key>)(.*)/) {
620	    if ($part == 1) {
621		chomp($_);
622		$string = $_;
623		@result = (@result, $string);
624	    }
625	    else {
626		$part = 1;
627	    }}}
628    return @result;
629}
630
631
632sub gen_onchange {
633    my ($pass)=@_;
634    my ($i, $acount, $which, $code, $type);
635    my (%hash) = ();
636
637    foreach (@onchange) {
638	unless ($_ eq "") {
639	    $which = (split(/$delim/))[0];
640	    if ($which > @params || ($which > 0 && $params[$which - 1] eq "")) {
641		print  STDERR "Error:  - onchange value $which > num parameters.\n";
642		exit 1;
643	    }
644	    if ($pass == 0) {
645		if (!defined($hash{$which})) {
646		    print OUT "    print \"$which$delimit\\n\";\n";
647		    $hash{$which} = 1;
648		}
649	    }
650	    else {
651		$code = substr($_, length($which) + 1);
652		push(@{$hash{$which}},  $code);
653	    }}
654    }
655
656    if ($pass == 1) {
657	foreach $which (sort keys %hash) {
658	    print OUT "\nif (\$command eq \"onchange_$which\") {\n";
659
660	    if (@requires && $is_util && $which eq "init") {
661		# for utilities, we generate requires here, since there is no process
662		&gen_requires(1);
663	    }
664
665	    $acount = 1;
666	    for ($i = 0; $i < @params; $i++) {
667		unless ($params[$i] eq "") {
668		    $type = &param_get_type($i);
669		    if ($type eq "colRGB24") {
670			# with RGBA we would also have _alpha
671			print OUT "    \$p$i" . "_red = \@ARGV[" . $acount++ . "];\n";
672			print OUT "    \$p$i" . "_green = \@ARGV[" . $acount++ . "];\n";
673			print OUT "    \$p$i" . "_blue = \@ARGV[" . $acount++ . "];\n";
674		    }
675		    else {
676			print OUT "    \$p$i" . " = \@ARGV[" . $acount++ . "];\n";
677			unless ($type eq "bool" || $type eq "string" || $type eq "string_list") {
678			    print OUT "    \$p$i" . "_min = \@ARGV[" . $acount++ . "];\n";
679			    print OUT "    \$p$i" . "_max = \@ARGV[" . $acount++ . "];\n";
680			}}}}
681
682	    print OUT "    \$width = \@ARGV[" . $acount++ . "];\n";
683	    print OUT "    \$height = \@ARGV[" . $acount++ . "];\n";
684	    print OUT "    \$start = \@ARGV[" . $acount++ . "];\n";
685	    print OUT "    \$end = \@ARGV[" . $acount++ . "];\n";
686	    print OUT "    \$last = \@ARGV[" . $acount++ . "];\n";
687	    print OUT "    \$length = \$end - \$start + 1;\n";
688
689	    if ($in_channels == 2) {
690		print OUT "    \$width2 = \@ARGV[" . $acount++ . "];\n";
691		print OUT "    \$height2 = \@ARGV[" . $acount++ . "];\n";
692	    }
693	    print OUT "\n";
694
695	    foreach (@{$hash{$which}}) {
696		print OUT "    $_\n";
697	    }
698
699	    my ($has_params) = 0;
700	    for ($i = 0; $i < @params; $i++) {
701		unless ($params[$i] eq "") {
702		    $type = &param_get_type($i);
703		    if (!$has_params) {
704			&escquotes(@params);
705			print OUT "\n    print \"";
706			$has_params = 1;
707		    }
708		    if ($type eq "colRGB24") {
709			print OUT "\$p$i" . "_red ";
710			print OUT "\$p$i" . "_green ";
711			print OUT "\$p$i" . "_blue ";
712		    }
713		    else {
714			if ($type eq "string") {
715			    print OUT "\\\"\$p$i\\\" ";
716			}
717			else {
718			    print OUT "\$p$i ";
719			}
720			unless ($type eq "bool" || $type eq "string" || $type eq "string_list") {
721			    print OUT "\$p$i" . "_min ";
722			    print OUT "\$p$i" . "_max ";
723			}}}}
724
725	    if ($has_params) {
726		print OUT "\";\n";
727	    }
728	    print OUT "    exit 0;\n";
729	    print OUT "}\n";
730	}}
731}
732
733
734sub param_get_type {
735    my $i = shift;
736    (split(/$delim/, @params[$i]))[2];
737}
738
739
740sub param_get_name {
741    my $i = shift;
742    (split(/$delim/, @params[$i]))[0];
743}
744
745
746sub escape {
747    my $string = shift;
748    $string =~ s/\\/\\\\/g;
749    return $string;
750}
751
752
753sub quotescape {
754    my $string = shift;
755    $string =~ s/([\"\$\@])/\\$1/g;
756    return $string;
757}
758
759
760sub escquotes {
761    my @params = @_;
762    for ($i = 0; $i < @params; $i++) {
763	unless  ($params[$i] eq "") {
764	    my $type = &param_get_type($i);
765	    if ($type eq "string") {
766		print OUT "    \$p$i =~ s/\\\"/\\\\\\\"/g;\n";
767	    }}}
768}
769
770
771sub make_ver_hash {
772    # turn a version like
773    # a.b.c into an integer
774    # a * 1,000,000 plus b * 1,000 plus c
775    # eg. 1.4.6 becomes 10004006
776
777    my $string = shift;
778    if ($string eq "") {
779	return 0;
780    }
781    my ($ver_major, $ver_minor, $ver_micro) = split (/\./,  $string, 3);
782    my $version_hash = ($ver_major * 1000 + $ver_minor) * 1000;
783    $version_hash;
784}
785