#
# ItemPitchUpOneTenth.pl
# Mike Lacey
#
 
use strict;
use warnings;
 
use Win32::Clipboard;
my $Clipboard = Win32::Clipboard();
 
# MediaItem* GetSelectedMediaItem(ReaProject* proj, int selitem)
# bool GetSetItemState(MediaItem* item, char* str, int maxlen)
sub extract_section($$$);
 
use constant CURR_PROJ => 0;
use constant FIRST_SEL => 0;
use constant MAXLEN => (16 * 1024);
use constant ACTION_NAME => "Increase Item Pitch by 1 Tenth of a Semitone";
use constant MSGBOX_OKONLY => 0;
 
my $it;
my ($bool, $chunk, $maxlen);
my ($before, $section, $after);
my @section_vals;
 
$it = RPR_GetSelectedMediaItem(CURR_PROJ,0);
($bool, undef, $chunk, undef) = RPR_GetSetItemState($it, "", MAXLEN);
($before, $section, $after) = extract_section($chunk, 'PLAYRATE', FIRST_SEL);
 
# The PLAYRATE section looks like this
# PLAYRATE 1.00000000000000 1 0.00000000000000 -65536
 
@section_vals = split(/\s/,$section);
# The third parameter $section_vals[3], $section_vals[0] is the section name,
#  holds the "Pitch Adjust" parameter, increase pitch by one tenth of
#  a semitone.
$section_vals[3] += 0.1;
$section_vals[3] = sprintf('%.14f', $section_vals[3]);
 
# hard code the section name here to make it more readable
$section = "PLAYRATE $section_vals[1] $section_vals[2] $section_vals[3] $section_vals[4]\n";
 
$chunk = $before . $section . $after;
 
# and update the item
($bool, undef, undef, undef) = RPR_GetSetItemState($it, $chunk, MAXLEN);
 
RPR_MB("Failed to update item, sorry", ACTION_NAME, MSGBOX_OKONLY) unless $bool;
($bool, undef, $chunk, undef) = RPR_GetSetItemState($it, "", MAXLEN);
$Clipboard -> Set($chunk);
 
exit(0);
 
# subroutines below here
sub extract_section($$$){ my($chunk, $name, $index) = @_;
 
my @chunk;                      # to hold $chunk split into lines
my $cline;                      # individual lines from @chunk
my $indent;                     # to keep track in a multiline section
my ($before, $section, $after); # return values
my $inner_state = 0;            # 0=before section, 1=in section, 2=after
my $multiline = 0;              # boolean, single line sections have no <
my $occurrence = 0;
 
    $multiline = 1 if $name =~ /^</;            # a multiline section?
 
    $before = $section = $after = '';           # just in case
 
    @chunk = split(/\n/,$chunk);                # populate @chunk
    foreach $cline (@chunk){                    # and loop through it
        if($inner_state == 0){                  # "before" section
            if($cline =~ /^\s*$name(\s|$)/){
                # correct section name - correct occurrence?
                if($occurrence == $index){      # Yes
                    $indent++;                  # keep track of indents
                    $inner_state = 1;           # might be multiline...
                    $section .= "$cline\n";     # build up return variable
                    $inner_state = 2            # done unless
                        unless $multiline;      # it's a multiline section
                } else {                        # No, wrong occurrence
                    $occurrence++;              # keep looking
                    last                        # unless already gone past it
                        if $occurrence > $index;
                }
            } else {
                # still before the section we're looking for
                $before .= "$cline\n";          # so build up return variable
            }
        } elsif($inner_state == 1){             # in a multiline section
            $section .= "$cline\n";             # so build up return variable
            $indent++ if $cline =~ /</;         # keep track of indents
            $indent-- if $cline =~ />/;         # keep track of indents
            $inner_state = 2 if $indent == 0;   # and get out if we're done
        } elsif($inner_state == 2){             # "after" section
            $after .= "$cline\n";               # so build up return variable
        }
    }
    return($before, $section, $after);
}