File Coverage

blib/lib/POE/Framework/MIDI/Conductor.pm

Criterion	Covered	Total	%
statement	616	631	97.6
branch	16	34	47.0
condition	3	9	33.3
subroutine	17	18	94.4
pod	0	14	0.0
total	652	706	92.3

# $Id: Conductor.pm,v 1.3 2004/12/11 16:24:23 root Exp $

package POE::Framework::MIDI::Conductor;

use strict;
use vars '$VERSION'; $VERSION = '0.02';

sub new {
    my ( $self, $class ) = ({}, shift);
    $self->{cfg} = shift or die "I need a config hashref to start the conductor.";
    bless( $self,  $class );
    $self->{bars} = {};
    return $self;
}

sub musician_names {
    my $self = shift;
    my $musicians = $self->{cfg}->{musicians} or die "no musicians defined in config";
    my $to_return;
    for (@$musicians) {
        push @$to_return, $_->{name};
    }
    return $to_return;
}

# register a bar/phrase in the internal datastructure
sub add_bar {
    my $self 			= shift;
    my $params 	= shift;
    die "Malformed add_bar data - " . Dumper($params) . "\n\n"
    	unless ($params->{musician_name} and $params->{barnum} and $params->{bar});
    die "$params->{bar} isn't a P:F:M:Bar object"
    	unless (ref($params->{bar}) =~ /POE::Framework::MIDI::Bar/);
    $self->{bars}->{$params->{musician_name}}->{$params->{barnum}} = $params->{bar};
}


sub bars {
	my $self = shift;
	return $self->{bars};
}

# convert event objects (note, rest, bar, etc) to perl code for
# midi simple.   this gets pretty ugly.
sub render {
    my ( $self,  $filename ) = @_ or die "render needs a filename to render to";
    my $musicians 	= $self->{cfg}->{musicians};
    my $perlcode 	= $self->perl_head;

    for my $musician (@$musicians) {
        my $events 	= $self->{bars}->{$musician->{name}};
        my $musician_perlcode = $self->musician_subroutine_header($musician);
        my $channel 	= $musician->{channel};
        my $patch 		= $musician->{patch};

        for my $event (
            sort { $events->{$a}->number <=> $events->{$b}->number }
                keys %$events
        ) {
            # $this_event is a bar, a phrase or maybe a noop
            my $this_event = $events->{$event};

            # we need the events out of the bar or phrase
            my $eventstack 	= $this_event->events;
            my $printwrap 	= 5; # how many events to print per line..so we can debug later
            my $wrap;

            for my $stackitem (@$eventstack) {
                ++$wrap;
                 $musician_perlcode .= $self->perl_from_event(
                	event => $stackitem,
                	musician_name => $musician->{name}) .'; ';
                if ($wrap >= $printwrap) {
                    $musician_perlcode .= "\n\t";
                    $wrap = 0;
                }
            }
        }

        $perlcode .= $musician_perlcode . "\n}";
    }

    if ($self->{cfg}->{debug}) {
        open DEBUG, ">debug.perl" or die "Can't open debug.perl for writing - $!\n";
        print DEBUG $perlcode;
        close DEBUG;
    }

    eval "$perlcode" or
        die "uh oh - bad stuff happened during rendering: " . join "\n", $@;
}

# header chunk of perl code for eventual eval
sub perl_head {
    my $self 		= shift;
    my $now  	= scalar(localtime);
    my $code 	= qq!
# magically generated by $0 - $now

use MIDI::Simple;
no strict 'subs';
new_score;
set_tempo 500000;

synch(! ;
    # add the subroutine refs
    for (@{$self->{cfg}->{musicians}}) {
        $code .= "\\&$_->{name},";
    }
    $code =~ s/\,$/)\;\n\n/;

    $code .= "\nwrite_score '$self->{cfg}->{filename}';\n\n";
    return $code;
}

# create perlcode from an event for eventual
# eval to MIDI::Simple code.
sub perl_from_event {
	my $self = shift;
	#my $p = shift;
	my %params = @_;
  	die "perl from event needs an event, and a musician_name: \n\n"
  		unless ($params{event} and $params{musician_name});

    # what type of event do we have?

    # should MIDI::Bar recursively call this sub for notes and rests, or keep
    # the seperate code?
    my $eventname = ref $params{event};

    if ($eventname eq 'POE::Framework::MIDI::Bar') {
        my $stack = $params{event}->events; # get the bar's eventstack

        for my $stackitem (@$stack) {
            if ($eventname eq 'POE::Framework::MIDI::Note') {
                my $duration 	= $stackitem->duration;
                my $note     	= $stackitem->note;
                # n wn, Cs4
                return "n $duration, $note";
            }
            elsif ($eventname eq 'POE::Framework::MIDI::Rest') {
                my $duration = $stackitem->duration;
                return "r $duration";
            }
        }
    }
    elsif ($eventname eq 'POE::Framework::MIDI::Note') {
        my $duration 		= $params{event}->duration;
        my $note     		= $params{event}->note;
        # n wn, Cs4
        return "n $duration, $note";
    }
    elsif ($eventname eq 'POE::Framework::MIDI::Rest') {
        my $duration = $params{event}->duration;
        return "r $duration";
    }
    elsif($eventname eq 'POE::Framework::MIDI::Interval') {
    	my $duration 		= $params{event}->duration;
    	my $notes 			= $params{event}->notes;
    	return "n $duration, " . join ",", @$notes;
    }

    else {
        warn "Unhandled event type $params{event} ignored";
    }
}

# the perl code to start a musician subroutine for MIDI::Simplels
# 'synch' function
sub musician_subroutine_header {
    my ($self,$musician) = @_;
    my ($name,$channel,$patch) = ($musician->{name}, $musician->{channel},$musician->{patch});

    return qq!
sub $name {
    noop c$channel, f, o4;
    patch_change $channel, $patch;
    #instrument_name $name;

    !;
}

# eventually this should evolve into a way for musicians or $self to query about
# what any musician played in any bar for follow the leader-type-stuff, and so on.
sub query {
    my $self = shift;
    my $querystring = shift or die  __PACKAGE__ . "query needs a querystring";
    print "query $querystring\n";
}

1;

__END__