RFX-GIMP

Artifact Content
Login

Artifact b7f534063fd6d4fafe541729a2d00a789f42e5af:


Script file generated from LiVES

<define>
|1.7
</define>

<name>
gap-edit
</name>

<version>
1
</version>

<author>
saulgoode|
</author>

<description>
Edit in GIMP-GAP|Importing from GAP|1|1|
</description>

<requires>
gimp
</requires>

<params>
message|Edit now in GAP, click OK only after you have finished.|bool|1|
</params>

<param_window>
</param_window>

<properties>
0x0001
</properties>

<language_code>
0xF0
</language_code>

<pre>
# reconnect to server

use IO::Socket;
use Text::Balanced;

$img_ext=".png"; # this is not set for trigger code.

if ($ENV{'RFXGIMP_PORT'}) {
  $rfx_port = $ENV{'RFXGIMP_PORT'};
  }
else {
  $rfx_port = 10008;
  }

$sock = new IO::Socket::INET ( PeerAddr => 'localhost',
                               PeerPort => $rfx_port,
                               Proto => 'tcp'
                               );
if ( not defined $sock ) {
  my $rfx_pid = fork();
  if (not defined $rfx_pid) {
    &sig_error("UNABLE TO EXECUTE GIMP: Not enough resources");
    }
  elsif ($rfx_pid == 0) {
    if ( -f $tmpdir . "rfxgimp.pid") {
      open(PIDFILE, $tmpdir . "rfxgimp.pid");
      # should probably do some sanity checking for the off chance that
      # the PID has been recycled or the system has rebooted (e.g, check
      # if process was executed with /usr/bin/perl. But for now...
      kill(15, -<PIDFILE>); # the negative PID means kill all children, too.
      close(PIDFILE);
      }
    setpgid($$,0); # change the pgroup to this forked process, rather than
                   # the original LiVES (so that we don't kill LiVES when
                   # this prgroup is killed).
    open(PIDFILE, ">" . $tmpdir . "rfxgimp.pid"); # overwrite old file
    print PIDFILE $$;
    close(PIDFILE);
    my $start_gimp = qq{ gimp -i -b "(plug-in-script-fu-server 1 $rfx_port \\\"\\\")" & };
    system ( $start_gimp ); # though started as separate process, GIMP now
                            # is part of this spawned child's pgroup, not the LiVES pgroup
    sleep(); # do nothing, forever
    &sig_error("GIMP killed by external process\n");
    }
  else {
    while (not defined $sock) {
      sleep (1);
      $sock = new IO::Socket::INET ( PeerAddr => 'localhost',
                                     PeerPort => $rfx_port,
                                     Proto => 'tcp'
                                     );
      }
    }
  }
</pre>

<loop>
&rfx_sendmsg( qq{
  (begin
    (let* ((basename (car (strbreakup (car (last (strbreakup "$in" DIR-SEPARATOR))) "$img_ext")))
           (input-file (string-append "$curtmpdir" "/gap-clip" DIR-SEPARATOR basename ".xcf"))
           (image (car (gimp-file-load RUN-NONINTERACTIVE input-file input-file)))
                   (layer (car (gimp-image-get-active-layer image))) )
      (rfx-save-frame image "$out") 
      )
    )
    }
  );

</loop>

<post>
use File::Path;
my $rfx_gap_dir = "./gap-clip";
#-- remove the GAP directory
if (-d $rfx_gap_dir) {
  rmtree($rfx_gap_dir);
  };
</post>

<onchange>
init|# This program is free software; you can redistribute it and/or modify
init|# it under the terms of the GNU General Public License version 3 or higher
init|# as published by the Free Software Foundation.
init|
init|# For gap-edit much of the setup that is typically performed
init|# in preloop is done in init. This is so that closing of the
init|# dialog can be used as the indicator that the user has
init|# completed his editing in GAP.
init|#
init|# Steps in overall process:
init|#  init: ensure RFX-GIMP daemon is running as per usual
init|#        make or clean out directory $curtmpdir/gap-clip
init|#        &mkname all frames in selection (guarantee they exist)
init|#        copy (using rfx-gimp server) selection as XCF to gap-clip
init|#        run gimp $first
init|#        display param window (message to press OK when done editing)
init|#  pre:  no op
init|#  loop: no op
init|#  post: backup all source frames (for UNDO)
init|#        convert (using rfx-gimp server) XCF frames to $img_ext in $in
init|#        delete XCF frames
init|
init|use IO::Socket;
init|use Text::Balanced;
init|
init|$img_ext=".png"; # this is not set for trigger code.
init|
init|if ($ENV{'RFXGIMP_PORT'}) {
init|  $rfx_port = $ENV{'RFXGIMP_PORT'};
init|  }
init|else {
init|  $rfx_port = 10008;
init|  }
init|
init|$sock = new IO::Socket::INET ( PeerAddr => 'localhost',
init|                               PeerPort => $rfx_port,
init|                               Proto => 'tcp'
init|                               );
init|if ( not defined $sock ) {
init|  my $rfx_pid = fork();
init|  if (not defined $rfx_pid) {
init|    &sig_error("UNABLE TO EXECUTE GIMP: Not enough resources");
init|    }
init|  elsif ($rfx_pid == 0) {
init|    if ( -f $tmpdir . "rfxgimp.pid") {
init|      open(PIDFILE, $tmpdir . "rfxgimp.pid");
init|      # should probably do some sanity checking for the off chance that
init|      # the PID has been recycled or the system has rebooted (e.g, check
init|      # if process was executed with /usr/bin/perl. But for now...
init|      kill(15, -<PIDFILE>); # the negative PID means kill all children, too.
init|      close(PIDFILE);
init|      }
init|    setpgid($$,0); # change the pgroup to this forked process, rather than
init|                   # the original LiVES (so that we don't kill LiVES when
init|                   # this prgroup is killed).
init|    open(PIDFILE, ">" . $tmpdir . "rfxgimp.pid"); # overwrite old file
init|    print PIDFILE $$;
init|    close(PIDFILE);
init|    my $start_gimp = qq{ gimp -i -b "(plug-in-script-fu-server 1 $rfx_port \\\"\\\")" & };
init|    system ( $start_gimp ); # though started as separate process, GIMP now
init|                            # is part of this spawned child's pgroup, not the LiVES pgroup
init|    sleep(); # do nothing, forever
init|    &sig_error("GIMP killed by external process\n");
init|    }
init|  else {
init|    while (not defined $sock) {
init|      sleep (1);
init|      $sock = new IO::Socket::INET ( PeerAddr => 'localhost',
init|                                     PeerPort => $rfx_port,
init|                                     Proto => 'tcp'
init|                                     );
init|      }
init|    }
init|  }
init|
init|# Define a Perl subroutine for sending messages to the SF server and waiting
init|# for a response.
init|#
init|sub rfx_sendmsg {
init|  my $message = $_[0];
init|  my $len = length ($message);
init|  if ($len > 65535) {
init|    &sig_error("ERROR: script is too long for one server request: $len > 65535");
init|    };
init|  # send script to GIMP
init|  my $header = pack( 'an', 'G', $len);
init|  syswrite( $sock, $_ ) for ($header, $message);
init|  # wait for response
init|  my $rin = '';
init|  vec( $rin, fileno($sock), 1 ) = 1;
init|  select( $rin,  undef, undef, undef );    # wait (forever) for response start
init|  select( undef, undef, undef, .1 );       # wait a bit for response to finish
init|                                           #  increase wait if INVALID/INCOMPLETE RESPONSE occurs
init|  # response
init|  $len = sysread( $sock, $header, 4 ) or &sig_error("INVALID RESPONSE: empty response");
init|  ( $len == 4 and $header =~ /^G/ ) or &sig_error("INVALID RESPONSE: bad header");
init|  my $status;
init|  ($status, $len) = unpack( 'xCn', $header );
init|  my $response;
init|  ( sysread( $sock, $response, $len ) == $len ) or &sig_error("INCOMPLETE RESPONSE: $response");
init|  # exit if response is not "Success"
init|  if ( $status and $response =~ /^Error: Success\n/i ) {
init|    &sig_error("UNSUCCESSFUL EXECUTION: Script-fu error");
init|    }
init|  $status;
init|  }
init|
init|# define a Script-fu utility function to save frames using the PNG or JPG
init|# compression levels specified in 'gimprc'.
init|# To specify a PNG compression level of 5, include the following line
init|# in gimprc:
init|#   (rfx-png-compression "5")
init|# If not specified then a default level of "3" is assumed.
init|# "3" is a good choice for PNGs because higher levels double the write
init|# times while only offering about 15% reduction in file size.
init|# To specify a JPG compression level of 85, include the following line
init|# in gimprc:
init|#   (rfx-jpg-compression "85")
init|# If not specified then a default level of "93" is assumed.
init|
init|# NOTE: 'rfx-save-frame' DELETES the image.
init|&rfx_sendmsg( qq{
init|  (begin
init|    (define rfx-curtmpdir "$curtmpdir")
init|    (define rfx-imgext "$img_ext")
init|    (unless (defined? 'rfx-save-frame)
init|      (define rfx-png-compression (catch #f (gimp-gimprc-query "rfx-png-compression")))
init|      (set! rfx-png-compression (if rfx-png-compression
init|                                  (string->number (car rfx-png-compression))
init|                                  3 ))
init|      (define rfx-jpg-compression (catch #f (gimp-gimprc-query "rfx-jpg-compression")))
init|      (set! rfx-jpg-compression (if rfx-jpg-compression
init|                                  (string->number (car rfx-jpg-compression))
init|                                  93 ))
init|      (define (rfx-save-frame image basename)
init|        (let ((filename (string-append rfx-curtmpdir DIR-SEPARATOR basename))
init|              (layer (car (gimp-image-get-active-layer image))) )
init|          (if (string-ci=? rfx-imgext ".jpg")
init|            (begin
init|              (gimp-context-push)
init|              (gimp-context-set-background '(6 6 6))
init|              (let loop ((layers (vector->list (cadr (gimp-image-get-layers image)))))
init|                (unless (null? layers)
init|                  (if (= (car layers) layer)
init|                    (gimp-drawable-set-visible layer TRUE)
init|                    (gimp-drawable-set-visible (car layers) FALSE) )
init|                  (loop (cdr layers)) ))
init|              (set! layer (car (gimp-image-flatten image)))
init|              (file-jpeg-save RUN-NONINTERACTIVE
init|                              image
init|                              layer
init|                              filename
init|                              filename
init|                              (/ rfx-jpg-compression 100)
init|                              0 ; smoothing
init|                              1 ; optimize
init|                              1 ; progressive
init|                              "" ; comment
init|                              0 ; subsmp (0-4)
init|                              1 ; baseline
init|                              0 ; restart
init|                              0 ;dct
init|                              )
init|              (gimp-context-pop) )
init|            (begin
init|              (unless (zero? (car (gimp-image-base-type image)))
init|                (gimp-image-convert-rgb image) )
init|              (file-png-save2 RUN-NONINTERACTIVE
init|                              image
init|                              layer
init|                              filename
init|                              filename
init|                              FALSE ; interlace
init|                              rfx-png-compression
init|                              FALSE ; bkgd
init|                              (car (gimp-drawable-has-alpha layer))
init|                              FALSE ; offs
init|                              FALSE ; phys
init|                              FALSE ; time
init|                              TRUE  ; comment
init|                              FALSE ; svtrans
init|                              )))
init|          (gimp-image-delete image) )))
init|    (define (make-progressor start delta . period)
init|      (let ((start start)
init|            (value start)
init|            (delta delta)
init|            (period (if (null? period)
init|                        #f
init|                        (car period)) ))
init|        (lambda ()
init|          (let ((temp value))
init|            (set! value (if (and period (>= (+ value delta) (+ start period)))
init|                          (- (+ value delta) period)
init|                          (+ value delta) ))
init|            temp ))))
init|    )
init|  }
init|  );
init|
init|$rfx_gap_dir = $curtmpdir . "/gap-clip";
init|if (-d $rfx_gap_dir) {
init|  &sig_error("Clip buffer already exists",
init|             "Perhaps clip is in use?",
init|             "Run GAP Cleanup utility before continuing");
init|  }
init|else {
init|  mkdir $rfx_gap_dir or &sig_error("Could not create directory", $rfx_gap_dir);
init|  };
init|for ($i = $start; $i <= $end; $i++) {
init|  $gap_frame=&mkname($i);
init|  &rfx_sendmsg( qq{
init|    (begin
init|      (let* ((input-file (string-append "$curtmpdir" DIR-SEPARATOR "$gap_frame" "$img_ext"))
init|             (image (car (gimp-file-load RUN-NONINTERACTIVE input-file input-file)))
init|             (layer (car (gimp-image-get-active-layer image)))
init|             (filename (string-append "$rfx_gap_dir" DIR-SEPARATOR "$gap_frame" ".xcf")) )
init|        (gimp-file-save RUN-NONINTERACTIVE image layer filename filename)
init|        (gimp-image-delete image)
init|        )
init|      )
init|    }
init|    );
init|  };
init|
init|system ("gimp " . $rfx_gap_dir . "/" . &mkname($start) . ".xcf &");
init|
</onchange>