Legacy ImageMagick Discussions Archive

Code: Select all

"C:\Program Files\ImageMagick-6.8.3-Q16\montage.exe" -quality 90 -define registry:temporary-path="D:\Temp" -define png:include-chunk=none -mode concatenate -tile 100x100 "G:\R-*.bmp" "D:\Temp\FINAL.png"

Code: Select all

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use File::Basename;
use Carp;
use POSIX;

sub fullyQuoted {
    my ($s) = @_;
    $s =~ s/'/'\\''/g;
    return "'$s'";
}

my @tmpFileList;

# any path passed to this method is recorded,
# and an attempt to unlink() it made at END time
sub deleteFileAtEnd {
    my ($f) = @_;
    push @tmpFileList, $f;
    return $f;
}

# takes a base and optional extension; the process ID
# and extension (if defined) are concatanated to the base
sub tmpFileName {
    my ( $base, $extension ) = @_;
    if ( defined($extension) ) {
        return $base . $$ . $extension;
    }
    else {
        return $base . $$;
    }
}

# wrapper that returns a fileName as per tmpFileName
# and also marks the file for eventual cleanup
sub tmpFileNameDeleteAtEnd {
    return deleteFileAtEnd( tmpFileName(@_) );
}

END {
    my $f;
    foreach $f (@tmpFileList) {
        if ( defined($f) && -e $f ) {
            unlink $f or croak "couldn't delete file $f:$!";
        }
    }
}

sub _backtick {
    my ( $cmd, $handler ) = @_;
    my $ret = `$cmd`;
    if($? == -1) {
        &$handler(
            sprintf( 'back tick : --%s-- could not be called', $cmd ) );
    }
    my $exit = ( $? >> 8 );
    if ( $exit != 0 ) {
        &$handler(
            sprintf( 'back tick : --%s-- failed, exit = %d', $cmd, $exit ) );
    }
    return $ret;
}

# execute like the `` operator, but catch, and deal
# with failures, by croak-ing
sub backtickdie {
    my ($cmd) = @_;
    _backtick(
        $cmd,
        sub {
            my ($msg) = @_;
            croak $msg;
        }
    );
}

# create a command that perform a LR concat of JPG files to pnm stdout 
sub lr {
    my ($files, $row_index) = @_;
    my $col_index = 0;
    my @ff;
    foreach my $f (@$files) {
	my $fifo_name = tmpFileNameDeleteAtEnd(sprintf("/tmp/f_%03d_%03d", $row_index, $col_index), "");
	mkfifo($fifo_name, 0666);
	# spawn a converter
	my $src = fullyQuoted($f);
	system("jpegtopnm $src > $fifo_name &");
	push @ff, $fifo_name;
	$col_index++;
    }
    my $row_name = tmpFileNameDeleteAtEnd(sprintf("/tmp/f_%03d", $row_index), "");
    mkfifo($row_name, 0666);
    my $src_list = join " ", @ff;
    system("pnmcat -lr $src_list > $row_name &");
    return $row_name;
}

sub tb {
    my ($tb) = @_;
    my $row_index = 0;
    my @ff;
    foreach my $r (@$tb) {
	push @ff, lr($r, $row_index++);
    }
    my $name = tmpFileNameDeleteAtEnd("/tmp/ff", "");
    mkfifo($name, 0666);
    my $src_list = join " ", @ff;
    system("pnmcat -tb $src_list > $name &");
    return $name;
}

sub stack_and_pump {
    my ($tb) = @_;
    my $src;
    if(scalar(@$tb) == 1) {
	$src = lr($tb->[0], 0);
    } else {
	$src = tb($tb);
    }
    my $in;
    open $in, "<", $src or die "cannot open $src";
    my $buf;
    while (read $in, $buf, 32 * 1024) {
	print STDOUT $buf;
    }
    close($in);
}

sub arg_parse {
    my ($argv) = @_;
    my @TB;
    my @LR;
    foreach my $f (@$argv) {
	if($f =~ /^br$/i) {
	    push @TB, [@LR];
	    @LR = ();
	} else {
	    push @LR, $f;
	}
    }
    if(scalar(@LR) > 0) {
	push @TB, [@LR];
    }
    stack_and_pump(\@TB);
}

unless(scalar(@ARGV) > 1) {
    die "usage $0 <file1> <file2> ['BR'] <file3> ... <filen> <output>";
}

# sort of like undice, but more pipe-lined

arg_parse(\@ARGV);