File Coverage

blib/lib/SMS/Ringtone/RTTTL/MIDI.pm

Criterion	Covered	Total	%
statement	38	41	92.6
branch	5	10	50.0
condition			n/a
subroutine	6	6	100.0
pod	1	1	100.0
total	50	58	86.2

package SMS::Ringtone::RTTTL::MIDI;
#### Package information ####
# Description and copyright:
#   See POD (i.e. perldoc SMS::Ringtone::RTTTL::MIDI).
####

use strict;
use Exporter;
use MIDI::Simple;
use SMS::Ringtone::RTTTL::MIDI;
use IO::String; # Add line "sub BINMODE {}" to this module.
our @ISA = qw(Exporter);
our @EXPORT = qw(rtttl_to_midi);
our $VERSION = '0.04';

1;

sub rtttl_to_midi {
 my $parser = shift; # SMS::Ringtone::RTTTL::Parser object
 my $patch = shift; # Instrument
 unless(defined($patch)) {
  $patch = 1; # Piano
 }
 my $ms = MIDI::Simple->new_score();
 if (length($parser->get_part_name())) {
  $ms->track_name($parser->get_part_name());
 }
 $ms->patch_change(0,$patch-1); # Set instrument on channel 0.
 $ms->set_tempo(60000000  / $parser->get_bpm()); # Microseconds per quarter note
 $ms->noop('fff','c0'); # Set max volume on channel 0.
 foreach my $nref ($parser->get_notes()) {
  # Convert RTTTL duration to MIDI ticks.
  my $ticks = ($ms->Tempo() * 4)/$nref->[0];
  if ($nref->[3] == 1) {
   $ticks *= 1.5;
  }
  elsif ($nref->[3] == 2) {
   $ticks *= 1.75;
  }
  # Write notes
  if ($nref->[1] eq 'P') {
   $ms->r("d$ticks");
  }
  else {
   my $note = uc($nref->[1]);
   $note =~ s/#/s/go;
   $ms->n("d$ticks",$note . $nref->[2]);
  }
 }
 my $midi;
 local(*OUT);
 tie *OUT, 'IO::String', \$midi;
 $ms->write_score(\*OUT);
 close(OUT);
 return $midi;
}

__END__