# This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License version 3 or higher # as published by the Free Software Foundation. use IO::Socket; use Text::Balanced; 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' ); } } } # Define a Perl subroutine for sending messages to the SF server and waiting # for a response. # sub rfx_sendmsg { my $message = $_[0]; my $len = length ($message); if ($len > 65535) { &sig_error("ERROR: script is too long for one server request: $len > 65535"); }; # send script to GIMP my $header = pack( 'an', 'G', $len); syswrite( $sock, $_ ) for ($header, $message); # wait for response my $rin = ''; vec( $rin, fileno($sock), 1 ) = 1; select( $rin, undef, undef, undef ); # wait (forever) for response start select( undef, undef, undef, .1 ); # wait a bit for response to finish # increase wait if INVALID/INCOMPLETE RESPONSE occurs # response $len = sysread( $sock, $header, 4 ) or &sig_error("INVALID RESPONSE: empty response"); ( $len == 4 and $header =~ /^G/ ) or &sig_error("INVALID RESPONSE: bad header"); my $status; ($status, $len) = unpack( 'xCn', $header ); my $response; ( sysread( $sock, $response, $len ) == $len ) or &sig_error("INCOMPLETE RESPONSE: $response"); # exit if response is not "Success" if ( $status and $response =~ /^Error: Success\n/i ) { &sig_error("UNSUCCESSFUL EXECUTION: Script-fu error"); } $status; } # define a Script-fu utility function to save frames using the PNG or JPG # compression levels specified in 'gimprc'. # To specify a PNG compression level of 5, include the following line # in gimprc: # (rfx-png-compression "5") # If not specified then a default level of "3" is assumed. # "3" is a good choice for PNGs because higher levels double the write # times while only offering about 15% reduction in file size. # To specify a JPG compression level of 85, include the following line # in gimprc: # (rfx-jpg-compression "85") # If not specified then a default level of "93" is assumed. # NOTE: 'rfx-save-frame' DELETES the image. &rfx_sendmsg( qq{ (begin (define rfx-curtmpdir "$curtmpdir") (define rfx-imgext "$img_ext") (unless (defined? 'rfx-save-frame) (define rfx-png-compression (catch #f (gimp-gimprc-query "rfx-png-compression"))) (set! rfx-png-compression (if rfx-png-compression (string->number (car rfx-png-compression)) 3 )) (define rfx-jpg-compression (catch #f (gimp-gimprc-query "rfx-jpg-compression"))) (set! rfx-jpg-compression (if rfx-jpg-compression (string->number (car rfx-jpg-compression)) 93 )) (define (rfx-save-frame image basename) (let ((filename (string-append rfx-curtmpdir DIR-SEPARATOR basename)) (layer (car (gimp-image-get-active-layer image))) ) (if (string-ci=? rfx-imgext ".jpg") (begin (gimp-context-push) (gimp-context-set-background '(6 6 6)) (set! layer (car (gimp-image-flatten image))) (file-jpeg-save RUN-NONINTERACTIVE image layer filename filename (/ rfx-jpg-compression 100) 0 ; smoothing 1 ; optimize 1 ; progressive "" ; comment 0 ; subsmp (0-4) 1 ; baseline 0 ; restart 0 ;dct ) (gimp-context-pop) ) (begin (unless (zero? (car (gimp-image-base-type image))) (gimp-image-convert-rgb image) ) (file-png-save2 RUN-NONINTERACTIVE image layer filename filename FALSE ; interlace rfx-png-compression FALSE ; bkgd (car (gimp-drawable-has-alpha layer)) FALSE ; offs FALSE ; phys FALSE ; time TRUE ; comment FALSE ; svtrans ))) (gimp-image-delete image) )))) } );