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] = "escape(&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 (¶m_get_type($i) eq "colRGB24") { 316 $pname=¶m_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 (¶m_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 = "\"" . "escape($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 = ¶m_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 = ¶m_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 = ¶m_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