ItemPitchUpOneTenth.pl
From CockosWiki
(Difference between revisions)
Line 1: | Line 1: | ||
- | < | + | =ItemPitchUpOneTenth.pl= |
+ | <source lang=perl> | ||
# | # | ||
# ItemPitchUpOneTenth.pl | # ItemPitchUpOneTenth.pl | ||
Line 100: | Line 101: | ||
return($before, $section, $after); | return($before, $section, $after); | ||
} | } | ||
- | </ | + | </source> |
Revision as of 12:58, 29 January 2010
ItemPitchUpOneTenth.pl
# # 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); }