Mostrando resultados del 1 al 3 de 3

Tema: Script Perl para añadir marcas de agua a tus fotos

  1. #1
    Fecha de Ingreso
    ene 2012
    Ubicación
    A un clic de ti...
    Mensajes
    8.019

    Predeterminado Script Perl para añadir marcas de agua a tus fotos



    Un tema recurrente en el foro es el de las marcas de agua. No soy muy fan de ellas, más que nada por que apenas publico mis fotos y dado a que muchas veces son versiones para web (como mucho a 1200x800 puntos), versiones demasiado pequeñas como para usarlas fuera de la red.

    Pero seguro que más de un Linuxero apurado encontrará ahora más fácil ponerle una marca de agua con este script Perl a todas sus fotos.

    Os dejo de muestra el resultado que obtendréis.



    Comentar que la foto de forma deliberada muestra una marca de agua inmensamente grande, se debe a que mi marca de agua mide 634x335 puntos y la foto en la cual la disolví mide 900x600, en fotos de 6 mpx se ve mucho más pequeña y discreta.

    Lo primero que necesitas es un fichero gráfico con tu marca de agua.
    Puedes hacer la marca de agua con tu programa favorito, en mi caso The Gimp, un tema importante es utilizar el menor número de colores, mejor sólo dos (blanco y negro), también es importante que el fondo sea transparente. El tamaño de la marca de agua debe estar en proporción con la foto, el script no reduce la foto, únicamente le colocará la marca de agua en el centro de la imagen.
    Una vez que tienes tu marca de agua con el fondo transparente, la exportas a un fichero con formato PNG. El formato PNG soporta fondos transparentes, el formato GIF también lo soporta pero no he probado GIF con este script.

    Ahora el script:
    Código:
    #!/usr/bin/perl
    #
    # Breve proceso que añade marcas de agua masivamente
    #
    # El script es lineal sin funciones adicionales salvo las estrictamente necesarias.
    #
    # Requerimientos:
    #    Perl 5.10 o posterior
    #    Módulo Time::HiRes
    #    Módulo Image::Magick
    #    ImageMagick 6.5 o posterior
    #
    # 20161125 por NerveNet
    #
    use strict;
    use Cwd;
    use Time::HiRes qw(gettimeofday);
    use Image::Magick;
    # Variables
    my $path=getcwd;    # Obtengo el directorio de trabajo
    my $k = 0;        # Un contador
    my @files;        # Contendrá la lista de ficheros a comprobar
    my $tinit = gettimeofday;
    # Constantes
    my $newquality = 95;
    my $HELPTEXT = "Sintaxis:\n\n$0\t--logo=filename_and_path | [--help] |\n\t\t[--opacity=integer(0-100)]\n\nThis script adds a watermark to any jpeg file in the current directory.\n\n";
    #
    my $opacity = 20;
    my $watermarkfile = '';
    # ARG
    if (@ARGV > 0) {
        foreach(@ARGV) {
            PARAMLOAD: {
                /^--help$/ && do {print $HELPTEXT; exit(0);};
                /^--logo=(.+)$/ && do {$watermarkfile = $1; last PARAMLOAD; };
                /^--opacity=([0-9]+)$/ && do {$opacity = $1; last PARAMLOAD; };
                print "Unknow or malformed parameter '".$_."'.\nPlease use --help to get more information.\n";
                exit(1);
            }
        }
        unless (-e $watermarkfile) {
            print "File '$watermarkfile' doesn't exist!\n";
            exit(2);
        }
    } else {
        print "Missing --logo parameter.\nPlease use --help to get more information.\n";
        exit(1);
    }
    # Obtengo los ficheros a comprobar y los ordeno
    opendir(DIR, $path);
    @files = grep { /\.[jJ][pP][gG]$/ } readdir (DIR);
    closedir(DIR);
    if (@files == 0) {
        print "En la ruta '$path' no se han encontrado ficheros jpg que tratar.\n";
        exit(1);
    }
    @files = sort (@files);
    # Proceso cada fichero
    foreach (@files) {
        if (-e $_) {
            my $oldpic = $_;
            my $newpic = $_;
            $newpic =~ s/[jJ][pP][gG]$//;
            $newpic = $newpic.'new.jpg';
            my $image = Image::Magick->new;
            my $imgwatermark = Image::Magick->new;
            $image->Read($oldpic);
            $imgwatermark->Read($watermarkfile);
            my ($cspace, $cols, $rows, $compr, $quality) = $image->Get('colorspace', 'columns', 'rows', 'compression', 'quality');
            $image->Composite(
                image => $imgwatermark,
                compose => 'dissolve',
                args => $opacity,
                gravity => 'center'
            );
            # Saving new image
            $image->Set(quality=>$newquality);
            my ($ncspace, $ncols, $nrows, $ncompr, $nquality) = $image->Get('colorspace', 'columns', 'rows', 'compression', 'quality');
            $image->Write($newpic);
            print "$oldpic ($cols x $rows: $cspace - $compr [$quality])-> $newpic ($ncols x $nrows: $ncspace - $ncompr [$nquality])\n";
            $k++;
        }
    }
    $tinit = gettimeofday - $tinit;
    print "$k JPEG files 'watermarked' in $tinit seconds.\n" if ($k);
    exit(0);
    El script lo guardas en un fichero de texto plano con extension .pl en tu carpeta ~/bin, recuerda otorgarle permisos de ejecución, recuerda también que necesitas comprobar que tengas instalado los módulo que indico en el script e ImageMagick 6.5 o posterior.

    Es recomendable guardar en el directorio que contiene el script la marca de agua en formato PNG para no andarla buscando a todas horas.

    Para ejecutar el script en cualquier carpeta, suponiendo que se llame watermark.pl:
    watermark.pl --logo=/home/usuario/bin/marcagua.png --opacity=20

    Esto usará el fichero /home/usuario/bin/marcagua.png como marca de agua con una opacidad del 20% sobre todas las imágenes JPEG que encuentre en la carpeta en la que estés en ese momento.

    El script tratara todos los ficheros JPG de la carpeta actual, les pondrá la marca de agua y grabará el resultado en un fichero con el mismo nombre sin extensión .jpg pero acabado en .new.jpg.

    Si tienes una foto llamada por ejemplo fulano.jpg esta no se tocará pero el resultado será otro fichero llamado fulano.new.jpg

    Bueno, espero que lo disfrutéis.

    P.D. El script puede hacerse funcionar bajo MacOS X y Windows, a ver si os animáis...
    Clic, clic, clic...

  2. #2
    Fecha de Ingreso
    ene 2012
    Ubicación
    A un clic de ti...
    Mensajes
    8.019

    Predeterminado Mejora al script

    Colocar la marca de agua en la imagen
    He añadido la posibilidad de indicar más o menos donde queremos colocar la marca de agua.

    Esto se consigue con el parámetros --gravity (gravedad), pegará la marca de agua al área que le indiquemos, este tiene las siguientes opciones:
    • northwest -> Noreste o arriba a la izquierda
    • north -> Norte o arriba centrado
    • northeast -> Noroeste o arriba a la derecha
    • west -> Oeste o a la izquierda centrado
    • center -> Centrado
    • east -> Este o a la derecha centrado
    • southwest -> Suroeste o abajo a la izquierda
    • south -> Sur o abajo centrado
    • southeast -> Sureste o abajo a la derecha


    Por ejemplo, si queremos pegar una marca de agua contenida en el fichero marcagua.png abajo a a la derecha con una opacidad del 40% el comando tendría el siguiente aspecto:
    watermark.pl --logo=/home/usuario/bin/marcagua.png --opacity=40 --gravity=southeast

    Cabe decir que para que la marca de agua quede bien se debe dejar un espacio en blanco (con fondo transparente) al rededor de la misma, en caso contrario quedará pegada a los bordes de la imagen y el efecto no quedará tan bien.

    Llenar la imagen con la marca de agua
    Por último he incluido la opción de llenar la imagen con la marca de agua mediante la opción --tile, os pongo un ejemplo como el anterior:
    watermark.pl --logo=/home/usuario/bin/marcagua.png --opacity=40 --tile


    Si se usa conjuntamente --gravity con --tile prevalecerá el --tile y no se aplicará --gravity.

    El script Perl con las modificaciones que acabo de mencionar:
    Código:
    #!/usr/bin/perl
    #
    # Breve proceso que añade marcas de agua masivamente
    #
    # El script es lineal sin funciones adicionales salvo las estrictamente necesarias.
    #
    # Requerimientos:
    #    Perl 5.10 o posterior
    #    Módulo Time::HiRes
    #    Módulo Image::Magick
    #    ImageMagick 6.5 o posterior
    #
    # 20161125-20161127 por NerveNet
    #
    use strict;
    use Cwd;
    use Time::HiRes qw(gettimeofday);
    use Image::Magick;
    # Variables
    my $path=getcwd;    # Obtengo el directorio de trabajo
    my $k = 0;        # Un contador
    my @files;        # Contendrá la lista de ficheros a comprobar
    my $tinit = gettimeofday;
    # Constantes
    my $newquality = 95;
    my $HELPTEXT = "Sintaxis:\n\n$0\t--logo=filename_and_path | [--help] |\n\t\t[--opacity=integer(0-100)] | [--tile] |\n\t\t[--gravity=northwest|north|northeast|west|center|east|southwest|south|southeast]\n\nThis script adds a watermark to any jpeg file in the current directory.\n\n";
    #
    my $watermarkfile = '';
    my $opacity = 20;
    my $gravity = 'center';
    my $tile = 1;    # if set to 0 watermark will fill the whole picture tiled, if set to 1 gravity will be used instead.
    # ARG
    if (@ARGV > 0) {
        foreach(@ARGV) {
            PARAMLOAD: {
                /^--help$/ && do {print $HELPTEXT; exit(0);};
                /^--logo=(.+)$/ && do {$watermarkfile = $1; last PARAMLOAD; };
                /^--opacity=([0-9]+)$/ && do {$opacity = $1; last PARAMLOAD; };
                /^--gravity=(northwest|north|northeast|west|center|east|southwest|south|southeast)$/ && do {$gravity = $1; last PARAMLOAD; };
                /^--tile$/ && do {$tile = 0; last PARAMLOAD; };
                print "Unknow or malformed parameter '".$_."'.\nPlease use --help to get more information.\n";
                exit(1);
            }
        }
        unless (-e $watermarkfile) {
            print "File '$watermarkfile' doesn't exist!\n";
            exit(2);
        }
    } else {
        print "Missing --logo parameter.\nPlease use --help to get more information.\n";
        exit(1);
    }
    # Obtengo los ficheros a comprobar y los ordeno
    opendir(DIR, $path);
    @files = grep { /\.[jJ][pP][gG]$/ } readdir (DIR);
    closedir(DIR);
    if (@files == 0) {
        print "En la ruta '$path' no se han encontrado ficheros jpg que tratar.\n";
        exit(1);
    }
    @files = sort (@files);
    # Proceso cada fichero
    foreach (@files) {
        if (-e $_) {
            my $oldpic = $_;
            my $newpic = $_;
            $newpic =~ s/[jJ][pP][gG]$//;
            $newpic = $newpic.'new.jpg';
            my $image = Image::Magick->new;
            my $imgwatermark = Image::Magick->new;
            $image->Read($oldpic);
            $imgwatermark->Read($watermarkfile);
            my ($cspace, $cols, $rows, $compr, $quality) = $image->Get('colorspace', 'columns', 'rows', 'compression', 'quality');
            if ($tile) {
                $image->Composite(
                    image => $imgwatermark,
                    compose => 'dissolve',
                    args => $opacity,
                    gravity => $gravity
                );
            } else {
                $image->Composite(
                    image => $imgwatermark,
                    compose => 'dissolve',
                    args => $opacity,
                    tile => 'true'
                );
            }
            # Saving new image
            $image->Set(quality=>$newquality);
            my ($ncspace, $ncols, $nrows, $ncompr, $nquality) = $image->Get('colorspace', 'columns', 'rows', 'compression', 'quality');
            $image->Write($newpic);
            print "$oldpic ($cols x $rows: $cspace - $compr [$quality])-> $newpic ($ncols x $nrows: $ncspace - $ncompr [$nquality])\n";
            $k++;
        }
    }
    $tinit = gettimeofday - $tinit;
    print "$k JPEG files 'watermarked' in $tinit seconds.\n" if ($k);
    exit(0);
    Color de la marca de agua
    Hay fotos donde no queda bien que el color principal de la marca de agua sea el negro quedando mejor que sea blanco, os dejo un ejemplo de la misma foto pero con dos marcas de agua con colores distintos (blanco y negro respectivamente):



    La marca de agua de la derecha tenía como color principal el negro y la de la izquierda el blanco.
    Última edición por NerveNet; 27/11/16 a las 16:40:53 Razón: Ampliada información
    Clic, clic, clic...

  3. #3
    Fecha de Ingreso
    ene 2012
    Ubicación
    A un clic de ti...
    Mensajes
    8.019

    Predeterminado San saru - Los tres monos

    Ejemplo de uso con marca de agua con color de primer plano blanco aplicada a una foto de color, he intentado dejarlo muy discreto.


    Canon EOS 5D + Canon EF 50mm f/2.5 Compact Macro + Canon LifeSize Converter (@70mm, M, f/11, 1/40s, ISO 1600)

    Resultado obtenido de ejecutar el siguiente comando:
    watermark.pl --logo=watermark_white.png --gravity=southeast --opacity=10
    Clic, clic, clic...

Marcadores

Normas de Publicación

  • No puedes crear nuevos temas
  • No puedes responder temas
  • No puedes subir archivos adjuntos
  • No puedes editar tus mensajes
  •