Script file generated from LiVES |1.7 gap-edit 1 saulgoode| Edit in GIMP-GAP|Importing from GAP|1|1| gimp message|Edit now in GAP, click OK only after you have finished.|bool|1| 0x0001 0xF0
# 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, -); # 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'
                                     );
      }
    }
  }
&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") ) ) } ); use File::Path; my $rfx_gap_dir = "./gap-clip"; #-- remove the GAP directory if (-d $rfx_gap_dir) { rmtree($rfx_gap_dir); }; 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, -); # 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|