The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

BPOSTLE / Panotools-Script-0.29 / bin / enblend-mask 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
—
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119

              
#!/usr/bin/perl
use strict;
use warnings;
use File::Temp qw/tempdir/;
use File::Spec;
my @parameters;
my @files;
my $tempdir = tempdir (CLEANUP => 1);
while (@ARGV)
{
    my $arg = shift @ARGV;
    if ($arg =~ /-o/)
    {
        push @parameters, $arg;
        push @parameters, shift @ARGV;
        next;
    }
    if ($arg =~ /\.[[:alnum:]]+$/i) {push @files, $arg}
    else {push @parameters, $arg}
}
my $index = 0;
for my $file (@files)
{
    $file = File::Spec->rel2abs ($file);
    my $tempfile = File::Spec->catfile ($tempdir, "$index.tif");
    my $mask = $file;
    $mask =~ s/\.[[:alnum:]]+$/_mask.tif/i;
    my $svg = $file;
    $svg =~ s/\.[[:alnum:]]+$/.svg/i;
    $file = $svg if (-e $svg);
    if (-e $mask)
    {
        print STDERR "Using mask $mask\n";
        my $mask_old = File::Spec->catfile ($tempdir, 'mask_old.tif');
        my $mask_new = File::Spec->catfile ($tempdir, 'mask_new.tif');
        # extract existing alpha mask
        system ('convert', $file, '-channel', 'matte', '-negate', '-separate', $mask_old);
        # merge existing mask with file mask to create new mask
        system ('composite', $mask_old, $mask, $mask, $mask_new);
        # insert new mask into existing image
        system ('composite', '-compose', 'CopyOpacity', $mask_new, $file, $tempfile);
        push @parameters, $tempfile;
    }
    elsif ($file !~ /\.tif$/i)
    {
        print STDERR "Converting $file to TIFF\n";
        # deal with imagemagick brokenness
        my $curdir = File::Spec->curdir ();
        $curdir = File::Spec->rel2abs ($curdir);
        my ($v, $d, $f) = File::Spec->splitpath ($file);
        my $basedir = File::Spec->catpath ($v, $d, '');
        chdir $basedir;
        system ('convert', '-background', 'transparent', $file, $tempfile);
        chdir $curdir;
        push @parameters, $tempfile;
    }
    else
    {
        push @parameters, $file;
    }
    $index++;
}
system ('enblend', @parameters);
__END__
=head1 NAME
enblend-mask - Wrapper around enblend for managing external masks
=head1 Synopsis
  enblend-mask [options] -o OUTPUT INPUTS
=head1 DESCRIPTION
Wrapper around enblend.  Usage is exactly the same as for enblend,
except that if files named '<prefix>_mask.tif' exist, they are
inserted as alpha masks before blending.
Some examples of valid image pairs:
  image0000.tif image0000_mask.tif
  foo.jpg foo_mask.tif
Note masks can be any bit depth, but must have no alpha channel.  Black
indicates areas to be ignored, any other colour indicates areas that may be
blended.
Note also that only masks need to be TIFF files, input images can be any
filetype supported by ImageMagick.
Requires enblend and ImageMagick.
L<http://www.bruno.postle.net/neatstuff/enblend-mask/>
L<http://enblend.sourceforge.net/>
=head1 License
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
=head1 See Also
L<perl>, L<Panotools::Script>
=head1 Author
October 2006, Bruno Postle <bruno AT postle.net>