File Coverage

blib/lib/MIDI/Music.pm

Criterion	Covered	Total	%
statement	32	200	16.0
branch	1	108	0.9
condition	8	18	44.4
subroutine	8	16	50.0
pod	4	4	100.0
total	53	346	15.3

package MIDI::Music;

use strict;
use Carp;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
use Fcntl;

require Exporter;
require DynaLoader;
require AutoLoader;

@ISA = qw(Exporter DynaLoader);
@EXPORT = qw();
$VERSION = '0.01';

sub AUTOLOAD {

    my $constname;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "& not defined" if $constname eq 'constant';
    my $val = constant($constname, @_ ? $_[0] : 0);
    if ($! != 0) {
	if ($! =~ /Invalid/) {
	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
	    goto &AutoLoader::AUTOLOAD;
	}
	else {
		croak "Your vendor has not defined MIDI::Music macro $constname";
	}
    }
    no strict 'refs';
    *$AUTOLOAD = sub { $val };
    goto &$AUTOLOAD;
}

bootstrap MIDI::Music $VERSION;

sub DESTROY {
    my $mm = shift;
    $mm->close() if ($mm->{'_initialized'});
}

################################################################################
################################# Constructor ##################################
sub new {

    my $class = shift;
    my %param = @_;

    ######################################
    # Device number (0 == first available)
    my $device = $param{'device'} || 0;    # Device number

    ##############################
    # Recording-related parameters
    my $readbuf  = $param{'readbuf'}  || 4096; # events per read * 8
    #my $actsense = $param{'actsense'} || 0;    # enable active sensing
    my $realtime = $param{'realtime'} || 0;    # realtime messages on
    #my $timing   = $param{'timing'}   || 0;    # timer on (requires rt(?))

    #############################
    # Playback-related parameters
    #my $extbuf      = $param{'extbuf'}  || 0;    # ?? not documented
    my $gmdrum      = $param{'gmdrum'}  || [];   # Drums to cache
    my $gminstr     = $param{'gminstr'} || [];   # Patches to cache

    ###################################
    # Initial timing parameters
    my $timebase = $param{'timebase'} || 96;  # Ticks per quarter-note
    my $tempo    = $param{'tempo'}    || 120; # BPM
    my $timesig  = $param{'timesig'}  || [0x04, 0x02, 0x18, 0x08]; # 4/4

    my $ppqn_per_clock = $timebase / 24; # Clocks (pulses) per quarter-note

    my $self = {'_device'      => $device,
                '_errstr'      => '',
                '_initialized' => 0,

                '_event_times' => [], # For the storage of
                '_midistruct'  => {}, #   MIDI file data

                '_readbuf'   => $readbuf,
                #'_actsense'  => $actsense,
                '_realtime'  => $realtime,
                #'_timing'    => $timing,
                '_rec_dtime' => 0, # if timing is enabled, this is
                                   #   calculated and supplied as
                                   #   1th element of text events

                #'_extbuf'         => $extbuf,
                '_gmdrum'         => $gmdrum,
                '_gminstr'        => $gminstr,

                '_tempo'          => $tempo,
                '_timebase'       => $timebase,
                '_ppqn_per_clock' => $ppqn_per_clock,

                '_timesig' => $timesig,
                };

    return bless $self, $class;
}

################################################################################
########################### Misc. ##############################################
sub errstr {
    my $mm = shift;
    return $mm->{'_errstr'};
}


################################################################################
####################### MIDI File Methods ######################################
sub _clear {

    my $mm = shift;
    $mm->{'_midistruct'}  = {};
    $mm->{'_event_times'} = [];
}

sub _loadmidifile {

    my $mm       = shift;
    my $midifile = shift;

    if (eval 'require MIDI') {

        my $opus = MIDI::Opus->new({'from_file' => $midifile});

        $mm->{'_timebase'} = $opus->ticks();
        my $format         = $opus->format();
        my $pos            = 0;

        foreach my $track (@{$opus->tracks_r}) {

            my $events_r = $track->events_r;
            $pos         = 0 unless ($format == 2);

            foreach my $event (@{$events_r}) {

                $pos += $event->[1]; # Add current dtime to last position

                push(@{$mm->{'_midistruct'}->{$pos}}, $event);
            }
        }
        $mm->{'_event_times'} = [ sort { $a <=> $b } keys %{$mm->{'_midistruct'}} ];

    } else {
        $mm->{'_errstr'} = ref($mm) . "::_loadmidifile(): require MIDI: $!";
        return 0;
    }
    return 1;
}

sub playmidifile {

    my $mm       = shift;
    my $midifile = shift || '';

    if ($midifile) {

        unless ($mm->_loadmidifile($midifile)) {
            $mm->{'_errstr'} = ref($mm) . '::playmidifile(): ' . $mm->{'_errstr'};
            return 0;
        }

    } else {
        $mm->{'_errstr'} = ref($mm) . '::playmidifile(): no file supplied';
        return 0;
    }

    unless ($mm->{'_initialized'}) {

        unless ($mm->init('mode' => O_WRONLY)) {
            $mm->{'_errstr'} = ref($mm) . '::playmidifile(): ' . $mm->{'_errstr'};
            return 0;
        }
    }

    $mm->_playloaded() || do {
        $mm->{'_errstr'} = ref($mm) . '::playmidifile(): ' . $mm->{'_errstr'};
        return 0;
    };
    $mm->close();
    $mm->_clear();

    return 1;
}

sub _playloaded {

    my $mm    = shift;
    my $dtime = 0;
    my $last  = 0;

    my $events = [];
    for (0 .. $#{$mm->{'_event_times'}}) {

        my $pos   = $mm->{'_event_times'}->[$_];
        my $dtime = $pos - $last;

        foreach my $event (@{ $mm->{'_midistruct'}->{$pos} }) {

            $event->[1] = $dtime;
            push @$events, $event;

            $dtime = 0;
        }
        $last = $pos;
    }
    $mm->playevents($events) || do {
        $mm->{'_errstr'} = ref($mm) . '::_playloaded(): ' . $mm->{'_errstr'};
        return 0;
    };
    $mm->dumpbuf();
    return 1;
}

################################################################################
############################## Recording #######################################
sub _readevents_OSS {

    my $mm      = shift;
    my $data    = $mm->_readblock();
    my $events  = [];

    $events = [ map { [ unpack('C8', substr($data, ($_ * 8), 8)) ]
                    } (0 .. ((length($data) / 8) - 1))
              ] if ($data);

    return $events;
}

sub readevents {

    my $mm      = shift;
    my $events  = $mm->_readevents_OSS();
    my $decoded = [];

    if (@{$events}) {

        for (0 .. $#{$events}) {

            my $event      = $events->[$_];
            my $ev_decoded = [];

            if ($event->[0] == &EV_CHN_VOICE) {

                if ($event->[2] == &MIDI_NOTEON) {

                    $ev_decoded->[0] = 'note_on';
                    $ev_decoded->[1] = $mm->{'_rec_dtime'};
                    $ev_decoded->[2] = $event->[3]; # channel
                    $ev_decoded->[3] = $event->[4]; # note
                    $ev_decoded->[4] = $event->[5]; # velocity

                    $mm->{'_rec_dtime'} = 0;

                } elsif ($event->[2] == &MIDI_NOTEOFF) {

                    $ev_decoded->[0] = 'note_off';
                    $ev_decoded->[1] = $mm->{'_rec_dtime'};
                    $ev_decoded->[2] = $event->[3]; # channel
                    $ev_decoded->[3] = $event->[4]; # note
                    $ev_decoded->[4] = $event->[5]; # velocity

                    $mm->{'_rec_dtime'} = 0;

                } elsif ($event->[2] == &MIDI_KEY_PRESSURE) {

                    $ev_decoded->[0] = 'key_after_touch';
                    $ev_decoded->[1] = $mm->{'_rec_dtime'};
                    $ev_decoded->[2] = $event->[3]; # channel
                    $ev_decoded->[3] = $event->[4]; # note
                    $ev_decoded->[4] = $event->[5]; # velocity

                    $mm->{'_rec_dtime'} = 0;
                }

            } elsif ($event->[0] == &EV_CHN_COMMON) {

                if ($event->[2] == &MIDI_CHN_PRESSURE) {

                    $ev_decoded->[0] = 'channel_after_touch';
                    $ev_decoded->[1] = $mm->{'_rec_dtime'};
                    $ev_decoded->[2] = $event->[3]; # channel
                    $ev_decoded->[3] = $event->[4]; # velocity

                    $mm->{'_rec_dtime'} = 0;

                } elsif ($event->[2] == &MIDI_PGM_CHANGE) {

                    $ev_decoded->[0] = 'patch_change';
                    $ev_decoded->[1] = $mm->{'_rec_dtime'};
                    $ev_decoded->[2] = $event->[3]; # channel
                    $ev_decoded->[3] = $event->[4]; # program

                    $mm->{'_rec_dtime'} = 0;

                } elsif ($event->[2] == &MIDI_CTL_CHANGE) { # control change

                    $ev_decoded->[0] = 'control_change';
                    $ev_decoded->[1] = $mm->{'_rec_dtime'};
                    $ev_decoded->[2] = $event->[3]; # channel
                    $ev_decoded->[3] = $event->[4]; # controller
                    $ev_decoded->[4] = $event->[5]; # value

                    $mm->{'_rec_dtime'} = 0;

                } elsif ($event->[2] == &MIDI_PITCH_BEND) {

                    $ev_decoded->[0] = 'pitch_wheel_change';
                    $ev_decoded->[1] = $mm->{'_rec_dtime'};
                    $ev_decoded->[2] = $event->[3];                # channel
                    $ev_decoded->[3] = ($event->[7] * 256) - 8192; # value

                }

#### fix this #####

            } elsif ($event->[0] == &EV_SYSEX) {

                $ev_decoded->[0] = 'sysex_f0'; # ???
                $ev_decoded->[1] = $mm->{'_rec_dtime'};
                $ev_decoded->[2] = $event->[2]; # data - six bytes at a time! (stupid)

	        for (;;) {
	            my $events_oss = $mm->_readevent_OSS();

	        }

                $mm->{'_rec_dtime'} = 0;

            } elsif ($event->[0] == &EV_TIMING) {

                if      ($event->[1] == &TMR_START)    {
                } elsif ($event->[1] == &TMR_STOP)     {
                } elsif ($event->[1] == &TMR_CONTINUE) {
                } elsif ($event->[1] == &TMR_WAIT_ABS) {
                } elsif ($event->[1] == &TMR_WAIT_REL) {
                } elsif ($event->[1] == &TMR_ECHO)     {
                } elsif ($event->[1] == &TMR_TEMPO)    {

#### possible need for fix here ###
#
                    $ev_decoded->[0] = 'set_tempo';
                    $ev_decoded->[1] = $mm->{'_rec_dtime'};
                    $ev_decoded->[2] = $event->[4]; ## not sure if this is correct..

                    $mm->{'_rec_dtime'} = 0;

                } elsif ($event->[1] == &TMR_SPP) { # not sure how this differs
                                                    #   from 0xf2...

                    $ev_decoded->[0] = 'song_position';
                    $ev_decoded->[1] = $mm->{'_rec_dtime'};

                    $mm->{'_rec_dtime'} = 0;

                } elsif ($event->[1] == &TMR_TIMESIG) {

                    $ev_decoded->[0] = 'time_signature';
                    $ev_decoded->[1] = $mm->{'_rec_dtime'};

                    my $timesig = $event->[4];

                    $ev_decoded->[2] = ($timesig >> 0x18) & 0xff;
                    $ev_decoded->[3] = ($timesig >> 0x10) & 0xff;
                    $ev_decoded->[4] = ($timesig >> 0x08) & 0xff;
                    $ev_decoded->[5] =  $timesig          & 0xff;

                    $mm->{'_rec_dtime'} = 0;
                }

            } elsif ($event->[0] == &EV_SEQ_LOCAL) {
            } elsif ($event->[0] == &EV_SYSTEM)    {

                if ($event->[2] == 0xf0) { # sysex
                } elsif ($event->[2] == 0xf1) { # MTC Qframe

                } elsif ($event->[2] == 0xf2) {

                    $ev_decoded->[0] = 'song_position';
                    $ev_decoded->[1] = $mm->{'_rec_dtime'};

                    $mm->{'_rec_dtime'} = 0;

                } elsif ($event->[2] == 0xf3) { # song select

                    $ev_decoded->[0] = 'song_select';
                    $ev_decoded->[1] = $mm->{'_rec_dtime'};
                    $ev_decoded->[2] = $event->[3]; # song number

                    $mm->{'_rec_dtime'} = 0;

                } elsif ($event->[2] == 0xf4) {
                } elsif ($event->[2] == 0xf5) {
                } elsif ($event->[2] == 0xf6) { # tune request

                    $ev_decoded->[0] = 'tune_request';
                    $ev_decoded->[1] = $mm->{'_rec_dtime'};

                    $mm->{'_rec_dtime'} = 0;

                } elsif ($event->[2] == 0xf7) { # end-of-sysex
                } elsif ($event->[2] == 0xf8) { # timing clock

	           # print "Timing clock\n";

                    $mm->{'_rec_dtime'} += $mm->{'_ppqn_per_clock'};

                } elsif ($event->[2] == 0xf9) {
                } elsif ($event->[2] == 0xfa) { # start
                } elsif ($event->[2] == 0xfb) { # continue
                } elsif ($event->[2] == 0xfc) { # stop
                } elsif ($event->[2] == 0xfd) {
                } elsif ($event->[2] == 0xfe) { # active sensing

	           # print "Active sensing\n";

                } elsif ($event->[2] == 0xff) { # reset
                }
            }
            push(@{$decoded}, $ev_decoded) if (@{$ev_decoded});
        }
    }
    return $decoded;
}

1;

__END__