—package
MIDI::RtController;
our
$AUTHORITY
=
'cpan:GENE'
;
# ABSTRACT: Control your MIDI controller
use
v5.36;
our
$VERSION
=
'0.0603'
;
use
Moo;
use
strictures 2;
use
IO::Async::Channel ();
use
IO::Async::Loop ();
use
IO::Async::Routine ();
use
IO::Async::Timer::Countdown ();
use
MIDI::RtMidi::FFI::Device ();
use
namespace::clean;
has
verbose
=> (
is
=>
'lazy'
,
);
sub
_build_verbose {
my
(
$self
) =
@_
;
return
$ENV
{PERL_FUTURE_DEBUG} ? 1 : 0;
}
has
input
=> (
is
=>
'ro'
,
required
=> 1,
);
has
output
=> (
is
=>
'ro'
,
);
has
loop
=> (
is
=>
'ro'
,
default
=>
sub
{ IO::Async::Loop->new },
);
has
filters
=> (
is
=>
'rw'
,
default
=>
sub
{ {} },
);
has
_msg_channel
=> (
is
=>
'ro'
,
default
=>
sub
{ IO::Async::Channel->new },
);
has
_midi_channel
=> (
is
=>
'ro'
,
default
=>
sub
{ IO::Async::Channel->new },
);
has
midi_out
=> (
is
=>
'ro'
,
default
=>
sub
{ RtMidiOut->new },
);
sub
BUILD {
my
(
$self
,
$args
) =
@_
;
my
$midi_rtn
= IO::Async::Routine->new(
channels_in
=> [
$self
->_msg_channel ],
channels_out
=> [
$self
->_midi_channel ],
model
=>
'spawn'
,
module
=> __PACKAGE__,
func
=>
'_rtmidi_loop'
,
);
$self
->loop->add(
$midi_rtn
);
$self
->_midi_channel->configure(
on_recv
=>
sub
(
$channel
,
$event
) {
my
$dt
=
shift
@$event
;
my
$ev
=
shift
@$event
;
my
$port
=
shift
@$event
;
"Delta time: $dt, MIDI port: $port\n"
if
$self
->verbose;
$self
->_filter_and_forward(
$port
,
$dt
,
$ev
);
}
);
my
$input_name
=
$self
->input;
$self
->_msg_channel->
send
(\
$input_name
);
unless
(
$args
->{midi_out}) {
$self
->midi_out->open_virtual_port(
'foo'
);
_log(
sprintf
'Opening %s port %s...'
,
$self
->midi_out->{type},
$self
->output)
if
$self
->verbose;
_open_port(
$self
->midi_out,
$self
->output);
_log(
sprintf
'Opened %s port %s'
,
$self
->midi_out->{type},
$self
->output)
if
$self
->verbose;
}
}
sub
_log {
join
(
"\n"
,
@_
),
"\n"
;
}
sub
_open_port(
$device
,
$name
) {
$device
->open_port_by_name(
qr/\Q$name/
i)
|| croak
"Failed to open port $name"
;
return
$name
;
}
sub
_rtmidi_loop (
$msg_ch
,
$midi_ch
) {
my
$midi_in
= MIDI::RtMidi::FFI::Device->new(
type
=>
'in'
);
my
$name
= _open_port(
$midi_in
, ${
$msg_ch
->
recv
});
$midi_in
->set_callback_decoded(
sub
{
$midi_ch
->
send
([
@_
[0, 2],
$name
]) }
);
# delta-time, event, midi port
sleep
;
}
sub
_filter_and_forward (
$self
,
$port
,
$dt
,
$event
) {
my
$event_filters
=
$self
->filters->{all} // [];
push
@$event_filters
, @{
$self
->filters->{
$event
->[0] } // [] };
for
my
$filter
(
@$event_filters
) {
return
if
$filter
->(
$port
,
$dt
,
$event
);
}
$self
->send_it(
$event
);
}
sub
add_filter (
$self
,
$name
,
$event_type
,
$action
) {
if
(
ref
$event_type
eq
'ARRAY'
) {
$self
->add_filter(
$name
,
$_
,
$action
)
for
@$event_type
;
return
;
}
_log(
"Add $name filter for $event_type"
)
if
$self
->verbose;
push
@{
$self
->filters->{
$event_type
} },
$action
;
}
sub
send_it (
$self
,
$event
) {
_log(
"Event: @$event"
)
if
$self
->verbose;
$self
->midi_out->send_event(
@$event
);
}
sub
delay_send (
$self
,
$delay_time
,
$event
) {
$self
->loop->add(
IO::Async::Timer::Countdown->new(
delay
=>
$delay_time
,
on_expire
=>
sub
{
$self
->send_it(
$event
) }
)->start
)
}
sub
run (
$self
) {
$self
->loop->run;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
MIDI::RtController - Control your MIDI controller
=head1 VERSION
version 0.0603
=head1 SYNOPSIS
use MIDI::RtController ();
my $rtc = MIDI::RtController->new(
input => 'input device 1',
output => 'output device',
);
sub filter_notes {
my ($note) = @_;
return $note, $note + 7, $note + 12;
}
sub filter_tone {
my ($midi_port, $delta_time, $event) = @_; # 3 required filter arguments
my ($ev, $channel, $note, $vel) = $event->@*;
my @notes = filter_notes($note);
$rtc->send_it([ $ev, $channel, $_, $vel ]) for @notes;
return 0;
}
# respond to specific events:
$rtc->add_filter('filter_tone', $_, \&filter_tone)
for qw(note_on note_off);
# Or:
$rtc->add_filter('filter_tone', [qw(note_on note_off)], \&filter_tone);
# respond to all events:
$rtc->add_filter(
'echo',
all => sub {
my ($port, $dt, $event) = @_;
print "port: $port, delta-time: $dt, ev: ", join(', ', @$event), "\n"
unless $event->[0] eq 'clock';
return 0;
}
);
# add stuff to the $rtc->loop...
$rtc->run;
# you can also use multiple input sources simultaneously:
my $rtc2 = MIDI::RtController->new(
input => 'input device 2',
loop => $rtc->loop,
midi_out => $rtc->midi_out,
);
$rtc2->run;
=head1 DESCRIPTION
C<MIDI::RtController> allows you to control your MIDI controller using
plug-in filters.
=head1 ATTRIBUTES
=head2 verbose
$verbose = $rtc->verbose;
Show progress.
=head2 input
$input = $rtc->input;
Return the MIDI B<input> port.
=head2 output
$output = $rtc->output;
Return the MIDI B<output> port.
=head2 loop
$loop = $rtc->loop;
Return the L<IO::Async::Loop>.
=head2 filters
$filters = $rtc->filters;
Return or set the B<filters>.
=head2 midi_out
$midi_out = $rtc->midi_out;
Return the B<midi_out> port.
=head1 METHODS
=head2 new
$rtc = MIDI::RtController->new(%attributes);
Create a new C<MIDI::RtController> object given the above attributes.
=for Pod::Coverage BUILD
=head2 add_filter
$rtc->add_filter($name, $event_type, $action);
Add a named filter, defined by the CODE reference B<action> for an
B<event_type> like C<note_on> or C<note_off>. An ARRAY reference
of event types like: C<[qw(note_on note_off)]> may also be given.
The special event type C<all> may also be used to refer to any
controller event (e.g. C<note_on>, C<control_change>,
C<pitch_wheel_change>, etc.).
=head2 send_it
$rtc->send_it($event);
Send a MIDI B<event> to the output port, where the MIDI event is an
ARRAY reference like, C<['note_on', 0, 40, 107]> or
C<['control_change', 0, 1, 24]>, etc.
=head2 delay_send
$rtc->delay_send($delay_time, $event);
Send a MIDI B<event> to the output port when the B<delay_time> (in
seconds) expires.
=head2 run
$rtc->run;
Run the asynchronous B<loop>!
=head1 THANK YOU
This code would not exist without the help of CPAN's JBARRETT (John
Barrett AKA fuzzix).
=head1 SEE ALSO
The F<eg/*.pl> example programs!
L<Future::AsyncAwait>
L<IO::Async::Channel>
L<IO::Async::Loop>
L<IO::Async::Routine>
L<IO::Async::Timer::Countdown>
L<MIDI::RtMidi::FFI::Device>
L<Moo>
=head1 AUTHOR
Gene Boggs <gene.boggs@gmail.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2025 by Gene Boggs.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut