MIDI-ALSA-1.22/README0000644000076400017500000000207511572551047011705 0ustar pjbpjb MIDI::ALSA This module offers a Perl interface to the ALSA library. It is a call-compatible translation into Perl of the Lua module midialsa http://www.pjb.com.au/comp/lua/midialsa.html which is in turn based on the Python modules alsaseq.py and alsamidi.py by Patricio Paez. It also offers some functions to translate events from and to the event format used in Sean Burke's MIDI-Perl module. Nothing is exported by default, but all the functions and constants can be exported, e.g.: use MIDI::ALSA(client, connectfrom, connectto, id, input, output); The event-type constants, beginning with SND_SEQ_, are available not as scalars, but as module subroutines with empty prototypes. They must therefore be used without a dollar-sign e.g.: if ($event[0] == MIDI::ALSA::SND_SEQ_EVENT_PORT_UNSUBSCRIBED) { ... The example/ directory includes: midikbd, midiecho and midiclick. To install: perl Makefile.PL; make; make install For up-to-date source, see http://search.cpan.org/~pjb/ Peter J Billam www.pjb.com.au/comp/contact.html www.pjb.com.au MIDI-ALSA-1.22/MANIFEST0000644000076400017500000000027511720410515012143 0ustar pjbpjbREADME MANIFEST Changes META.yml Makefile.PL test.pl ALSA.pm ALSA.xs examples/apmid examples/armid examples/midiclick examples/midiecho examples/midiedit examples/midifade examples/midikbd MIDI-ALSA-1.22/Changes0000644000076400017500000000266313007006046012310 0ustar pjbpjb20161104 1.22 ??? 20161104 1.21 test.pl works with different queue ids 20140416 1.20 outputports marked WRITE to get UNSUBSCRIBED messages from System 20140404 1.19 CONSTS exported as advertised 20130514 1.18 parse_address matches startofstring to cover alsa-lib 1.0.24 bug 20130211 noteonevent and noteoffevent accept a $start parameter 20121208 1.17 test.pl handles alsa_1.0.16 quirk 20121129 1.16 test.pl prints better diagnostics if it fails 20120930 1.15 output() timestamp and duration in floating-point seconds 20120925 (dis)?connect(from|to) return undef if parse_address fails 20111112 1.14 but output() does broadcast if destination is self 20111108 1.13 fix version number 20111108 1.12 output() does not broadcast if destination is set 20111101 1.11 add parse_address(), and call automatically from connectto() etc 20111024 1.10 crash-proof all xs_ subs if called before client exists 20110624 1.09 $maximum_nports increased from 4 to 64 20110605 1.08 examples include midikbd, midiecho and midiclick 20110430 1.07 reposition call to free() in xs_status 20110428 1.06 fix bug in status() in the time return-value 20110425 1.05 add the missing xs_status routine, and test status() 20110303 1.04 output, input, *2alsa and alsa2* now handle sysex events 20110228 1.03 add listclients, listconnectedto and listconnectedfrom 20110213 1.02 add disconnectto and disconnectfrom 20110211 1.01 translated from midialsa.lua, first released version MIDI-ALSA-1.22/Makefile.PL0000644000076400017500000000071011523462077012771 0ustar pjbpjbuse ExtUtils::MakeMaker; # Bug #52416: 5.6.2 fails with "xref is not of type AVPtr" # die "5.6.2 unsupported" if $] eq '5.006002'; use 5.006_001; # 1.16 WriteMakefile( NAME => 'MIDI::ALSA', VERSION_FROM => 'ALSA.pm', EXE_FILES => [ glob "bin/*" ], AUTHOR => 'PJB, Peter Billam, www.pjb.com.au/comp/contact.html', ABSTRACT => 'Access to the ALSA library', LIBS => ["-lasound"], dist => {COMPRESS=>'gzip -9f', SUFFIX => 'gz'}, ); MIDI-ALSA-1.22/test.pl0000644000076400017500000004261112535154117012336 0ustar pjbpjb#!/usr/bin/perl -w ######################################################################### # This Perl script is Copyright (c) 2002, Peter J Billam # # c/o P J B Computing, www.pjb.com.au # # # # This script is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### use MIDI::ALSA qw(:ALL); # use Class::MakeMethods::Utility::Ref qw( ref_clone ref_compare ); use Time::HiRes; use Data::Dumper; $Data::Dumper::Indent = 0; # 1.16 use Test::Simple tests => 57; my @virmidi = virmidi_clients_and_files(); if (@virmidi < 4) { print("# To run all tests, four virmidi clients are needed...\n"); print("# You might need to add the line:\n"); print("# modprobe snd_virmidi enable=1 # to create 4 virmidi ports\n"); print("# to your /etc/rc.local :-)\n"); } $rc = MIDI::ALSA::inputpending(); ok(! defined $rc, "inputpending() with no client returned undef"); my ($cl,$po) = MIDI::ALSA::parse_address('97:3'); ok(($cl==97)&&($po==3), "parse_address('97:3') with no client returned 97,3"); my $my_name = "testpl pid=$$"; $rc = MIDI::ALSA::client($my_name,2,2,1); ok($rc, "client('$my_name',2,2,1)"); my ($seconds, $microseconds) = Time::HiRes::gettimeofday; my $start_time = $seconds + 1.0E-6 * $microseconds; $id = MIDI::ALSA::id(); ok($id > 0, "id() returns $id"); ($cl,$po) = MIDI::ALSA::parse_address($my_name); if (! ok($cl == $id, "parse_address('$my_name') returns $id,$po")) { print "# it returned instead: $cl,$po\n"; } ($cl,$po) = MIDI::ALSA::parse_address('testpl'); if (! ok($cl == $id, "parse_address('testpl') returns $id,$po")) { print "# it returned instead: $cl,$po\n"; } # 20121205 apparently fails on 1.0.22 on Centos. #($cl,$po) = MIDI::ALSA::parse_address('testp'); #if (! ok($cl == $id, "parse_address('testp') returns $id,$po")) { # print "# it returned instead: $cl,$po\n"; #} if (@virmidi >= 2 ) { $rc = MIDI::ALSA::connectfrom(1,$virmidi[0],0); ok($rc, "connectfrom(1,$virmidi[0],0)"); } else { ok(1, "can't see a virmidi client, so skipping connectfrom()"); } $rc = MIDI::ALSA::connectfrom(1,133,0); ok(! $rc, 'connectfrom(1,133,0) correctly returned 0'); if (@virmidi >= 2 ) { $rc = MIDI::ALSA::connectto(2,$virmidi[2],0); ok($rc, "connectto(2,$virmidi[2],0)"); } else { ok(1, "can't see two virmidi clients, so skipping connectto()"); } $rc = MIDI::ALSA::connectto(1,133,0); ok(! $rc, 'connectto(1,133,0) correctly returned 0'); $rc = MIDI::ALSA::start(); ok($rc, 'start()'); my $qid = MIDI::ALSA::queue_id(); if (! ok(($qid >= 0 and $qid != MIDI::ALSA::SND_SEQ_QUEUE_DIRECT()), "queue_id is not negative and not SND_SEQ_QUEUE_DIRECT")) { print "# queue_id() returned $qid\n"; } $fd = MIDI::ALSA::fd(); ok($fd > 0, 'fd()'); my %num2name = MIDI::ALSA::listclients(); ok($num2name{$id} eq $my_name, "listclients()"); my %num2nports = MIDI::ALSA::listnumports(); ok($num2nports{$id} == 4, "listnumports()"); if (@virmidi < 2) { ok(1, "skipping inputpending() returns $rc"); ok(1, 'skipping input() test'); ok(1, 'skipping alsa2scoreevent() test'); ok(1, 'skipping input() test'); ok(1, 'skipping alsa2scoreevent() test'); ok(1, 'skipping input() test'); ok(1, 'skipping alsa2scoreevent() test'); ok(1, 'skipping input() test'); ok(1, 'skipping alsa2scoreevent() test'); ok(1, 'skipping listconnectedto() test'); ok(1, 'skipping listconnectedfrom() test'); } else { open(my $inp, '>', $virmidi[1]) || die "can't open $virmidi[1]: $!\n"; # client 20 my $vm = 0 + $virmidi[0]; select($inp); $|=1; select(STDOUT); print("# feeding ourselves a patch_change event...\n"); print $inp "\xC0\x63"; # string.char(12*16, 99)); # {'patch_change',0,0,99} $rc = MIDI::ALSA::inputpending(); ok($rc > 0, "inputpending() returns $rc"); @alsaevent = MIDI::ALSA::input(); @correct = (11, 1, 0, 1, 300, [$vm,0], [$id,1], [0, 0, 0, 0, 0, 99] ); $alsaevent[3] = 1; # 1.16 sometimes it's 0 ... $alsaevent[4] = 300; if (! ok(Dumper(@alsaevent) eq Dumper(@correct), "input() returns (11,1,0,1,300,[$vm,0],[id,1],[0,0,0,0,0,99])")) { print "# alsaevent=".Dumper(\@alsaevent)."\n"; # 1.16 print "# correct =".Dumper(\@correct)."\n"; # 1.16 } @e = MIDI::ALSA::alsa2scoreevent(@alsaevent); #warn("e=".Dumper(\@e)."\n"); @correct = ('patch_change',300000,0,99); ok(Dumper(@e) eq Dumper(@correct), 'alsa2scoreevent() returns ("patch_change",300000,0,99)'); print("# feeding ourselves a control_change event...\n"); print $inp "\xB2\x0A\x67"; # 11*16+2,10,103 {'control_change',3,2,10,103} $rc = MIDI::ALSA::inputpending(); @alsaevent = MIDI::ALSA::input(); @correct = (10, 1, 0, 1, 300, [$vm,0], [$id,1], [2, 0, 0, 0,10,103] ); $alsaevent[3] = 1; # 1.16 sometimes it's 0 ... $alsaevent[4] = 300; if (! ok(Dumper(@alsaevent) eq Dumper(@correct), "input() returns (10,1,0,1,300,[$vm,0],[id,1],[2,0,0,0,10,103])")) { print "# alsaevent=".Dumper(\@alsaevent)."\n"; # 1.16 print "# correct =".Dumper(\@correct)."\n"; # 1.16 } @e = MIDI::ALSA::alsa2scoreevent(@alsaevent); # warn("e=".Dumper(@e)."\n"); @correct = ('control_change',300000,2,10,103); # warn("correct=".Dumper(@correct)."\n"); ok(Dumper(@e) eq Dumper(@correct), 'alsa2scoreevent() returns ("control_change",300000,2,10,103)'); print("# feeding ourselves a note_on event...\n"); print $inp "\x90\x3C\x65"; # (9*16, 60,101)); {'note_on',0,60,101} $rc = MIDI::ALSA::inputpending(); @alsaevent = MIDI::ALSA::input(); $save_time = $alsaevent[4]; @correct = ( 6, 1, 0, 1, 300, [$vm,0], [$id,1], [ 0, 60, 101, 0, 0 ] ); $alsaevent[3] = 1; # 1.16 sometimes it's 0 ... $alsaevent[4] = 300; ${$alsaevent[7]}[3] = 0; ${$alsaevent[7]}[4] = 0; if (! ok(Dumper(@alsaevent) eq Dumper(@correct), "input() returns (6,1,0,1,300,[$vm,0],[id,1],[0,60,101,0,0])")) { print "# alsaevent=".Dumper(\@alsaevent)."\n"; # 1.16 print "# correct =".Dumper(\@correct)."\n"; # 1.16 } @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); #$scoreevent[1] = 300000; #@correct = ('note_on',300000,0,60,101); #ok(Dumper(@scoreevent) eq Dumper(@correct), # 'alsa2scoreevent() returns ("note_on",300000,0,60,101)'); print("# feeding ourselves a note_off event...\n"); print $inp "\x80\x3C\x65"; # (8*16, 60,101); # {'note_off',0,60,101} $rc = MIDI::ALSA::inputpending(); @alsaevent = MIDI::ALSA::input(); $save_time = $alsaevent[4]; @correct = ( 7, 1, 0, 1, 301, [ $vm,0 ], [ $id,1 ], [ 0, 60, 101, 0, 0 ] ); $alsaevent[3] = 1; # 1.16 sometimes it's 0 ... $alsaevent[4] = 301; ${$alsaevent[7]}[4] = 0; if (! ok(Dumper(@alsaevent) eq Dumper(@correct), "input() returns (7,1,0,1,301,[$vm,0],[id,1],[0,60,101,0,0])")) { print "# alsaevent=".Dumper(\@alsaevent)."\n"; # 1.16 print "# correct =".Dumper(\@correct)."\n"; # 1.16 } @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); # print('scoreevent='.Dumper(@scoreevent)); $scoreevent[1] = 300000; @correct = ('note',300000,1000,0,60,101); ok(Dumper(@scoreevent) eq Dumper(@correct), 'alsa2scoreevent() returns ("note",300000,1000,0,60,101)'); print("# feeding ourselves a sysex_f0 event...\n"); print $inp "\xF0}hello world\xF7"; # {'sysex_f0',0,'hello world'} @alsaevent = MIDI::ALSA::input(); $save_time = $alsaevent[4]; @correct = (130, 5, 0, 1, 300, [$vm,0], [$id,1], ["\xF0}hello world\xF7",undef,undef,undef,0] ); $alsaevent[3] = 1; # 1.16 sometimes it's 0 ... $alsaevent[4] = 300; ${$alsaevent[7]}[4] = 0; if (! ok(Dumper(@alsaevent) eq Dumper(@correct), 'input() returns (130,5,0,1,300,[vm,0],[id,1],["\xF0}hello world\xF7"])')) { print "# alsaevent=".Dumper(\@alsaevent)."\n"; # 1.16 print "# correct =".Dumper(\@correct)."\n"; # 1.16 } #print('alsaevent='.Dumper(@alsaevent)); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); $scoreevent[1] = 300000; @correct = ('sysex_f0',300000,"}hello world\xF7"); ok(Dumper(@scoreevent) eq Dumper(@correct), 'alsa2scoreevent() returns ("sysex_f0",300000,"}hello world\xF7")'); my @to = MIDI::ALSA::listconnectedto(); @correct = ([2,0+$virmidi[2],0],); #print "to=",Dumper(@to),"correct=",Dumper(@correct); ok(Dumper(@to) eq Dumper(@correct), "listconnectedto() returns ([2,$virmidi[2],0])"); my @from = MIDI::ALSA::listconnectedfrom(); @correct = ([1,0+$virmidi[0],0],); #print "from=",Dumper(@from),"correct=",Dumper(@correct); ok(Dumper(@from) eq Dumper(@correct), "listconnectedfrom() returns ([1,$virmidi[0],0])"); } if (@virmidi < 4) { ok(1, 'skipping patch_change event output'); ok(1, 'skipping control_change event output'); ok(1, 'skipping note_on event output'); ok(1, 'skipping note_off event output'); } else { open(my $oup, '<', $virmidi[3]) || die "can't open $virmidi[3]: $!\n"; my $cl_num = $virmidi[2]; # client 25 print("# outputting a patch_change event...\n"); my @alsaevent = (11, 1,0,1, 0.5,[$id,0],[$cl_num,0],[0, 0, 0, 0, 0, 99]); $rc = MIDI::ALSA::output(@alsaevent); read $oup, $bytes, 2; ok($bytes eq "\xC0\x63", 'patch_change event detected'); print("# outputting a control_change event...\n"); @alsaevent = (10, 1,0,1, 1.5,[$id,0],[$cl_num,0], [2, 0, 0, 0,10,103]); $rc = MIDI::ALSA::output(@alsaevent); read $oup, $bytes, 3; ok($bytes eq "\xB2\x0A\x67", 'control_change event detected'); print("# outputting a note_on event...\n"); @alsaevent = (6, 1,0,1, 2.0, [$id,1], [$cl_num,0], [0,60,101,0,0]); $rc = MIDI::ALSA::output(@alsaevent); read $oup, $bytes, 3; #printf "bytes=%vx\n", $bytes; ok($bytes eq "\x90\x3C\x65", 'note_on event detected'); print("# outputting a note_off event...\n"); @alsaevent = (7, 1,0,1, 2.5, [$id,1], [$cl_num,0], [0, 60, 101, 0, 0]); $rc = MIDI::ALSA::output(@alsaevent); read $oup, $bytes, 3; #printf "bytes=%vx\n", $bytes; ok($bytes eq "\x80\x3C\x65", 'note_off event detected'); } if (@virmidi <2) { ok(1, "skipping disconnectfrom()"); ok(1, 'skipping SND_SEQ_EVENT_PORT_UNSUBSCRIBED event'); ok(1, "skipping disconnectto()"); } else { print("# running aconnect -d $virmidi[0] $id:1 ...\n"); system("aconnect -d $virmidi[0] $id:1"); foreach (1..5) { # 1.17 $rc = MIDI::ALSA::inputpending(); @alsaevent = MIDI::ALSA::input(); if ($alsaevent[0] != MIDI::ALSA::SND_SEQ_EVENT_SENSING()) { last; } my $cl = join ":", @{$alsaevent[5]}; warn "# discarding a SND_SEQ_EVENT_SENSING event from $cl\n"; } if (! ok($alsaevent[0] == MIDI::ALSA::SND_SEQ_EVENT_PORT_UNSUBSCRIBED, 'SND_SEQ_EVENT_PORT_UNSUBSCRIBED event received')) { print "# inputpending returned $rc\n"; # 1.16+ print "# alsaevent=".Dumper(\@alsaevent)."\n"; # 1.16+ } # inside the if (@virmidi<2) else { 1.18 $rc = MIDI::ALSA::disconnectto(2,$virmidi[2],0); ok($rc, "disconnectto(2,$virmidi[2],0)"); } $rc = MIDI::ALSA::connectto(2,"$my_name:1"); ok($rc, "connectto(2,'$my_name:1') connected to myself by name"); #system 'aconnect -oil'; @correct = (11, 1, 0, $qid, 2.8, [$id,2], [$id,1], [0, 0, 0, 0, 0, 99] ); $rc = MIDI::ALSA::output(@correct); foreach (1..5) { # 1.17 $rc = MIDI::ALSA::inputpending(); @alsaevent = MIDI::ALSA::input(); if ($alsaevent[0] != MIDI::ALSA::SND_SEQ_EVENT_SENSING()) { last; } my $cl = join ":", @{$alsaevent[5]}; warn "# discarding a SND_SEQ_EVENT_SENSING event from $cl\n"; } $latency = int(0.5 + 1000000 * ($alsaevent[4]-$correct[4])); $alsaevent[3] = $qid; # 1.16 sometimes it's 0... 1.21 or the other way round $alsaevent[4] = $correct[4]; if (! ok(Dumper(@alsaevent) eq Dumper(@correct), "received an event from myself")) { print "# alsaevent=".Dumper(\@alsaevent)."\n"; # 1.16 print "# correct =".Dumper(\@correct)."\n"; # 1.16 } ok($latency < 10000, "latency was $latency microsec"); $rc = MIDI::ALSA::disconnectfrom(1,$id,2); ok($rc, "disconnectfrom(1,$id,2)"); my($running, $time, $events) = MIDI::ALSA::status(); ($seconds, $microseconds) = Time::HiRes::gettimeofday(); my $end_time = $seconds + 1.0E-6 * $microseconds; ok($running,'status() reports running'); my $elapsed = $end_time-$start_time; ok(abs($end_time-$start_time - $time) < 0.1, "status() reports time = $time not $elapsed"); sleep(1); ($running, $time, $events) = MIDI::ALSA::status(); ($seconds, $microseconds) = Time::HiRes::gettimeofday(); $end_time = $seconds + 1.0E-6 * $microseconds; $elapsed = $end_time-$start_time; ok(abs($end_time-$start_time - $time) < 0.1, "status() reports time = $time not $elapsed"); $rc = MIDI::ALSA::stop(); ok($rc,'stop() returns success'); @alsaevent = MIDI::ALSA::noteonevent(15, 72, 100, 2.7); @correct = (6,1,0,$qid,2.7,[0,0],[0,0],[15,72,100,0,0]); if (! ok(Dumper(@alsaevent) eq Dumper(@correct), 'noteonevent()')) { print "# alsaevent=".Dumper(\@alsaevent)."\n"; # 1.18 print "# correct =".Dumper(\@correct)."\n"; # 1.18 } @alsaevent = MIDI::ALSA::noteoffevent(15, 72, 100, 2.7); @correct = (7,1,0,$qid,2.7,[0,0],[0,0],[15,72,100,100,0]); if (! ok(Dumper(@alsaevent) eq Dumper(@correct), 'noteoffevent()')) { print "# alsaevent=".Dumper(\@alsaevent)."\n"; # 1.18 print "# correct =".Dumper(\@correct)."\n"; # 1.18 } @alsaevent = MIDI::ALSA::noteevent(15, 72, 100, 2.7, 3.1); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); @correct = ('note',2700,3100,15,72,100); ok(Dumper(@scoreevent) eq Dumper(@correct), 'noteevent()'); @alsaevent = MIDI::ALSA::pgmchangeevent(11, 98, 2.7); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); @correct = ('patch_change',2700,11,98); ok(Dumper(@scoreevent) eq Dumper(@correct), 'pgmchangeevent() with time>=0'); @alsaevent = MIDI::ALSA::pgmchangeevent(11, 98); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); @correct = ('patch_change',0,11,98); ok(Dumper(@scoreevent) eq Dumper(@correct), 'pgmchangeevent() with time undefined'); @alsaevent = MIDI::ALSA::pitchbendevent(11, 98, 2.7); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); @correct = ('pitch_wheel_change',2700,11,98); ok(Dumper(@scoreevent) eq Dumper(@correct), 'pitchbendevent() with time>=0'); @alsaevent = MIDI::ALSA::pitchbendevent(11, 98); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); @correct = ('pitch_wheel_change',0,11,98); ok(Dumper(@scoreevent) eq Dumper(@correct), 'pitchbendevent() with time undefined'); @alsaevent = MIDI::ALSA::chanpress(11, 98, 2.7); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); # print('alsaevent='.Dumper(@alsaevent)."\n"); # print('scoreevent='.Dumper(@scoreevent)."\n"); @correct = ('channel_after_touch',2700,11,98); ok(Dumper(@scoreevent) eq Dumper(@correct), 'chanpress() with time>=0'); @alsaevent = MIDI::ALSA::chanpress(11, 98); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); # print('alsaevent='.Dumper(@alsaevent)."\n"); # print('scoreevent='.Dumper(@scoreevent)."\n"); @correct = ('channel_after_touch',0,11,98); ok(Dumper(@scoreevent) eq Dumper(@correct), 'chanpress() with time undefined'); @correct = ('note',0,1000,15,72,100); @alsaevent = MIDI::ALSA::scoreevent2alsa(@correct); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); ok(Dumper(@scoreevent) eq Dumper(@correct), 'scoreevent2alsa("note"...)'); @correct = ('control_change',10,15,72,100); @alsaevent = MIDI::ALSA::scoreevent2alsa(@correct); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); ok(Dumper(@scoreevent) eq Dumper(@correct), 'scoreevent2alsa("control_change"...)'); @correct = ('patch_change',10,15,72); @alsaevent = MIDI::ALSA::scoreevent2alsa(@correct); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); ok(Dumper(@scoreevent) eq Dumper(@correct), 'scoreevent2alsa("patch_change"...)'); @correct = ('pitch_wheel_change',10,15,3232); @alsaevent = MIDI::ALSA::scoreevent2alsa(@correct); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); ok(Dumper(@scoreevent) eq Dumper(@correct), 'scoreevent2alsa("pitch_wheel_change"...)'); @correct = ('channel_after_touch',10,15,123); @alsaevent = MIDI::ALSA::scoreevent2alsa(@correct); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); ok(Dumper(@scoreevent) eq Dumper(@correct), 'scoreevent2alsa("channel_after_touch"...)'); @correct = ('sysex_f0',2,"}hello world\xF7"); @alsaevent = MIDI::ALSA::scoreevent2alsa(@correct); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); ok(Dumper(@scoreevent) eq Dumper(@correct), 'scoreevent2alsa("sysex_f0"...)'); @correct = ('sysex_f7',2,"that's all folks\xF7"); @alsaevent = MIDI::ALSA::scoreevent2alsa(@correct); # print "alsaevent=",Dumper(@alsaevent); @scoreevent = MIDI::ALSA::alsa2scoreevent(@alsaevent); # print "scoreevent=",Dumper(@scoreevent),"correct=",Dumper(@correct); ok(Dumper(@scoreevent) eq Dumper(@correct), 'scoreevent2alsa("sysex_f7"...)'); # --------------------------- infrastructure ---------------- sub virmidi_clients_and_files { if (!open(P, 'aconnect -oil|')) { die "can't run aconnect; you may need to install alsa-utils\n"; } my @virmidi = (); while (

) { if (/^client (\d+):\s*\W*Virtual Raw MIDI (\d+)-(\d+)/) { my $f = "/dev/snd/midiC$2D$3"; if (! -e $f) { warn "client $1: can't see associated file $f\n"; last; } push @virmidi, 0+$1, $f; if (@virmidi >= 4) { last; } } } close P; return @virmidi; } sub equal { my ($xref, $yref) = @_; my @x = @$xref; my @y = @$yref; if (scalar @x != scalar @y) { return 0; } my $i; for ($i=$[; $i<=$#x; $i++) { if (abs($x[$i]-$y[$i]) > 0.0000001) { return 0; } } return 1; } __END__ =pod =head1 NAME test.pl - Perl script to test MIDI::ALSA.pm =head1 SYNOPSIS perl test.pl =head1 DESCRIPTION This script tests MIDI::ALSA.pm =head1 AUTHOR Peter J Billam http://www.pjb.com.au/comp/contact.html =head1 SEE ALSO MIDI::ALSA.pm , http://www.pjb.com.au/ , perl(1). =cut MIDI-ALSA-1.22/META.yml0000644000076400017500000000054313007005775012271 0ustar pjbpjb# http://module-build.sourceforge.net/META-spec-current.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: MIDI-ALSA version: 1.22 version_from: ALSA.pm installdirs: site license: perl distribution_type: module requires: perl: ">= 5.006001" build_requires: Test::Simple: 0 generated_by: /usr/bin/vim MIDI-ALSA-1.22/ALSA.pm0000644000076400017500000013507313007006233012073 0ustar pjbpjb# MIDI::ALSA.pm ######################################################################### # This Perl module is Copyright (c) 2002, Peter J Billam # # c/o P J B Computing, www.pjb.com.au # # # # This module is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### package MIDI::ALSA; no strict; use bytes; # this gives a -w warning, but $VERSION.='' confuses CPAN: $VERSION = '1.22'; # 20161104 1.22 # 20161104 1.21 test.pl works with different queue ids # 20140416 1.20 output-ports marked WRITE so they can receive UNSUBSCRIBED # 20140404 1.19 CONSTS exported as advertised # 20130514 1.18 parse_address matches startofstring to hide alsa-lib 1.0.24 bug # 20130211 1.18 noteonevent and noteoffevent accept a $start parameter # 20121208 1.17 test.pl handles alsa_1.0.16 quirk # 20121206 1.16 queue_id; test.pl prints better diagnostics # 20120930 1.15 output() timestamp and duration in floating-point seconds # 20111112 1.14 but output() does broadcast if destination is self # 20111108 1.13 repair version number # 20111108 1.12 output() does not broadcast if destination is set # 20111101 1.11 add parse_address() and call automatically from connectto() etc # 20101024 1.10 crash-proof all xs_ subs if called before client exists # 20100624 1.09 $maximum_nports increased from 4 to 64 # 20100605 1.08 examples include midikbd, midiecho and midiclick # 20110430 1.07 reposition free() in xs_status # 20110428 1.06 fix bug in status() in the time return-value # 20110322 1.05 controllerevent # 20110303 1.04 output, input, *2alsa and alsa2* now handle sysex events # 20110301 1.03 add listclients, listnumports, listconnectedto etc # 20110213 1.02 add disconnectto and disconnectfrom # 20110211 1.01 first released version require Exporter; require DynaLoader; @ISA = qw(Exporter DynaLoader); @EXPORT = (); @EXPORT_OK = qw(client connectfrom connectto fd id input inputpending output start status stop syncoutput noteevent noteonevent noteoffevent parse_address pgmchangeevent pitchbendevent controllerevent chanpress alsa2scoreevent scoreevent2alsa); @EXPORT_CONSTS = qw(SND_SEQ_EVENT_BOUNCE SND_SEQ_EVENT_CHANPRESS SND_SEQ_EVENT_CLIENT_CHANGE SND_SEQ_EVENT_CLIENT_EXIT SND_SEQ_EVENT_CLIENT_START SND_SEQ_EVENT_CLOCK SND_SEQ_EVENT_CONTINUE SND_SEQ_EVENT_CONTROL14 SND_SEQ_EVENT_CONTROLLER SND_SEQ_EVENT_ECHO SND_SEQ_EVENT_KEYPRESS SND_SEQ_EVENT_KEYSIGN SND_SEQ_EVENT_NONE SND_SEQ_EVENT_NONREGPARAM SND_SEQ_EVENT_NOTE SND_SEQ_EVENT_NOTEOFF SND_SEQ_EVENT_NOTEON SND_SEQ_EVENT_OSS SND_SEQ_EVENT_PGMCHANGE SND_SEQ_EVENT_PITCHBEND SND_SEQ_EVENT_PORT_CHANGE SND_SEQ_EVENT_PORT_EXIT SND_SEQ_EVENT_PORT_START SND_SEQ_EVENT_PORT_SUBSCRIBED SND_SEQ_EVENT_PORT_UNSUBSCRIBED SND_SEQ_EVENT_QFRAME SND_SEQ_EVENT_QUEUE_SKEW SND_SEQ_EVENT_REGPARAM SND_SEQ_EVENT_RESET SND_SEQ_EVENT_RESULT SND_SEQ_EVENT_SENSING SND_SEQ_EVENT_SETPOS_TICK SND_SEQ_EVENT_SETPOS_TIME SND_SEQ_EVENT_SONGPOS SND_SEQ_EVENT_SONGSEL SND_SEQ_EVENT_START SND_SEQ_EVENT_STOP SND_SEQ_EVENT_SYNC_POS SND_SEQ_EVENT_SYSEX SND_SEQ_EVENT_SYSTEM SND_SEQ_EVENT_TEMPO SND_SEQ_EVENT_TICK SND_SEQ_EVENT_TIMESIGN SND_SEQ_EVENT_TUNE_REQUEST SND_SEQ_EVENT_USR0 SND_SEQ_EVENT_USR1 SND_SEQ_EVENT_USR2 SND_SEQ_EVENT_USR3 SND_SEQ_EVENT_USR4 SND_SEQ_EVENT_USR5 SND_SEQ_EVENT_USR6 SND_SEQ_EVENT_USR7 SND_SEQ_EVENT_USR8 SND_SEQ_EVENT_USR9 SND_SEQ_EVENT_USR_VAR0 SND_SEQ_EVENT_USR_VAR1 SND_SEQ_EVENT_USR_VAR2 SND_SEQ_EVENT_USR_VAR3 SND_SEQ_EVENT_USR_VAR4 SND_SEQ_QUEUE_DIRECT SND_SEQ_TIME_STAMP_REAL); # 1.19 %EXPORT_TAGS = ( ALL => [@EXPORT,@EXPORT_OK,@EXPORT_CONSTS], CONSTS => [@EXPORT_CONSTS] ); bootstrap MIDI::ALSA $VERSION; my $maximum_nports = 64; # 1.09 my $StartTime = 0; #------------- public constants from alsa/asoundlib.h ------------- my %k2v = &xs_constname2value(); while (my ($k,$v) = each %k2v) { push @EXPORT_OK, $k; push @EXPORT_CONSTS, $k; # eval "sub $k() { return $v;}"; # subroutines # if ($@) { die "can't eval 'sub $k() { return $v;}': $@\n"; } # eval "\$$k = $v;"; # simple variables # if ($@) { die "can't eval '\$$k = $v;': $@\n"; } } # generate this by '!!perl filter': sub SND_SEQ_EVENT_BOUNCE() { return $k2v{'SND_SEQ_EVENT_BOUNCE'}; } sub SND_SEQ_EVENT_CHANPRESS() { return $k2v{'SND_SEQ_EVENT_CHANPRESS'}; } sub SND_SEQ_EVENT_CLIENT_CHANGE() { return $k2v{'SND_SEQ_EVENT_CLIENT_CHANGE'}; } sub SND_SEQ_EVENT_CLIENT_EXIT() { return $k2v{'SND_SEQ_EVENT_CLIENT_EXIT'}; } sub SND_SEQ_EVENT_CLIENT_START() { return $k2v{'SND_SEQ_EVENT_CLIENT_START'}; } sub SND_SEQ_EVENT_CLOCK() { return $k2v{'SND_SEQ_EVENT_CLOCK'}; } sub SND_SEQ_EVENT_CONTINUE() { return $k2v{'SND_SEQ_EVENT_CONTINUE'}; } sub SND_SEQ_EVENT_CONTROL14() { return $k2v{'SND_SEQ_EVENT_CONTROL14'}; } sub SND_SEQ_EVENT_CONTROLLER() { return $k2v{'SND_SEQ_EVENT_CONTROLLER'}; } sub SND_SEQ_EVENT_ECHO() { return $k2v{'SND_SEQ_EVENT_ECHO'}; } sub SND_SEQ_EVENT_KEYPRESS() { return $k2v{'SND_SEQ_EVENT_KEYPRESS'}; } sub SND_SEQ_EVENT_KEYSIGN() { return $k2v{'SND_SEQ_EVENT_KEYSIGN'}; } sub SND_SEQ_EVENT_NONE() { return $k2v{'SND_SEQ_EVENT_NONE'}; } sub SND_SEQ_EVENT_NONREGPARAM() { return $k2v{'SND_SEQ_EVENT_NONREGPARAM'}; } sub SND_SEQ_EVENT_NOTE() { return $k2v{'SND_SEQ_EVENT_NOTE'}; } sub SND_SEQ_EVENT_NOTEOFF() { return $k2v{'SND_SEQ_EVENT_NOTEOFF'}; } sub SND_SEQ_EVENT_NOTEON() { return $k2v{'SND_SEQ_EVENT_NOTEON'}; } sub SND_SEQ_EVENT_OSS() { return $k2v{'SND_SEQ_EVENT_OSS'}; } sub SND_SEQ_EVENT_PGMCHANGE() { return $k2v{'SND_SEQ_EVENT_PGMCHANGE'}; } sub SND_SEQ_EVENT_PITCHBEND() { return $k2v{'SND_SEQ_EVENT_PITCHBEND'}; } sub SND_SEQ_EVENT_PORT_CHANGE() { return $k2v{'SND_SEQ_EVENT_PORT_CHANGE'}; } sub SND_SEQ_EVENT_PORT_EXIT() { return $k2v{'SND_SEQ_EVENT_PORT_EXIT'}; } sub SND_SEQ_EVENT_PORT_START() { return $k2v{'SND_SEQ_EVENT_PORT_START'}; } sub SND_SEQ_EVENT_PORT_SUBSCRIBED() { return $k2v{'SND_SEQ_EVENT_PORT_SUBSCRIBED'}; } sub SND_SEQ_EVENT_PORT_UNSUBSCRIBED() { return $k2v{'SND_SEQ_EVENT_PORT_UNSUBSCRIBED'}; } sub SND_SEQ_EVENT_QFRAME() { return $k2v{'SND_SEQ_EVENT_QFRAME'}; } sub SND_SEQ_EVENT_QUEUE_SKEW() { return $k2v{'SND_SEQ_EVENT_QUEUE_SKEW'}; } sub SND_SEQ_EVENT_REGPARAM() { return $k2v{'SND_SEQ_EVENT_REGPARAM'}; } sub SND_SEQ_EVENT_RESET() { return $k2v{'SND_SEQ_EVENT_RESET'}; } sub SND_SEQ_EVENT_RESULT() { return $k2v{'SND_SEQ_EVENT_RESULT'}; } sub SND_SEQ_EVENT_SENSING() { return $k2v{'SND_SEQ_EVENT_SENSING'}; } sub SND_SEQ_EVENT_SETPOS_TICK() { return $k2v{'SND_SEQ_EVENT_SETPOS_TICK'}; } sub SND_SEQ_EVENT_SETPOS_TIME() { return $k2v{'SND_SEQ_EVENT_SETPOS_TIME'}; } sub SND_SEQ_EVENT_SONGPOS() { return $k2v{'SND_SEQ_EVENT_SONGPOS'}; } sub SND_SEQ_EVENT_SONGSEL() { return $k2v{'SND_SEQ_EVENT_SONGSEL'}; } sub SND_SEQ_EVENT_START() { return $k2v{'SND_SEQ_EVENT_START'}; } sub SND_SEQ_EVENT_STOP() { return $k2v{'SND_SEQ_EVENT_STOP'}; } sub SND_SEQ_EVENT_SYNC_POS() { return $k2v{'SND_SEQ_EVENT_SYNC_POS'}; } sub SND_SEQ_EVENT_SYSEX() { return $k2v{'SND_SEQ_EVENT_SYSEX'}; } sub SND_SEQ_EVENT_SYSTEM() { return $k2v{'SND_SEQ_EVENT_SYSTEM'}; } sub SND_SEQ_EVENT_TEMPO() { return $k2v{'SND_SEQ_EVENT_TEMPO'}; } sub SND_SEQ_EVENT_TICK() { return $k2v{'SND_SEQ_EVENT_TICK'}; } sub SND_SEQ_EVENT_TIMESIGN() { return $k2v{'SND_SEQ_EVENT_TIMESIGN'}; } sub SND_SEQ_EVENT_TUNE_REQUEST() { return $k2v{'SND_SEQ_EVENT_TUNE_REQUEST'}; } sub SND_SEQ_EVENT_USR0() { return $k2v{'SND_SEQ_EVENT_USR0'}; } sub SND_SEQ_EVENT_USR1() { return $k2v{'SND_SEQ_EVENT_USR1'}; } sub SND_SEQ_EVENT_USR2() { return $k2v{'SND_SEQ_EVENT_USR2'}; } sub SND_SEQ_EVENT_USR3() { return $k2v{'SND_SEQ_EVENT_USR3'}; } sub SND_SEQ_EVENT_USR4() { return $k2v{'SND_SEQ_EVENT_USR4'}; } sub SND_SEQ_EVENT_USR5() { return $k2v{'SND_SEQ_EVENT_USR5'}; } sub SND_SEQ_EVENT_USR6() { return $k2v{'SND_SEQ_EVENT_USR6'}; } sub SND_SEQ_EVENT_USR7() { return $k2v{'SND_SEQ_EVENT_USR7'}; } sub SND_SEQ_EVENT_USR8() { return $k2v{'SND_SEQ_EVENT_USR8'}; } sub SND_SEQ_EVENT_USR9() { return $k2v{'SND_SEQ_EVENT_USR9'}; } sub SND_SEQ_EVENT_USR_VAR0() { return $k2v{'SND_SEQ_EVENT_USR_VAR0'}; } sub SND_SEQ_EVENT_USR_VAR1() { return $k2v{'SND_SEQ_EVENT_USR_VAR1'}; } sub SND_SEQ_EVENT_USR_VAR2() { return $k2v{'SND_SEQ_EVENT_USR_VAR2'}; } sub SND_SEQ_EVENT_USR_VAR3() { return $k2v{'SND_SEQ_EVENT_USR_VAR3'}; } sub SND_SEQ_EVENT_USR_VAR4() { return $k2v{'SND_SEQ_EVENT_USR_VAR4'}; } sub SND_SEQ_QUEUE_DIRECT() { return $k2v{'SND_SEQ_QUEUE_DIRECT'}; } sub SND_SEQ_TIME_STAMP_REAL() { return $k2v{'SND_SEQ_TIME_STAMP_REAL'}; } #----------------- public functions from alsaseq.py ----------------- sub client { my ($name, $ninputports, $noutputports, $createqueue) = @_; if ($ninputports > $maximum_nports) { warn("MIDI::ALSA::client: only $maximum_nports input ports are allowed.\n"); return 0; } elsif ($noutputports > $maximum_nports) { warn("MIDI::ALSA::client: only $maximum_nports output ports are allowed.\n"); return 0; } return &xs_client($name, $ninputports, $noutputports, $createqueue); } sub parse_address { my ($port_name) = @_; my @a = &xs_parse_address($port_name); if (@a) { return @a; } # 1.18 bodge to cover bug introduced in alsa-lib 1.0.24 # and fixed 3 years later my ($cli,$por) = split /:/,$port_name,2; if (!$por) { $por = 0; } else { $por = 0+$por; } my $cli_length = length $cli; if (! $cli) { return (); } my @all = listclients(); while (@all) { my $num = shift @all; my $name = shift @all; if (! $name) { return (); } if ($cli eq substr $name,$[,$cli_length) { return ($num, $por); } } return (); } sub connectfrom { my ($myport, $src_client, $src_port) = @_; if (! defined $src_client) { return undef; } # 1.18 if ($src_client =~ /[A-Za-z]/ || !defined $src_port) { # 1.03 ? ($src_client, $src_port) = parse_address("$src_client"); # 1.11 if (! defined $src_client) { return undef; } # 1.15 } return &xs_connectfrom($myport, $src_client, $src_port || 0); } sub connectto { my ($myport, $dest_client, $dest_port) = @_; if (! defined $dest_client) { return undef; } # 1.18 if ($dest_client =~ /[A-Za-z]/ || !defined $dest_port) { # 1.03 ? # http://alsa-project.org/alsa-doc/alsa-lib/group___seq_middle.html ($dest_client, $dest_port) = parse_address("$dest_client"); # 1.11 if (! defined $dest_client) { return undef; } # 1.15 } return &xs_connectto($myport, $dest_client, $dest_port || 0); } sub disconnectfrom { my ($myport, $src_client, $src_port) = @_; if (! defined $src_client) { return undef; } # 1.18 if ($src_client =~ /[A-Za-z]/ || !defined $src_port) { # 1.03 ? ($src_client, $src_port) = parse_address("$src_client"); # 1.11 if (! defined $src_client) { return undef; } # 1.15 } return &xs_disconnectfrom($myport, $src_client, $src_port || 0); } sub disconnectto { my ($myport, $dest_client, $dest_port) = @_; if (! defined $dest_client) { return undef; } # 1.18 if ($dest_client =~ /[A-Za-z]/ || !defined $dest_port) { # 1.03 ? ($dest_client, $dest_port) = parse_address("$dest_client"); # 1.11 if (! defined $dest_client) { return undef; } # 1.15 } return &xs_disconnectto($myport, $dest_client, $dest_port || 0); } sub fd { return &xs_fd(); } sub id { return 0 + &xs_id(); # 1.19 } sub input { my @ev = &xs_input(); if (! @ev) { return undef; } # 1.04 probably received an interrupt my @data = @ev[9..$#ev]; if ($ev[0] == SND_SEQ_EVENT_SYSEX) { # there's only one element in @data; # If you receive a sysex remember the data-string starts # with a F0 and and ends with a F7. "\xF0}hello world\xF7" # If you're receiving a multiblock sysex, the first block has its # F0 at the beginning, and the last block has a F7 at the end. return ( $ev[0], $ev[1], $ev[2], $ev[3], $ev[4], [$ev[5],$ev[6]], [$ev[7],$ev[8]], [$data[0]] ); # We could test for a top bit set and if so return undef ... # but that would mean every caller would have to test for undef :-( # We can't just hang waiting for the next event, because the caller # may have called inputpending() and probably doesn't want to hang. } else { return ( $ev[0], $ev[1], $ev[2], $ev[3], $ev[4], [$ev[5],$ev[6]], [$ev[7],$ev[8]], [@data] ); } } sub inputpending { return &xs_inputpending(); } sub output { my @ev = @_; if (! @ev) { return 0; } my @src = @{$ev[5]}; my @dest = @{$ev[6]}; my @data = @{$ev[7]}; if ($ev[0] == SND_SEQ_EVENT_SYSEX) { # $data[0]=length, $data[6]=char* my $s = "$data[0]"; # If you're sending a sysex remember the data-string needs an F0 # and an F7. (SND_SEQ_EVENT_SYSEX, ...., ["\xF0}hello world\xF7"]) # ( If you're sending a multiblock sysex, the first block needs its # F0 at the beginning, and the last block needs a F7 at the end. ) if ($s =~ /^\xF0.*[\x80-\xF6\xF8-\xFF]/) { if (length($s) > 16) { $s = substr($s,0,14).'...'; } warn "MIDI::ALSA::output: SYSEX data '$s' has a top bit set\n"; return undef; # some misgivings... this is stricter than aplaymidi, and than alsa } return &xs_output($ev[0], $ev[1], $ev[2], $ev[3], $ev[4], $src[0],$src[1], $dest[0],$dest[1], length($s),1,2,3,4,5,$s); # (encoding?) } elsif ($ev[0] == SND_SEQ_EVENT_NOTE) { # 1.15 duration in FP secs return &xs_output($ev[0], $ev[1], $ev[2], $ev[3], $ev[4], $src[0],$src[1], $dest[0],$dest[1], $data[0], $data[1], $data[2],$data[3], # the argument is an int, so we convert here, not in xs_output int(0.5 + 1000*$data[4])||0, $data[5]||0,q{}); } else { return &xs_output($ev[0], $ev[1], $ev[2], $ev[3], $ev[4], $src[0],$src[1], $dest[0],$dest[1], $data[0], $data[1], $data[2],$data[3],$data[4]||0,$data[5]||0,q{}); } } sub queue_id { my $rc = &xs_queue_id(); return 0+$rc; # 1.19 } sub start { my $rc = &xs_start(); return $rc; } sub status { return &xs_status(); } sub stop { return &xs_stop(); } sub syncoutput { return &xs_syncoutput(); } # ---------------- public functions from alsamidi.py ----------------- # 1.15 the SND_SEQ_TIME_STAMP_REALs are now superfluous # 1.16 use xs_queue_id for the queue_id sub noteevent { my ($ch,$key,$vel,$start,$duration ) = @_; my $qid = &xs_queue_id(); # 1.16 return ( SND_SEQ_EVENT_NOTE, SND_SEQ_TIME_STAMP_REAL, 0, $qid, $start, [ 0,0 ], [ 0,0 ], [ $ch,$key,$vel,$vel,$duration ] ); # [$ch,$key,$vel, $vel, int(0.5 + 1000*$duration) ] ); pre-1.15 } sub noteonevent { my ($ch,$key,$vel, $start) = @_; if (! defined $start) { return ( SND_SEQ_EVENT_NOTEON, SND_SEQ_TIME_STAMP_REAL, 0, SND_SEQ_QUEUE_DIRECT, 0, [ 0,0 ], [ 0,0 ], [$ch,$key,$vel, 0, 0 ] ); } else { # 1.18 my $qid = &xs_queue_id(); return ( SND_SEQ_EVENT_NOTEON, SND_SEQ_TIME_STAMP_REAL, 0, 0+$qid, $start, [ 0,0 ], [ 0,0 ], [$ch,$key,$vel, 0, 0 ] ); } } sub noteoffevent { my ($ch,$key,$vel, $start) = @_; if (! defined $start) { return ( SND_SEQ_EVENT_NOTEOFF, SND_SEQ_TIME_STAMP_REAL, 0, SND_SEQ_QUEUE_DIRECT, 0, [ 0,0 ], [ 0,0 ], [$ch,$key,$vel, $vel, 0 ] ); } else { # 1.18 my $qid = &xs_queue_id(); return ( SND_SEQ_EVENT_NOTEOFF, SND_SEQ_TIME_STAMP_REAL, 0, 0+$qid, $start, [ 0,0 ], [ 0,0 ], [$ch,$key,$vel, $vel, 0 ] ); } } sub pgmchangeevent { my ($ch,$value,$start ) = @_; # If start is not provided, the event will be sent directly. if (! defined $start) { return ( SND_SEQ_EVENT_PGMCHANGE, SND_SEQ_TIME_STAMP_REAL, 0, SND_SEQ_QUEUE_DIRECT, 0, [ 0,0 ], [ 0,0 ], [$ch, 0, 0, 0, 0,$value ] ); } else { my $qid = &xs_queue_id(); # 1.16 return ( SND_SEQ_EVENT_PGMCHANGE, SND_SEQ_TIME_STAMP_REAL, 0, $qid, $start, [ 0,0 ], [ 0,0 ], [$ch, 0, 0, 0, 0,$value ] ); } } sub pitchbendevent { my ($ch,$value,$start ) = @_; # If start is not provided, the event will be sent directly. if (! defined $start) { return ( SND_SEQ_EVENT_PITCHBEND, SND_SEQ_TIME_STAMP_REAL, 0, SND_SEQ_QUEUE_DIRECT, 0, [ 0,0 ], [ 0,0 ], [$ch, 0,0,0,0, $value ] ); } else { my $qid = &xs_queue_id(); # 1.16 return ( SND_SEQ_EVENT_PITCHBEND, SND_SEQ_TIME_STAMP_REAL, 0, $qid, $start, [ 0,0 ], [ 0,0 ], [$ch, 0,0,0,0, $value ] ); } } sub controllerevent { my ($ch,$key,$value,$start ) = @_; # 1.05 # If start is not provided, the event will be sent directly. if (! defined $start) { return ( SND_SEQ_EVENT_CONTROLLER, SND_SEQ_TIME_STAMP_REAL, 0, SND_SEQ_QUEUE_DIRECT, 0, [ 0,0 ], [ 0,0 ], [$ch, 0,0,0, $key, $value ] ); } else { my $qid = &xs_queue_id(); # 1.16 return ( SND_SEQ_EVENT_CONTROLLER, SND_SEQ_TIME_STAMP_REAL, 0, $qid, $start, [ 0,0 ], [ 0,0 ], [$ch, 0,0,0, $key, $value ] ); } } sub chanpress { my ($ch,$value,$start ) = @_; # If start is not provided, the event will be sent directly. if (! defined $start) { return ( SND_SEQ_EVENT_CHANPRESS, SND_SEQ_TIME_STAMP_REAL, 0, SND_SEQ_QUEUE_DIRECT, 0, [ 0,0 ], [ 0,0 ], [$ch, 0,0,0,0, $value ] ); } else { my $qid = &xs_queue_id(); # 1.16 return ( SND_SEQ_EVENT_CHANPRESS, SND_SEQ_TIME_STAMP_REAL, 0, $qid, $start, [ 0,0 ], [ 0,0 ], [$ch, 0,0,0,0, $value ] ); } } sub sysex { my ($ch,$value,$start ) = @_; if ($value =~ /[\x80-\xFF]/) { warn "sysex: the string $value has top-bits set :-(\n"; return undef; } if (! defined $start) { return ( SND_SEQ_EVENT_SYSEX, SND_SEQ_TIME_STAMP_REAL, 0, SND_SEQ_QUEUE_DIRECT, 0, [ 0,0 ], [ 0,0 ], ["\xF0$value\xF7",] ); } else { my $qid = &xs_queue_id(); # 1.16 return ( SND_SEQ_EVENT_SYSEX, SND_SEQ_TIME_STAMP_REAL, 0, $qid, $start, [ 0,0 ], [ 0,0 ], ["\xF0$value\xF7",] ); } } #------------ public functions to handle MIDI.lua events ------------- # for MIDI.lua events see http://www.pjb.com.au/comp/lua/MIDI.html#events # for data args see http://alsa-project.org/alsa-doc/alsa-lib/seq.html # http://alsa-project.org/alsa-doc/alsa-lib/group___seq_events.html my %chapitch2note_on_events = (); # this mechanism courtesy of MIDI.lua sub alsa2scoreevent { my @alsaevent = @_; if (@alsaevent<8) { warn "alsa2scoreevent: event too short\n"; return (); } my $ticks = int(0.5 + 1000*$alsaevent[4]); my $func = 'MIDI::ALSA::alsa2scoreevent'; my @data = @{$alsaevent[7]}; # deepcopy needed? # snd_seq_ev_note_t: channel, note, velocity, off_velocity, duration if ($alsaevent[0] == SND_SEQ_EVENT_NOTE) { return ( 'note',$ticks, int(0.5 + 1000*$data[4]), # 1.15 $data[0],$data[1],$data[2] ); } elsif ($alsaevent[0] == SND_SEQ_EVENT_NOTEOFF or ($alsaevent[0] == SND_SEQ_EVENT_NOTEON and !$data[2])) { my $cha = $data[0]; my $pitch = $data[1]; my $key = $cha*128 + $pitch; my @pending_notes = @{$chapitch2note_on_events{$key}}; if (@pending_notes and @pending_notes > 0) { # 1.04 my $new_e = pop @pending_notes; # pop $new_e->[2] = $ticks - $new_e->[1]; return @{$new_e}; } elsif ($pitch > 127) { warn("$func: note_off with no note_on, bad pitch=$pitch"); return undef; } else { warn("$func: note_off with no note_on cha=$cha pitch=$pitch"); return undef; } } elsif ($alsaevent[0] == SND_SEQ_EVENT_NOTEON) { my $cha = $data[0]; my $pitch = $data[1]; my $key = $cha*128 + $pitch; my $new_e = ['note',$ticks,0,$cha,$pitch,$data[2]]; if ($chapitch2note_on_events{$key}) { push @{$chapitch2note_on_events[$key]}, $new_e; } else { $chapitch2note_on_events{$key} = [ $new_e ]; # 1.04 } return undef; } elsif ($alsaevent[0] == SND_SEQ_EVENT_CONTROLLER) { return ( 'control_change',$ticks,$data[0],$data[4],$data[5] ); } elsif ($alsaevent[0] == SND_SEQ_EVENT_PGMCHANGE) { return ( 'patch_change',$ticks,$data[0],$data[5] ); } elsif ($alsaevent[0] == SND_SEQ_EVENT_PITCHBEND) { return ( 'pitch_wheel_change',$ticks,$data[0],$data[5] ); } elsif ($alsaevent[0] == SND_SEQ_EVENT_CHANPRESS) { return ( 'channel_after_touch',$ticks,$data[0],$data[5] ); } elsif ($alsaevent[0] == SND_SEQ_EVENT_SYSEX) { # 1.04 my $s = $data[0]; if ($s =~ s/^\xF0//) { return ( 'sysex_f0',$ticks,$s ); } else { return ( 'sysex_f7',$ticks,$s ); } } elsif ($alsaevent[0] == SND_SEQ_EVENT_PORT_SUBSCRIBED or $alsaevent[0] == SND_SEQ_EVENT_PORT_UNSUBSCRIBED) { return undef; # only have meaning to an ALSA client } else { warn("$func: unsupported event-type $alsaevent[0]\n"); return undef; } } sub scoreevent2alsa { my @event = @_; my $time_in_secs = 0.001*$event[1]; # ms ticks -> secs if ($event[0] eq 'note') { # note on and off with duration; event data type = snd_seq_ev_note_t return ( SND_SEQ_EVENT_NOTE, SND_SEQ_TIME_STAMP_REAL, 0, 0, $time_in_secs, [ 0,0 ], [ 0,0 ], [ $event[3], $event[4], $event[5], 0, 0.001*$event[2] ] ); # 1.15 } elsif ($event[0] eq 'control_change') { # controller; snd_seq_ev_ctrl_t; channel, unused[3], param, value return ( SND_SEQ_EVENT_CONTROLLER, SND_SEQ_TIME_STAMP_REAL, 0, 0, $time_in_secs, [ 0,0 ], [ 0,0 ], [ $event[2], 0,0,0, $event[3], $event[4] ] ); } elsif ($event[0] eq 'patch_change') { # program change; data type=snd_seq_ev_ctrl_t, param is ignored return ( SND_SEQ_EVENT_PGMCHANGE, SND_SEQ_TIME_STAMP_REAL, 0, 0, $time_in_secs, [ 0,0 ], [ 0,0 ], [ $event[2], 0,0,0, 0, $event[3] ] ); } elsif ($event[0] eq 'pitch_wheel_change') { # pitchwheel; snd_seq_ev_ctrl_t; data is from -8192 to 8191 return ( SND_SEQ_EVENT_PITCHBEND, SND_SEQ_TIME_STAMP_REAL, 0, 0, $time_in_secs, [ 0,0 ], [ 0,0 ], [ $event[2], 0,0,0, 0, $event[3] ] ); } elsif ($event[0] eq 'channel_after_touch') { # channel_after_touch; snd_seq_ev_ctrl_t; data is from -8192 to 8191 return ( SND_SEQ_EVENT_CHANPRESS, SND_SEQ_TIME_STAMP_REAL, 0, 0, $time_in_secs, [ 0,0 ], [ 0,0 ], [ $event[2], 0,0,0, 0, $event[3] ] ); # } elsif ($event[0] eq 'key_signature') { # # key_signature; snd_seq_ev_ctrl_t; data is from -8192 to 8191 # return ( SND_SEQ_EVENT_KEYSIGN, SND_SEQ_TIME_STAMP_REAL, # 0, 0, $time_in_secs, [ 0,0 ], [ 0,0 ], # [ $event[2], 0,0,0, $event[3], $event[4] ] ); # } elsif ($event[0] eq 'set_tempo') { # # set_tempo; snd_seq_ev_queue_control # return ( SND_SEQ_EVENT_TEMPO, SND_SEQ_TIME_STAMP_REAL, # 0, 0, $time_in_secs, [ 0,0 ], [ 0,0 ], # [ $event[2], 0,0,0, 0, 0 ] ); } elsif ($event[0] eq 'sysex_f0') { # If you're sending a sysex remember the data-string needs an # an F7 at the end. ('sysex_f0', $ticks, "}hello world\xF7") # If you're sending a multiblock sysex, the first block should # be a sysex_f0, all subsequent blocks should be sysex_f7's, # of which the last block needs a F7 at the end. my $s = $event[2]; $s =~ s/^([^\xF0])/\xF0$1/; return ( SND_SEQ_EVENT_SYSEX, SND_SEQ_TIME_STAMP_REAL, 0, 0, $time_in_secs, [ 0,0 ], [ 0,0 ], [ $s, ] ); } elsif ($event[0] eq 'sysex_f7') { # If you're sending a multiblock sysex, the first block should # be a sysex_f0, all subsequent blocks should be sysex_f7's, # of which the last block needs a F7 at the end. # You can also use a sysex_f7 to sneak in a MIDI command that # cannot be otherwise specified in .mid files, such as System # Common messages except SysEx, or System Realtime messages. # E.g., you can output a MIDI Tune-Request message (F6) by # ('sysex_f7', , "\xF6") which will put the event # " F7 01 F6" into the .mid file, and hence the # byte F6 onto the wire. return ( SND_SEQ_EVENT_SYSEX, SND_SEQ_TIME_STAMP_REAL, 0, 0, $time_in_secs, [ 0,0 ], [ 0,0 ], [ $event[2], ] ); } else { # Meta-event, or unsupported event return undef; } } # 1.03 sub listclients { return &xs_listclients(0); } sub listnumports { # returns (14->2,20->1,128->4) return &xs_listclients(1); } sub listconnectedto { # returns ([0,14,1], [1,20,0]) my @flat = &xs_listconnections(0); my @lol = (); my $ifl = $[; my $ilol = $[; while ($ifl < $#flat) { push @{$lol[$ilol]}, 0+$flat[$ifl]; $ifl += 1; push @{$lol[$ilol]}, 0+$flat[$ifl]; $ifl += 1; push @{$lol[$ilol]}, 0+$flat[$ifl]; $ifl += 1; $ilol += 1; } return @lol; } sub listconnectedfrom { # returns ([1,32,0], [0,36,0]) my @flat = &xs_listconnections(1); my @lol = (); my $ifl = $[; my $ilol = $[; while ($ifl < $#flat) { push @{$lol[$ilol]}, 0+$flat[$ifl]; $ifl += 1; push @{$lol[$ilol]}, 0+$flat[$ifl]; $ifl += 1; push @{$lol[$ilol]}, 0+$flat[$ifl]; $ifl += 1; $ilol += 1; } return @lol; } 1; __END__ =pod =head1 NAME MIDI::ALSA - the ALSA library, plus some interface functions =head1 SYNOPSIS use MIDI::ALSA(':CONSTS'); MIDI::ALSA::client( 'Perl MIDI::ALSA client', 1, 1, 0 ); MIDI::ALSA::connectfrom( 0, 14, 0 ); # input port is lower (0) MIDI::ALSA::connectto( 1, 20, 0 ); # output port is higher (1) while (1) { my @alsaevent = MIDI::ALSA::input(); if ($alsaevent[0] == SND_SEQ_EVENT_PORT_UNSUBSCRIBED()) { last; } if ($alsaevent[0] == SND_SEQ_EVENT_NOTEON()) { my $channel = $alsaevent[7][0]; my $pitch = $alsaevent[7][1]; my $velocity = $alsaevent[7][2]; } elsif ($alsaevent[0] == SND_SEQ_EVENT_CONTROLLER()) { my $channel = $alsaevent[7][0]; my $controller = $alsaevent[7][4]; my $value = $alsaevent[7][5]; } MIDI::ALSA::output( @alsaevent ); } =head1 DESCRIPTION This module offers a Perl interface to the I library. It is a call-compatible translation into Perl of the Lua module I http://www.pjb.com.au/comp/lua/midialsa.html which is in turn based on the Python modules I and I by Patricio Paez. It also offers some functions to translate events from and to the event format used in Sean Burke's MIDI-Perl module. Nothing is exported by default, but all the functions and constants can be exported, e.g.: use MIDI::ALSA(client, connectfrom, connectto, id, input, output); use MIDI::ALSA(':CONSTS'); As from version 1.15, note durations are in seconds rather than milliseconds, for consistency with the timestamps. This introduces a backward incompatibility which only affects you if are putting together your own alsaevents without using the noteevent() function. In the worst case you have to detect versions: if ($MIDI::ALSA::VERSION < 1.145) { $alsevent[7][4] *= 1000; } =head1 FUNCTIONS Functions based on those in I: client(), connectfrom(), connectto(), disconnectfrom(), disconnectto(), fd(), id(), input(), inputpending(), output(), start(), status(), stop(), syncoutput() Functions based on those in I: noteevent(), noteonevent(), noteoffevent(), pgmchangeevent(), pitchbendevent(), controllerevent(), chanpress(), sysex() Functions to interface with I: alsa2scoreevent(), scoreevent2alsa() Functions to get the current ALSA status: listclients(), listnumports(), listconnectedto(), listconnectedfrom(), parse_address() =over 3 =item client($name, $ninputports, $noutputports, $createqueue) Create an ALSA sequencer client with zero or more input or output ports, and optionally a timing queue. ninputports and noutputports are created if the quantity requested is between 1 and 64 for each. If I = true, it creates a queue for stamping the arrival time of incoming events and scheduling future start times of outgoing events. For full ALSA functionality, the I<$name> should contain only letters, digits, underscores or spaces, and should contain at least one letter. Unlike in the I Python module, it returns success or failure. =item connectfrom( $inputport, $src_client, $src_port ) Connect from I to I. Each input port can connect from more than one client. The I() function will receive events from any intput port and any of the clients connected to each of them. Events from each client can be distinguised by their source field. Unlike in the I Python module, it returns success or failure. Since version 1.11, and unlike in the I Python module, if $src_client contains a letter or $src_port is undefined, then I automatically gets invoked. This allows you to refer to the clients by name, for example connectfrom($inputport,'Virtual:1') will connect from port 1 of the 'Virtual Raw MIDI' client. =item connectto( $outputport, $dest_client, $dest_port ) Connect I to I. Each output port can be Connected to more than one client. Events sent to an output port using the I() funtion will be sent to all clients that are connected to it using this function. Unlike in the I Python module, it returns success or failure. Since version 1.11, and unlike in the I Python module, if $dest_client contains a letter or $dest_port is undefined, then I automatically gets invoked. This allows you to refer to the clients by name, for example connectto($outputport,'Virtual:1') will connect to port 1 of the 'Virtual Raw MIDI' client. =item disconnectfrom( $inputport, $src_client, $src_port ) Disconnect the connection from the remote I to my I. Returns success or failure. Since version 1.11, and unlike in the I Python module, if $dest_client contains a letter or $dest_port is undefined, then I automatically gets invoked. This allows you to refer to the clients by name, for example disconnectfrom($inputport,'Virtual:1') will disconnect from port 1 of the 'Virtual Raw MIDI' client. =item disconnectto( $outputport, $dest_client, $dest_port ) Disconnect the connection from my I to the remote I. Returns success or failure. Since version 1.11, and unlike in the I Python module, if $dest_client contains a letter or $dest_port is undefined, then I automatically gets invoked. This allows you to refer to the clients by name, for example disconnectto($outputport,'Virtual:1') will disconnect to port 1 of the 'Virtual Raw MIDI' client. =item fd() Return fileno of sequencer. This piece of code, contributed by Daren Schwenke, uses the I module to build an application which waits both for ALSA events, and for user-input: my $alsa_midi = AnyEvent->io ( fh => MIDI::ALSA::fd(), poll => "r", cb => sub { my @alsaevent = MIDI::ALSA::input(); print "Alsa event: " . Dumper(\@alsaevent); } ); =item id() Return the client number, or 0 if the client is not yet created. =item input() Wait for an ALSA event in any of the input ports and return it. ALSA events are returned as an array with 8 elements: ($type, $flags, $tag, $queue, $time, \@source, \@destination, \@data) Unlike in the I Python module, the time element is in floating-point seconds. The last three elements are also arrays: @source = ( $src_client, $src_port ) @destination = ( $dest_client, $dest_port ) @data = ( varies depending on type ) The I and I arrays may be useful within an application for handling events differently according to their source or destination. The event-type constants, beginning with SND_SEQ_, are available as module subroutines with empty prototypes, not as strings, and must therefore be used without any dollar-sign e.g.: if ($event[0] == MIDI::ALSA::SND_SEQ_EVENT_PORT_UNSUBSCRIBED) { ... The data array is mostly as documented in http://alsa-project.org/alsa-doc/alsa-lib/seq.html. For NOTE events, the elements are ( $channel, $pitch, $velocity, unused, $duration ); where since version 1.15 the I is in floating-point seconds (unlike in the I Python module where it is in milliseconds). For SYSEX events, the data array contains just one element: the byte-string, including any F0 and F7 bytes. For most other events, the elements are ($channel, unused,unused,unused, $param, $value) The I element is always 0..15 In the SND_SEQ_EVENT_PITCHBEND event the I element is from -8192..+8191 (not 0..16383) If a connection terminates, then input() returns, and the next event will be of type SND_SEQ_EVENT_PORT_UNSUBSCRIBED Note that if the event is of type SND_SEQ_EVENT_PORT_SUBSCRIBED or SND_SEQ_EVENT_PORT_UNSUBSCRIBED, then that message has come from the System, and its I tells you which of your ports is involved. But its I and I do not tell you which other client disconnected; you'll need to use I or I to see what's happened. =item inputpending() Return the number of bytes available in input buffer. Use before input() to wait till an event is ready to be read. =item output($type,$flags,$tag,$queue,$time,\@source,\@destination,\@data) Send an ALSA-event from an output port. The format of the event is as discussed in input() above. The event will be output immediately either if no queue was created in the client or if the I parameter is set to SND_SEQ_QUEUE_DIRECT, and otherwise it will be queued and scheduled. The I<@source> is an array with two elements: ($src_client, $src_port), specifying the local output-port from which the event will be sent. If only one output-port exists, all events are sent from it. If two or more exist, the I<$src_port> determines which to use. The smallest available port-number (as created by I()) will be used if I<$src_port> is less than it, and the largest available will be used if I<$src_port> is greater than it. The I<@destination> is an array with two elements: ($dest_client, $dest_port), specifying the remote client/port to which the event will be sent. If I<$dest_client> is zero (as generated by I or I), or is the same as the local client (as generated by I), then the event will be sent to all clients that the local port is connected to (see I() and I). But if you set I to a remote client, then the event will be sent to that I and nowhere else. It is possible to send an event to a destination to which there is no connection, but it's not usually the right thing to do. Normally, you should set up a connection, to allow the underlying RawMIDI ports to remain open while playing - otherwise, ALSA will reset the port after every event. If the queue buffer is full, I() will wait until space is available to output the event. Use I() to know how many events are scheduled in the queue. If no queue has been started, a SND_SEQ_EVENT_NOTE event can only emerge as a SND_SEQ_EVENT_NOTEON, since a queue is necessary in order to schedule the corresponding NOTEOFF. =item start() Start the queue. It is ignored if the client does not have a queue. =item status() Return ($status,$time,$events ) of the queue. Status: 0 if stopped, 1 if running. Time: current time in seconds. Events: number of output events scheduled in the queue. If the client does not have a queue then (0,0,0) is returned. Unlike in the I Python module, the I

ort I<128:0>, or into the I client.. It does this by using the I Perl CPAN module. When I exits the connection is automatically deleted. This option allows I to use the same port-specification as the other alsa-utils, e.g. I and I. An ALSA-port is specified by its number; for port 0 of a client, the ":0" part of the port specification can be omitted. The output port is taken from the I environment variable if none is given on the command line. Since Version 5.0, you may supply a comma-separated list of ports, e.g. I<-o 20,128:1> Since Version 5.4, the particular port value zero e.g. I<-o 0> is taken as an instruction to not connect to anything at all. This is useful if you want the output to go into another program like I or I; you no longer have to go through a MIDI-Through client. In separate Is: midikbd -o 0 and then midiecho -i midikbd -c 0 -d 250,450 -s 45 -e 1,2 =item I<-ka> or I<-kd> or I<-kh> or I<-kp> or I<-kw> =item I<-k augmented> or I<-k drumkit> etc. Selects the Beymap: possible keymaps are I (the default), I, I, I and I. All keymappings are aimed at the US-keyboard; this could be seen as a bug. The I keymap is particularly good for improvisation. The I keymap preselects Channel 9; in this mode, it is pointless to change the Patch or the Transposition. The I keymap is sort of inspired by accordion buttons, and makes it very easy to play major and minor triads; this is unfortunately not very useful as I is only monophonic, which could also be seen as a bug. the "piano" keymap (bottom 2 rows round middleC, top 2 treble clef): 1 2 3 5 6 8 9 0 = Back F F# G G# A Bb B C C# D Eb E F F# G G# A Bb B c c# d eb e Tab q w e r t y u i o p [ ] \ s d g h j l ; C C# D Eb E F F# G G# A Bb B C C# D Eb E z x c v b n m , . / the "wholetone" keymap (bottom 2 rows bass, top 2 treble): ` 1 2 3 4 5 6 7 8 9 0 - = Back G G# A Bb B C C# D Eb E F F# G G# A Bb B c c# d eb e f f# g g# a bb Tab q w e r t y u i o p [ ] \ a s d f g h j k l ; ' B_ C C# D Eb E F F# G G# A Bb B C C# D Eb E F F# G z x c v b n m , . / the "augmented" keymap (all 4 rows, starting from top left): ` 1 2 3 4 5 6 7 8 9 0 - = Back Bb C E G# C E G# c e g# c e g a Tab q w e r t y u i o p [ ] \ B C# F A C# F A c# f a c# f g# bb a s d f g h j k l ; ' D F# Bb D F# Bb d f# bb d f# z x c v b n m , . / Eb G B Eb G B eb g b eb the "harmonic" keymap (rightwards, alternate maj and min 3rds): 1 2 3 4 5 6 7 8 9 0 - = Back Eb Bb G D Bb F D A F C A E C G E B G D B F# D A F# C# A q w e r t y u i o p [ ] a s d f g h j k l ; ' F C A E C G E B G D B F# D A F# C# A E C# G# E z x c v b n m , . / the "drumkit" keymap (for General-MIDI channel 9): Perc 1 2 3 4 5 6 7 8 9 0 - = Congas HiHat q w e r t y u i o p [ ] Cymbals Snare a s d f g h j k l ; ' TomToms Metronome z x c v b n m , . BassDrums =item I<-q> Buiet mode: doesn't display keystroke help =item I<-h> Prints Belpful usage information. =item I<-v> Prints Bersion number. =back =head1 CHANNELSPEC After the options, the remaining command-line arguments are ChannelSpecs, which specify how the MIDI-Channels are to be set up. For example: B< 5> This first example preselects Bhannel number 5 (out of 0..15). B< 5:91:120 4:14:120 3:91:8 2:14:8 1:91:64 0:14:64> The second example sets up I on a number of channels, and leaves I playing on the last channel mentioned. A list of General-MIDI Patch-numbers is at http://www.pjb.com.au/muscript/gm.html#patch in separate xterm's: midikbd -o 0 5:91:120 4:14:120 3:91:8 2:14:8 1:29:64 0:14:64 & and midiecho -i midikbd -d 1,2200,2201,4400,4401 -q 5 -e 1,2,3,4,5 B< 3:91:y0 2:92:y-0 1:93:x-10 0:94:x10> The third example uses mouse movement X,Y within its window to drive MIDI-controllers, with an B or a B followed by a Controller-number. A list of MIDI-Controller numbers is at http://www.pjb.com.au/muscript/gm.html#cc and if the number is preceded by a minus sign then I reverses the direction of drive, so that right- or up-motions decrease the parameter rather than increase it as they do normally. Controller number zero is re-interpreted by I to mean Pitch-Bend, which is not technically a real MIDI-controller, but is very useful. (The real MIDI-controller number zero is a Bank-Select, which is a slow and discontinuous operation not useful under a mouse.) B This fourth example leaves I transmitting to patch 94 on channel 0, after having set patch 91 on channel 3, and 92 on 2, and 93 on channel 1; and the X-motions of the mouse cross-fade from patch 93 to 94, and the Y-motions raise and lower patches 91 and 92 in opposite directions. Previously, in a different I, you have to be running: midiecho -i 14 -d 1,1,1 -s 1,1,1 -e 1,2,3 to duplicate channel 0 onto channels 1,2, and 3 (very wild :-). I detects mouse-motion events from the I, by using the DECSET SET_ANY_EVENT_MOUSE command: \e[?1003h (An earlier version ran I and parsed its output). =head1 SUPERSEDED OPTIONS =over 3 =item I<-p> Specifies the output ALSA-port. Just use B<-o> instead. =item I<-C> Preselect the MIDI-channel.Just specify the I arguments after the options on the command-line. =item I<-P 32> Preselects B

atch number 32 on whatever the current channel is. This option is superseded by the I arguments. =back =head1 CHANGES 20150603 5.8 X and Y mouse-control of pitchwheel displayed helpfully 20150531 5.7 X and Y mouse-control fixed 20150529 5.6 UI change: F1-F4=Una/Tre F5-F8=Sos/*Sos F9-F12=Ped 20150528 5.5 the Synopsis responds to Pedal on/off 20130225 5.4 -o 0 doesn't connect to anything 20120407 5.3 the Y-controller works correctly 20120401 5.2 changing the X- or Y-controller is displayed correctly 20111103 5.1 use the new MIDI-ALSA 1.11 to handle portnames 20111028 5.0 OutputPort can be a comma-separated list 20110917 4.9 Pan controlled by mouse is not falsely displayed 20110620 4.8 drumkit offers z,x = metronome 20110509 4.7 quit from drumkit mode cleans up screen properly 20110414 4.6 keystroke A changes ALSA connections 20110321 4.5 now uses MIDI::ALSA, not writing to /dev/snd/midi* 20101213 4.4 display more compact; Controllers now displayed 20101117 4.3 keystrokes X and Y map X and Y mouse at run-time 20101017 4.2 keystroke M sets MIDI-Controller 20101017 4.2 AutoPan is cancelled by Pan, but still unimplemented 20100819 4.1 CursorRow set correctly for drumkit keymap 20100419 4.0 -C deprecated, -p and -d subsumed into -o 20100417 3.6 X and Y mouse movements govern controllers 20100402 3.5 F1,F2 take new pedal; F3,F4 remove pedal 20100326 3.4 -C accepts the Channel:Patch:Pan format 20100325 3.3 handles multiple -C nn -P nn -C nn -P nn settings 20100325 3.2 Left&Right pan; U&D transpose, Up&Down vol 20100318 3.1 -d - outputs to stdout, e.g. to pipe into midiecho -i - 20100215 3.0 -C and -P, and -p now means ALSA-port 20100206 2.9 augmented keymapping 20100202 2.8 uses aconnect to show "connected to" info for virmidi 20100202 2.7 -d option 20100130 2.6 in drumkit mode, no Channel, Patch or Transpose 20100130 2.5 fixed -h option 20100130 2.4 drumkit keymapping 20100129 2.3 piano, wholetone and harmonic keymappings; -k option 20100128 2.2 Quiet mode: doesn't display keystroke help 20100127 2.1 display_note() 20100127 2.0 different key2note mapping, starting from z=C 20100126 1.9 bug fixed with note-off for bass c 20100126 1.8 End = sounds off, Home = reset controllers 20100126 1.7 looks through /dev/snd for midiC* files 20100126 1.6 remembers Patch per Channel 20100125 1.5 proper little Clui-style state display 20100125 1.4 Left and Right arrows change volume 20100125 1.3 the -p option works 20100125 1.2 sub note_off; channel change stops last note 20100125 1.1 PageUp,PageDown,Up,Down change transpose 20100125 P changes patch, C changes channel 20100124 1.0 first working version =head1 AUTHOR Peter J Billam http://www.pjb.com.au/comp/contact.html =head1 REQUIREMENTS Uses the CPAN modules Term::ReadKey and MIDI::ASLA. =head1 SEE ALSO Term::ReadKey MIDI::ALSA http://www.pjb.com.au/midi http://www.pjb.com.au/muscript/gm.html http://vmpk.sourceforge.net perl(1). =cut MIDI-ALSA-1.22/examples/midiecho0000755000076400017500000011745413007532624014355 0ustar pjbpjb#! /usr/bin/perl ######################################################################### # This Perl script is Copyright (c) 2006, Peter J Billam # # c/o P J B Computing, GPO Box 669, Hobart TAS 7001, Australia # # # # This script is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### # Simulates (very roughly) a tape-delay echo on a particular MIDI-channel # in a MIDI-file, or, since 2.0. on real-time-MIDI, # by issuing repeated note_on events with diminishing volume. YMMV! use Term::ReadKey; use bytes; my $Version = '4.5'; # -E specifies which controllers get echoed my $VersionDate = '13jun2016'; my %Channel = ('0',1); # MIDI channel on which the echoes will be added my %EchoNotes = (); # MIDI notes to which the echoes will be added my @Delays = (300); # incremental milliseconds of the various delays my @Echoes = (); # the channels that the echoes will be sent to my @PitchChanges = (0); # the pitch-changes of the various channels my %PitchWheel = (); # pitch_wheel, -1..+1 semitones, -4095..+4096 my @PitchDelta = (); # int(PitchChange/100) added to note-pitch my @Patches = (); # the Patches that the echo-channels will be set to my @Softenings = (25); # decremental velocites (loudness) of the echoes my %DoEchoCC = map {$_,1} (1,5,11,64,65,66,84); # do echo Modulation,Portamento,Expression and Pedals my $Debug = 0; my $AlsaName = "midiecho pid=$$"; # 4.3 for -N option # no display in real-time-mode; for use in background, and in scripts: my $Quiet = 0; my $RealTimeMode = 0; my $InputPort = q{}; my $OutputPort = q{}; my $E_option = 0; # vt100 globals my $CursorRow = 7; my $Irow = 1; my $Icol = 1; my $MidCol = 32; # use Data::Dumper; # to send the event array from parent to child use Time::HiRes; # check format of options args... while ($ARGV[$[] =~ /^-(\w)/) { if ($1 eq 'v') { shift; my $n = $0; $n =~ s{^.*/([^/]+)$}{$1}; print "$n version $Version $VersionDate\n"; exit 0; } elsif ($1 eq 'c') { shift; %Channel = (); my $a = shift; if ($a !~ /^\d[\d,]*$/) { die "bad -c arg: $a\n"; } foreach (split (',', $a)) { $Channel{$_} = 1; } } elsif ($1 eq 'd') { shift; my $a = shift; if ($a !~ /^\d[\d,]*$/) { die "bad -d arg: $a\n"; } @Delays = split (',', $a); # 4.2 don't sort ! } elsif ($1 eq 'e') { shift; my $a = shift; if ($a !~ /^\d[\d,]*$/) { die "bad -e arg: $a\n"; } @Echoes = split (',', $a); } elsif ($1 eq 'E') { shift; my $a = shift; if ($a !~ /^\d[\d,]*$/) { die "bad -E arg: $a\n"; } %DoEchoCC = map { $_, 1 } split (',', $a); $E_option = 1; } elsif ($1 eq 'p') { shift; my $a = shift; if ($a !~ /^[\d,]*$/) { die "bad -p arg: $a\n"; } @Patches = split (',', $a); } elsif ($1 eq 'w') { shift; # 3.1 my $a = shift; if ($a !~ /^[-\d,]*$/) { die "bad -w arg: $a\n"; } @PitchChanges = split (',', $a); } elsif ($1 eq 's' or $1 eq 'q') { shift; my $a = shift; if ($a !~ /^\d[\d,]*$/) { die "bad -s arg: $a\n"; } @Softenings = split (',', $a); } elsif ($1 eq 'n') { shift; my $a = shift; if ($a !~ /^\d[\d,]*$/) { die "bad -n arg: $a\n"; } shift; foreach (split (',', $a)) { $EchoNotes{$_} = 1; } } elsif ($1 eq 'i') { shift; $RealTimeMode = 1; $InputPort = shift; } elsif ($1 eq 'o') { shift; $RealTimeMode = 1; $OutputPort = shift; } elsif ($1 eq 'N') { shift; # 4.3 $AlsaName = shift; } elsif ($1 eq 'Q') { shift; $Quiet = 1; } elsif ($1 eq 'D') { shift; $Debug = 1; } else { my $n = $0; $n =~ s#^.*/([^/]+)$#$1#; print "usage:\n"; my $synopsis = 0; while () { if (/^=head1 SYNOPSIS/) { push @Synopsis,$_; $synopsis=1; next; } if ($synopsis && /^=head1/) { last; } if ($synopsis) { print $_; next; } } exit 1; } } # pre-extend @Softenings @Echoes and @PitchChanges to same length as @Delays my $i=$[; while (1) { last if ($i > $#Delays); if ($Delays[$i] < 1) { $Delays[$i] = 1; } # 1.6; delay=0 causes midi chaos $i++; } $i=$[; while (1) { last if ($i > $#Delays); if (!defined $Softenings[$i]) { $Softenings[$i] = $Softenings[$i-1]; } $i++; } $#Softenings = $#Delays; # if (@Echoes) { { my $i=$[; while (1) { last if ($i > $#Delays); my @c = sort keys %Channel; if (!defined $Echoes[$i]) { $Echoes[$i] = $c[$[] or 0; } $i++; } } $#Echoes = $#Delays; @Echoes = map { 0+$_ } @Echoes; # 3.5 if (@PitchChanges) { my $i=$[; while (1) { last if ($i > $#PitchChanges); if (defined $PitchChanges[$i]) { # 3.1 $PitchDelta[$i] = int ($PitchChanges[$i]/100); # 4.0 $PitchWheel{$Echoes[$i]} = int (40.96 * ($PitchChanges[$i]-100*$PitchDelta[$i])); # %PitchWheel is not so clear, because it's a cc10= } $i++; } } $#PitchChanges = $#Delays; $#PitchDelta = $#Delays; if ($RealTimeMode) { eval 'require MIDI::ALSA'; if ($@) { die "you need to install the MIDI::ALSA module from www.cpan.org\n"; } if (! defined $OutputPort) { $OutputPort = $ENV{'ALSA_OUTPUT_PORTS'}; } if (! defined $OutputPort) { # 4.4 warn "OutputPort not specified and ALSA_OUTPUT_PORTS not set\n"; } if ($Quiet and !$InputPort) { # 3.1 die "in -Q Quiet-mode you must specify the -i InputPort\n"; } MIDI::ALSA::client( $AlsaName, 1, 1, 1 ); foreach my $cl_po (split /,/, $InputPort) { # 3.6 if ($cl_po ne '0' and ! MIDI::ALSA::connectfrom(0, $cl_po)) { # 4.4 die "can't connect from ALSA client $cl_po\n"; } } foreach my $cl_po (split /,/, $OutputPort) { # 3.6 if ($cl_po ne '0' and ! MIDI::ALSA::connectto(1, $cl_po)) { # 4.4 die "can't connect to ALSA client $cl_po\n"; } } if (! MIDI::ALSA::start()) { die "can't start the queue of the ALSA client\n"; } $CursorRow = default_cursor_row(); display_alsa(); display_channel(); display_keystrokes(); display_echoes(); # output the patch-change events on the channels that need them #warn "Patches=@Patches\n"; foreach my $i_echo ($[ .. $#Patches) { MIDI::ALSA::output(MIDI::ALSA::pgmchangeevent( $Echoes[$i_echo],$Patches[$i_echo],)); #warn "pgmchangeevent($Echoes[$i_echo],$Patches[$i_echo],)\n"; } # output the pitch-change events on the channels that need them foreach my $channel (keys %PitchWheel) { my $change = $PitchWheel{$channel}; MIDI::ALSA::output(MIDI::ALSA::pitchbendevent($channel,$change,)); # if abs(cents)>100 (e.g. cents==1200) then we keep track # of that in @PitchDelta and add it into the note events! } # How can we respond to keystrokes as well as to alsaevents? # defined ($key = ReadKey(-1)) tests if a char is waiting, # MIDI::ALSA::inputpending() tests if an alsaevent is waiting, # but how do we just sit there waiting for the next of either ? # I don't want to do an ugly 1ms-loop ... # The plan is to use Up/Down to select an Echo, then offering keystrokes # (all case-insensitive, for ergonomics _and_ comptibility with midikbd) # but how to respond to both keystrokes and alsaevents? # Could fork a ReadKey process which writes the char to its stdout, then # sends a signal to the parent process where a handler reads the char ? # Alternatively, the child could do all the user-interface and # the parent just run as an ALSA client. But no, the UI and the # resulting manipluations on the midi are tightly linked in the app; # so the parent should do both, and the child just getc and signal. # The child should have a 1-sec-timeout read, so the parent # can update its "Connected to|from" lines every second # or so; this again is an app-related functionality. # Attempts with no signalling (so each process updates the screen) # will interrupt each other's dialogues; except if you could set # up a "I'm in the middle of a dialogue" lock-flag on the UI. # AHA... The parent would like to run choose() and ask() as part # of its UI; but the parent _can't_, because it must keep the # midi-loop going. Therefore either the parent has to pass # sophisticated requests to the child (like choose and ask) # or the child has to run the whole UI and pass somewhat # sophisticated data back to the parent, like setting variables; # this is probably best because it's one-way: $Delay[3]=480; if (! $Quiet) { # 3.1 my $parent_pid = $$; my $child_pid = open(CHILD_STDOUT, "-|"); sub handle_child_output { my $cmd = ; eval $cmd; if ($@) { warn "can't eval $cmd $@\n"; } } if (! $child_pid) { # The child does all the UI while (1) { ReadMode(4, STDIN); my $c = ReadKey(0, STDIN); if ($c =~ /^\e$/) { # reduce an escape sequence to just 1 char $c = ReadKey(0, STDIN); if ($c eq '[') { $c = ReadKey(0, STDIN); if ($c =~ /^\d$/) { # e.g. Delete; throw away the ~ my $tilde = ReadKey(0, STDIN); } } } if ($c =~ /^q$/i) { $CursorRow = default_cursor_row(); gotoxy(1, $CursorRow); display_keystrokes('quit'); ReadMode(0, STDIN); print STDOUT "wait; exit;\n"; kill 'HUP', $parent_pid; exit; } if ($c eq 'A') { # Up if ($CursorRow > 2) { $CursorRow -= 1; gotoxy(1, $CursorRow); display_keystrokes(); } } elsif ($c eq 'B') { # Down if ($CursorRow < default_cursor_row()) { $CursorRow += 1; gotoxy(1, $CursorRow); display_keystrokes(); } } elsif ($c eq '3') { # Delete } elsif ($c eq 'c' and $CursorRow == 4) { # change dry-channel my $ch = get_int('apply echo to which channel'); if (defined $ch) { %Channel = ($ch, 1); print STDOUT "%Channel = ($ch, 1);\n"; kill 'HUP', $parent_pid; } display_channel(); } elsif ($c eq 'n' and $CursorRow == default_cursor_row()) { push @Delays,350; push @Softenings,25; push @Echoes,0; print STDOUT 'push @Delays,350; ' .'push @Softenings,25; push @Echoes,0;'."\n"; kill 'HUP', $parent_pid; display_echoes(); display_keystrokes(); } elsif ($CursorRow > 4 and $CursorRow < default_cursor_row()) { my $i_echo = $CursorRow-5+$[; if ($c eq 'c') { # change an echo-channel my $ch = get_int('send echo to which channel'); if (defined $ch) { $Echoes[$i_echo] = $ch; print STDOUT "\$Echoes[$i_echo] = $ch;\n"; kill 'HUP', $parent_pid; } display_echoes(); display_keystrokes(); } elsif ($c eq 'd') { # change an echo-delay my $d = get_int('delay in millisecs'); if (defined $d) { $Delays[$i_echo] = $d; print STDOUT "\$Delays[$i_echo] = $d;\n"; kill 'HUP', $parent_pid; } display_echoes(); display_keystrokes(); } elsif ($c eq 'n' and $CursorRow > 4) { # a New echo splice @Delays,$i_echo,0,350; splice @Softenings,$i_echo,0,25; splice @Echoes,$i_echo,0,0; splice @Patches,$i_echo,0,undef; print STDOUT "splice \@Delays,$i_echo,0,350; " . "splice \@Softenings,$i_echo,0,25; " . "splice \@Echoes,$i_echo,0,0;\n"; kill 'HUP', $parent_pid; display_echoes(); display_keystrokes(); } elsif ($c eq 's') { # softer by how much my $d = get_int('softer by how much'); if (defined $d) { $Softenings[$i_echo] = $d; print STDOUT "\$Softenings[$i_echo] = $d;\n"; kill 'HUP', $parent_pid; } display_echoes(); display_keystrokes(); } elsif ($c eq 'p' and defined $Echoes[$i_echo]) { my $d = get_int('Patch'); if (defined $d) { $Patches[$i_echo] = $d; print STDOUT "MIDI::ALSA::output(MIDI::ALSA::" ."pgmchangeevent($Echoes[$i_echo],$d,));\n"; kill 'HUP', $parent_pid; } display_echoes(); display_keystrokes(); } elsif ($c eq 'w') { # MIDI-controller my $d = get_int('pitch-Wheel (cents)'); if (defined $d) { my $cha = $Echoes[$i_echo]; $PitchChanges[$i_echo] = $d; # for us, the child my $cmd = "\$PitchChanges[$i_echo] = $d; "; my $delta = int($d/100); $cmd .= "\$PitchDelta[$i_echo] = $delta; "; my $w = int (40.96 * ($d-100*$delta)); $PitchWheel{$cha} = $w; print STDOUT "$cmd MIDI::ALSA::output(MIDI::ALSA::" ."pitchbendevent($cha,$w,));\n"; kill 'HUP', $parent_pid; } display_echoes(); display_keystrokes(); } } # every second or so, the child should display_alsa() # print STDOUT "$cmd\n"; kill 'HUP', $parent_pid; } } $SIG{'HUP'} = \&handle_child_output; close STDIN; # end of child } # end of if(!$Quiet) while (1) { my @alsaevent = MIDI::ALSA::input(); if ($alsaevent[0] == MIDI::ALSA::SND_SEQ_EVENT_PORT_UNSUBSCRIBED() or $alsaevent[0] == MIDI::ALSA::SND_SEQ_EVENT_PORT_SUBSCRIBED()) { display_alsa(); # shit. The parent shouldn't be doing this :-( # we could signal HUP the child. But even then, that only # detects connects and disconnects on the input-port... # Probably the child should do display_alsa every second # This will become a big problem in a more general case :-( next; } # could detect a 0-delay arg and change the volume accordingly... MIDI::ALSA::output(@alsaevent); # direct dry output my ($is_running,$now,$nevents) = MIDI::ALSA::status(); # now output it, at all the various delays, to the right channels # Don't echo patch-change, or start of sysex, or pitchbend # (why not pitchbend, if it's going to a different channel ?) if ($alsaevent[0] == MIDI::ALSA::SND_SEQ_EVENT_PGMCHANGE) { next; } if ($alsaevent[0] == MIDI::ALSA::SND_SEQ_EVENT_SYSEX) { next; } # noteon, noteoff, pitch_wheel, controller, pressure: my $cha = $alsaevent[$#alsaevent][0]; if (! $Channel{$cha}) { next; } if ($alsaevent[0] == MIDI::ALSA::SND_SEQ_EVENT_CONTROLLER()) { # 3.4 my $cc = $alsaevent[7][4]; if (!$DoEchoCC{$cc}) { next; } } if ($alsaevent[0] == MIDI::ALSA::SND_SEQ_EVENT_NOTEON() or $alsaevent[0] == MIDI::ALSA::SND_SEQ_EVENT_NOTEOFF()) { my $note = $alsaevent[$#alsaevent][1]; if (%EchoNotes and !$EchoNotes{"$note"}) { next; } } my %already = (0+$cha, 1); # 3.5 $alsaevent[3] = 0; # reset "queue" my $cumulative_delay = 0; my $dry_note = $alsaevent[$#alsaevent][1]; foreach my $j ($[ .. $#Delays) { $cumulative_delay += $Delays[$j]/1000; my $secs = $now + $cumulative_delay; $alsaevent[4] = $secs; if (defined $Echoes[$j]) { # set the -e output-channel $alsaevent[$#alsaevent][0] = $Echoes[$j]; if ($alsaevent[0] == MIDI::ALSA::SND_SEQ_EVENT_PITCHBEND() or $alsaevent[0] == MIDI::ALSA::SND_SEQ_EVENT_CONTROLLER()) { if (! $already{$Echoes[$j]}) { # 3.5 MIDI::ALSA::output(@alsaevent); $already{$Echoes[$j]} = 1; } next; } } if ($alsaevent[0] == MIDI::ALSA::SND_SEQ_EVENT_NOTEON() or $alsaevent[0] == MIDI::ALSA::SND_SEQ_EVENT_NOTEOFF()) { my $quietenedvol = $alsaevent[$#alsaevent][2]; if ($quietenedvol > 0) { $quietenedvol -= $Softenings[$j]; if ($quietenedvol < 1) { $quietenedvol = 1; } $alsaevent[$#alsaevent][2] = $quietenedvol; } $alsaevent[$#alsaevent][1] = $dry_note + $PitchDelta[$j]; #4.0 my $rc = MIDI::ALSA::output(@alsaevent); } } } exit 0; # end of RealTime mode } #--------- RealTime UI and infrastructure, recycled from midikbd --------- sub display_alsa { return if $Quiet; @ConnectedTo = (); my $id = MIDI::ALSA::id(); foreach (MIDI::ALSA::listconnectedto()) { my @cl = @$_; push @ConnectedTo, "$cl[1]:$cl[2]" } @ConnectedFrom = (); foreach (MIDI::ALSA::listconnectedfrom()) { my @cl = @$_; push @ConnectedFrom, "$cl[1]:$cl[2]" } gotoxy(1,1); puts_30c("ALSA client $id"); gotoxy($MidCol,1); puts_clr("midiecho pid=$$"); my $s = "Input port $id:0 is "; if (@ConnectedFrom) { $s .= "connected from ".join(',',@ConnectedFrom); } else { $s .= "not connected from anything"; } gotoxy(1,2); puts_clr($s); my $s = "Ouput port $id:1 is "; if (@ConnectedTo) { $s .= "connected to ".join(',',@ConnectedTo); } else { $s .= "not connected to anything"; } gotoxy(1,3); puts_clr($s); gotoxy(1,$CursorRow); } sub display_channel { # %Channel # MIDI channel on which the echoes will be added # %EchoNotes # MIDI notes to which the echoes will be added return if $Quiet; my @c = sort keys %Channel; gotoxy(1,4); if (1 == @c) { puts("Echo is being applied to input channel $c[$[]"); } else { puts("Echo is being applied to input channels @c"); } gotoxy(1,$CursorRow); } sub display_echoes { return if $Quiet; my $i = 0; while ($i <= $#Delays) { my $s = "Delay $Delays[$i] ms"; if (defined $Echoes[$i]) { $s .= ", to Channel $Echoes[$i]"; } if ($Softenings[$i]) { $s .= ", Softer by $Softenings[$i]"; } if ($Patches[$i]) { $s .= ", Patch=$Patches[$i]"; } if ($PitchChanges[$i]) {$s.=", pitchWheel $PitchChanges[$i] cents";} gotoxy(1,5+$i); puts_clr($s); $i += 1; } # $CursorRow = 5+$i; gotoxy(1,default_cursor_row()); puts_clr(""); gotoxy(1,$CursorRow); } sub default_cursor_row { # The default CursorRow, beneath the Echos return 5+@Delays; } sub display_keystrokes { if ($Quiet) { return; } # or on the "Connected to" line, offer keystrokes: Delete, n=New # or on the "Connected from" line, offer keystrokes: Delete, n=New if ($CursorRow == 2) { # Input port $s = "Down, Delete, n=New"; } elsif ($CursorRow == 3) { # Output port $s = "Up, Down, Delete, n=New"; } elsif ($CursorRow == 4) { # Echo is applied to channel $s ="Up, Down, c=Channel"; } elsif ($_[$[] eq 'quit') { gotoxy(1, default_cursor_row()+2); puts_clr(''); gotoxy(1, default_cursor_row()); display_equivalent_cmd(); gotoxy(1, default_cursor_row()+1); puts_clr(''); return; } elsif ($CursorRow == default_cursor_row()) { gotoxy(1, default_cursor_row()+1); puts_clr("Up, n=New echo, q=Quit"); gotoxy(1, default_cursor_row()+2); display_equivalent_cmd(); gotoxy(1,$CursorRow); return; } else { # an echo # should not offer p=Patch if there is no Channel set $s = "Up, Down, Delete, n=New, d=Delay, c=Channel, s=Softer, " . "p=Patch, w=pitchWheel"; gotoxy(1, default_cursor_row()+2); display_equivalent_cmd(); } gotoxy(1, default_cursor_row()+1); puts_clr($s); gotoxy(1,$CursorRow); } sub display_equivalent_cmd { my @c = sort keys %Channel; my $s = "midiecho -c $c[$[] -d ".join(",",@Delays); if (@Echoes) { $s .= " -e ".join(",",@Echoes); } if ($E_option) { $s .= " -E ".join(",",sort keys %DoEchoCC); } $s .= " -s ".join(",",@Softenings); if (@Patches) { $s .= " -p ".join(",",@Patches); } if (@PitchChanges) { $s .= " -w ".join(",",@PitchChanges); } puts_clr($s); } sub get_int { my $s = $_[$[]; # this runs in the child my $min_int = 0; my $max_int = 127; if ($s =~ /channel/i) { $max_int = 15; } elsif ($s =~ /quiet/i) { $max_int = 50; } elsif ($s =~ /delay/i) { $max_int = 10000; } elsif ($s =~ /wheel/i) { $min_int = -2400; $max_int = 2400; } ReadMode(0, STDIN); my $int; while (1) { puts_clr("$s ($min_int..$max_int) ? "); $int = ; print STDERR "\e[A"; if ($int =~ /^-?[0-9]+$/ and $int >= $min_int and $int <= $max_int) { ReadMode(4, STDIN); return 0+$int; } if ($int =~ /^\s*$/) { ReadMode(4, STDIN); return undef; } } } # --------------- vt100 stuff, evolved from Term::Clui --------------- sub puts { my $s = join q{}, @_; $Irow += ($s =~ tr/\n/\n/); if ($s =~ /\r\n?$/) { $Icol = 0; } else { $Icol += length($s); # BUG, wrong on multiline strings! } # print STDERR "$s\e[K"; # and clear-to-eol # should be caller's responsibility ? or an option ? a different sub ? print STDERR $s; } sub puts_30c { my $s = $_[$[]; # assumes no newlines my $rest = 30-length($s); print STDERR $s, " "x$rest, "\e[D"x$rest; $Icol += length($s); } sub puts_clr { my $s = $_[$[]; # assumes no newlines my $rest = 30-length($s); print STDERR "$s\e[K"; $Icol += length($s); } sub clrtoeol { print STDERR "\e[K"; } sub up { # if ($_[$[] < 0) { down(0 - $_[$[]); return; } print STDERR "\e[A" x $_[$[]; $Irow -= $_[$[]; } sub down { # if ($_[$[] < 0) { up(0 - $_[$[]); return; } print STDERR "\n" x $_[$[]; $Irow += $_[$[]; } sub right { # if ($_[$[] < 0) { left(0 - $_[$[]); return; } print STDERR "\e[C" x $_[$[]; $Icol += $_[$[]; } sub left { # if ($_[$[] < 0) { right(0 - $_[$[]); return; } print STDERR "\e[D" x $_[$[]; $Icol -= $_[$[]; } sub gotoxy { my $newcol = shift; my $newrow = shift; if ($newcol == 0) { print STDERR "\r" ; $Icol = 0; } elsif ($newcol > $Icol) { right($newcol-$Icol); } elsif ($newcol < $Icol) { left($Icol-$newcol); } if ($newrow > $Irow) { down($newrow-$Irow); } elsif ($newrow < $Irow) { up($Irow-$newrow); } } # =================================================================== # we're in MIDI-file mode (not RealTime-mode) ... # 20120908 work in score form :-) eval 'require MIDI'; if ($@) { die "you'll need to install the MIDI::Perl module from www.cpan.org\n"; } import MIDI; my @Score = file2ms_score($ARGV[$[] || '-'); my @Track = @{$Score[$[+1]}; my @NewTrack = (); # my $Now = 1; foreach my $cha (keys %PitchWheel) { push @NewTrack, ['pitch_wheel_change',$Now,$cha,$PitchWheel{$cha}]; $Now = $Now + 1; } foreach my $i ($[..$#Patches) { # 3.9 push @NewTrack, ['patch_change',$Now,$Echoes[$i],$Patches[$i]]; $Now = $Now + 1; } foreach my $eventref (@Track) { push @NewTrack, $eventref; # straight-through my @event = @$eventref; if ($event[$[] eq 'note') { # this is a dry-note my ($evtype, $time, $duration, $cha, $note, $vol) = @event; if ($Channel{$cha} && (!%EchoNotes || $EchoNotes{$note})) { my $quietenedvol = $vol; my $cumulative_delay = 0; foreach my $i ($[ .. $#Delays) { my @new_event = ( @event ); # make a new copy $cumulative_delay += $Delays[$i]; $new_event[$[+1] = $time + $cumulative_delay; if (defined $Echoes[$i]) { $new_event[$[+3] = $Echoes[$i]; } else { $new_event[$[+3] = $cha; } $new_event[$[+4] = $note + $PitchDelta[$i]; $quietenedvol -= $Softenings[$i]; if ($quietenedvol < 1) { next; } $new_event[$[+5] = $quietenedvol; push @NewTrack, \@new_event; # time-order doesn't matter :-) } } } elsif ($event[$]] eq 'pitch_wheel_change') { my ($evtype, $time, $cha, $val) = @event; if ($Channel{$cha}) { my $cumulative_delay = 0; foreach my $i ($[ .. $#Delays) { my @new_event = ( @event ); # make a new copy $cumulative_delay += $Delays[$i]; $new_event[$[+1] = $time + $cumulative_delay; my $echocha = $cha; if (defined $Echoes[$i]) { $echocha = $Echoes[$i]; } $new_event[$[+2] = $echocha; if ($PitchWheel{$echocha}) { push @NewTrack, \@new_event; } } } } elsif ($event[$]] eq 'control_change') { my ($evtype, $time, $cha, $cc, $val) = @event; if ($Channel{$cha} and $DoEchoCC{$cc}) { my $cumulative_delay = 0; foreach my $i ($[ .. $#Delays) { my @new_event = ( @event ); # make a new copy $cumulative_delay += $Delays[$i]; $new_event[$[+1] = $time + $cumulative_delay; my $echocha = $cha; if (defined $Echoes[$i]) { $echocha = $Echoes[$i]; } $new_event[$[+2] = $echocha; push @NewTrack, \@new_event; } } } } score2file('-', 1000,\@NewTrack); #--------------------- Non-real-time infrastructure ------------------ # api_for_perl.txt - Peter Billam 2012 # # This bit of Perl code will wrap the CPAN MIDI module # http://search.cpan.org/perldoc?MIDI # so as to present a calling-interface compatible with the Lua module # http://www.pjb.com.au/comp/lua/MIDI.html # and the Python module # http://www.pjb.com.au/midi/MIDI.html # # This code is used in midisox_pl # http://www.pjb.com.au/midi/midisox.html # and in midiedit # http://www.pjb.com.au/midi/midiedit.html # # The original is at # http://www.pjb.com.au/midi/free/api_for_perl.txt #------------ MIDI infrastructure from midisox_pl ------------ sub round { my $x = $_[$[]; if ($x > 0.0) { return int ($x + 0.5); } if ($x < 0.0) { return int ($x - 0.5); } return 0; } sub deepcopy { use Storable; if (1 == @_ and ref($_[$[])) { return Storable::dclone($_[$[]); } else { my $b_ref = Storable::dclone(\@_); return @$b_ref; } } sub vol_mul { my $vol = $_[$[] || 100; my $mul = $_[$[+1] || 1.0; my $new_vol = round($vol*$mul); if ($new_vol < 0) { $new_vol = 0 - $new_vol; } if ($new_vol > 127) { $new_vol = 127; } elsif ($new_vol < 1) { $new_vol = 1; # some synths see vol=0 as default } return $new_vol; } #---------------------- Encoding stuff ----------------------- sub opus2file { my ($filename, @opus) = @_; my $format = 1; if (2 == @opus) { $format = 0; } my $cpan_opus = MIDI::Opus->new( {'format'=>$format, 'ticks' => 1000, 'tracks' => []}); my @list_of_tracks = (); my $itrack = $[+1; while ($itrack <= $#opus) { push @list_of_tracks, MIDI::Track->new({ 'type' => 'MTrk', 'events' => $opus[$itrack]}); $itrack += 1; } $cpan_opus->tracks(@list_of_tracks); if ($filename eq '-') { $cpan_opus->write_to_file( '>-' ); } elsif ($filename eq '-d') { $PID = fork; if ($PID) { eval "sub END { kill 'INT', $PID; wait;}"; $SIG{'HUP'} = sub { exit; }; } else { if (!open(P, '| aplaymidi -')) { die "can't run aplaymidi: $!\n"; } $cpan_opus->write_to_handle( *P{IO}, {} ); close P; exit 0; } } else { $cpan_opus->write_to_file($filename); } } sub score2opus { if (2 > @_) { return (1000, []); } my ($ticks, @tracks) = @_; my @opus = ($ticks,); my $itrack = $[; while ($itrack <= $#tracks) { my %time2events = (); foreach my $scoreevent_ref (@{$tracks[$itrack]}) { my @scoreevent = @{$scoreevent_ref}; if ($scoreevent[0] eq 'note') { my @note_on_event = ('note_on',$scoreevent[1], $scoreevent[3],$scoreevent[4],$scoreevent[5]); my @note_off_event = ('note_off',$scoreevent[1]+$scoreevent[2], $scoreevent[3],$scoreevent[4],$scoreevent[5]); if ($time2events{$note_on_event[1]}) { push @{$time2events{$note_on_event[1]}}, \@note_on_event; } else { @{$time2events{$note_on_event[1]}} = (\@note_on_event,); } if ($time2events{$note_off_event[1]}) { push @{$time2events{$note_off_event[1]}}, \@note_off_event; } else { @{$time2events{$note_off_event[1]}} = (\@note_off_event,); } } elsif ($time2events{$scoreevent[1]}) { push @{$time2events{$scoreevent[1]}}, \@scoreevent; } else { @{$time2events{$scoreevent[1]}} = (\@scoreevent,); } } my @sorted_events = (); # list of event_refs sorted by time for my $time (sort {$a <=> $b} keys %time2events) { push @sorted_events, @{$time2events{$time}}; } my $abs_time = 0; for my $event_ref (@sorted_events) { # convert abstimes => deltatimes my $delta_time = ${$event_ref}[1] - $abs_time; $abs_time = ${$event_ref}[1]; ${$event_ref}[1] = $delta_time; } push @opus, \@sorted_events; $itrack += 1; } return (@opus); } sub score2file { my ($filename, @score) = @_; my @opus = score2opus(@score); return opus2file($filename, @opus); } #--------------------------- Decoding stuff ------------------------ sub file2opus { my $opus_ref; if ($_[$[] eq '-') { $opus_ref = MIDI::Opus->new({'from_handle' => *STDIN{IO}}); } elsif ($_[$[] =~ /^[a-z]+:\//) { eval 'require LWP::Simple'; if ($@) { die "you need to install libwww-perl from www.cpan.org\n"; } $midi = LWP::Simple::get($_[$[]); if (! defined $midi) { die("can't fetch $_[$[]\n"); } open(P, '<', \$midi) or die("can't open FileHandle, need Perl5.8\n"); $opus_ref = MIDI::Opus->new({'from_handle' => *P{IO}}); close P; } else { $opus_ref = MIDI::Opus->new({'from_file' => $_[$[]}); } my @my_opus = (${$opus_ref}{'ticks'},); foreach my $track ($opus_ref->tracks) { push @my_opus, $track->events_r; } return (@my_opus); } sub opus2score { my ($ticks, @opus_tracks) = @_; if (!@opus_tracks) { return (1000,[],); } my @score = ($ticks,); my @tracks = deepcopy(@opus_tracks); # couple of slices probably quicker... foreach my $opus_track_ref (@tracks) { my $ticks_so_far = 0; my @score_track = (); my %chapitch2note_on_events = (); # 4.4 XXX!!! Must be by Channel !! foreach $opus_event_ref (@{$opus_track_ref}) { my @opus_event = @{$opus_event_ref}; $ticks_so_far += $opus_event[1]; if ($opus_event[0] eq 'note_off' or ($opus_event[0] eq 'note_on' and $opus_event[4]==0)) { # YY my $cha = $opus_event[2]; my $pitch = $opus_event[3]; my $key = $cha*128 + $pitch; if ($chapitch2note_on_events{$key}) { my $new_event_ref = shift @{$chapitch2note_on_events{$key}}; ${$new_event_ref}[2] = $ticks_so_far - ${$new_event_ref}[1]; push @score_track, $new_event_ref; } else { warn("note_off without a note_on, cha=$cha pitch=$pitch\n"); } } elsif ($opus_event[0] eq 'note_on') { my $cha = $opus_event[2]; # 4.4 my $pitch = $opus_event[3]; my $new_event_ref = ['note', $ticks_so_far, 0, $cha, $pitch, $opus_event[4]]; my $key = $cha*128 + $pitch; push @{$chapitch2note_on_events{$key}}, $new_event_ref; } else { $opus_event[1] = $ticks_so_far; push @score_track, \@opus_event; } } # 4.7 check for unterminated notes, see: ~/lua/lib/MIDI.lua while (my ($k1,$v1) = each %chapitch2note_on_events) { foreach my $new_e_ref (@{$v1}) { ${$new_e_ref}[2] = $ticks_so_far - ${$new_e_ref}[1]; push @score_track, $new_e_ref; warn("opus2score: note_on with no note_off cha=" . ${$new_e_ref}[3] . ' pitch=' . ${$new_e_ref}[4] . "; adding note_off at end\n"); } } push @score, \@score_track; } return @score; } sub file2score { return opus2score(file2opus($_[$[])); } sub file2ms_score { my @score = opus2score(to_millisecs(file2opus($_[$[]))); # must merge the tracks of a format-2 file; could perhaps even # extend the @event to indicate which Track it originated in... my $itrack = $#score; while ($itrack > ($[+1.5)) { foreach my $event_ref (@{$score[$itrack]}) { push @{$score[$[+1]}, $event_ref; # push them onto track 1 } $itrack -= 1; $#score = $itrack; # and jettison the last track } return @score; } #------------------------ Other Transformations --------------------- sub to_millisecs { my @old_opus = @_; if (!@old_opus) { return (1000,[],); } my $old_tpq = $_[$[]; my @new_opus = (1000,); my $millisec_per_old_tick = 1000.0 / $old_tpq; # float: will round later $itrack = $[+1; while ($itrack <= $#old_opus) { my $millisec_so_far = 0.0; my $previous_millisec_so_far = 0.0; my @new_track = (['set_tempo',0,1000000],); # new "crochet" is 1 sec foreach my $old_event_ref (@{$old_opus[$itrack]}) { my @old_event = @{$old_event_ref}; if ($old_event[0] eq 'note') { die "to_millisecs needs an opus, not a score\n"; } my @new_event = deepcopy(@old_event); # copy.deepcopy ? $millisec_so_far += ($millisec_per_old_tick * $old_event[1]); $new_event[1] = round($millisec_so_far-$previous_millisec_so_far); if ($old_event[0] eq 'set_tempo') { $millisec_per_old_tick = $old_event[2] / (1000.0 * $old_tpq); } else { $previous_millisec_so_far = $millisec_so_far; push @new_track, \@new_event; } } push @new_opus, \@new_track; $itrack += 1; } return @new_opus; } sub usecs { my ($secs, $usecs) = Time::HiRes::gettimeofday(); return 1000000*$secs + $usecs; } __END__ =pod =head1 NAME midiecho - Simulates tape-delay echo, on MIDI files or on real-time MIDI =head1 SYNOPSIS # on midi-files (e.g. *.mid ) : midiecho -c 3 fn # echo will be added to midi channel 3 midiecho -c 3 -d 450,450,450 fn # three echoes at 450 mS gaps midiecho -c 3 -d 450,450 -s 30 fn # each echo is (MIDI) 30 softer midiecho -c 2 -d 450 -e 5 -s 30 fn # the echo appears on channel 5 midiecho -c 3 -d 40 -e 4 -w 10 -s 0 # Automatic-Double-Tracking midiecho filename # defaults: midiecho -c 0 -d 300 -s 30 muscript -midi f.txt | midiecho -c 1 -d 300 -s 25 -e 2 >f.mid # on real-time (raw) midi : ~> xterm -g 80x16+1+1 -exec 'midiecho -i 32 -d 22 -c 3 -e 4' & ~> midiecho -i 32:0 -o 128:0 -c 3 -d 450,400 -e 4,5 ALSA client 129 midiecho pid=2157 Input port 129:0 is connected from 32:0 Ouput port 129:1 is connected to 128:0 Echo is being applied to input channel 3 Delay 450 ms, to Channel 4, Softer by 25 Delay 400 ms, to Channel 5, Softer by 25 _ Up, n=New echo, q=Quit midiecho -c 3 -d 450,400 -e 3,3 -s 25,25 http://www.pjb.com.au/midi/midiecho.html =head1 DESCRIPTION Simulates a tape-delay echo on a particular MIDI-channel by issuing repeated note_on events with diminishing volume. Since version 2.0, the -i and -o options allow I to work on real-time (raw) midi inputs, as well as on midi files. Midiecho sounds best if the -e option is used, to assign the echoes to different MIDI-channels; this avoids notes being restarted before they have finished. Without -e, I works much better on transient sounds, e.g. banjo, or snare-drum. If the -e option is not being used, then the echo note is played on the same channel as the original note. If this leaves your synth chopping of lots of notes (when the original note is not finished by the time the echo note starts), then your synth is probably stateless, and you should try invoking midiecho with the -S option. Since version 4.5, the -E option specifies the list of CC controllers which get echoed to the echo-channels. This is different from previous versions, in which the -E option did not work and was undocumented. Since version 2.6, the delays are incremental (since the previous delay) not absolute (since the original note); this is a bug-fix, but it was a well-established bug. Version 3.0 brings major changes, involving some loss of backward-compatibility. Since version 3.0: =over 3 =item * In real-time mode, the MIDI::ALSA module is used to create a proper ALSA client, so Virtual-MIDI clients are no longer needed. =item * The real-time mode now has a keyboard interface, allowing real-time adjustment of the delay parameters. If you don't want the interface (e.g. in a Makefile), the -Q option sets Quiet-mode. =item * The -d option specifies delays I in milliseconds since the previous signal, not in absolute milliseconds since the dry signal. =item * The -p option specifies the Patches of the various echoes, in the same order as they were given delays. =item * The former "Pitch" option is now called "Wheel" and is invoked by B<-w>; it allows the echo to be detuned (in 1/100's of a semitone) which makes possible an "Automatic Double-Tracking" effect. =item * The B<-m> option specifies MIDI-Controller settings of the various Echoes; midiecho -c 0 -d 300,300 -e 1,2 -p 0,74 -m cc10=15,cc10=103 This option is currently unimplemented. In this example, the echo on channel 1 is panned (MIDI-controller number 10) over to the left (cc10=15), and the echo on channel 2 is panned over to the right (cc10=103). =item * The B<-s> option replaces the -q option, because in the real-time mode keyboard interface B means quit. =back =head1 OPTIONS =over 3 =item I<-c 3> Echo will be added to midi Bhannel 3. The channels are numbered from 0...15 If -c is not specified, the default channel is 0. Currently, I can only add echoes to one channel at once; the other channels pass through unaltered. =item I<-d 350,300,250> The echo notes will be Belayed at gaps of 350, 300, and 250 mS, which means at 350, 300 and 250 mS after the previous. If -d is not specified, the default delay is just 300 mS =item I<-e 4,5,4> The Bchoes are produced not on the original (-c) channel but on the channels 4 then 5 then 4 again (in this example there are three echoes). This is a really useful option :-) As one example usage, you might have set up your synth's channel 4 and 5 with the same patch (instrumental sound) as the original channel (e.g. 3), but panned to different places in the stereo image. This creates a very realistic echo-effect. Another example usage could be to set up the echo-channels with a completely different sound, maybe something atmospheric or ethereal. Another example usage could be to set up the echo-channels with a different patch, and use a 1ms delay, thus doubling the original channel with a different sound. If the number of echo-channels (-e) is fewer than the number of delays in the -d list, then the last echo-channel is repeated as necessary. =item I<-n 38,40> Echo will be added only to midi Botes 38 and 40. This option is mainly useful with General-MIDI channel 9, which represents a drumkit, with each note representing a different drum, see http://www.pjb.com.au/muscript/gm.html#perc In this I<-c 9 -n 38,40> example, echoes would only be added to the Acoustic Snare and the Electric Snare sounds. =item I<-p 74,93> The channels specifed by the B<-e> option will be preset to use MIDI-Patches 74 and 93 (in this example). =item I<-w 8> The echo will be changed by the pitch-Bheel up 8 cents (hundredth's of a semitone). This can be used in conjunction with the B<-e>, B<-d> and B<-s> options to produce the "Automatic-Double-Tracking" effect, e.g. midiecho -c 3 -e 4 -d 40 -w -10 -s 0 which assumes that the original channel 3 is panned over to one extreme, and the echo-channel 4 is set up with the same patch but panned over the other way. It then produces an "echo" of the same volume and just 40mS late and just 10 cents lower. Because the two sounds are in different speakers they don't beat with each other, and sound almost like two instruments playing in unison. With larger parameters, it can be used to produce doubling at a large interval; e.g. I<-d 10 -w 1200> causes the original voice to be doubled (with a delay of 10ms) at the octave (1200 cents). =item I<-s 35,20> The first delayed note is 35 (MIDI) Bofter than the original, and the second is 20 softer still. If the number of softenings (-e) is fewer than the number of delays in the -d list, then the last softening is repeated as necessary. If an echo ends up with zero volume or less, then it is suppressed. If -s is not specified, by default each echo is 30 softer than the previous. =item I<-S> You'll need to use the -S option if you're not using -e, and if the sythesiser you're going to be using is Btateless. In other words, if the sythesiser does not keep a count of how many note_on's there have been on a given note, and switches the note off if receives even just one note_off command. So if your synth seems to be chopping off lots of notes, you should try invoking midiecho with the -S option. =item I<-i 32:0> or I<-i ProKeys> This option puts I into raw-midi (or real-time, or midi-on-the-wire) mode, and takes the midi-data from the specified port. The port is specified as an ALSA-port; you can check out the available ports with the command I or I. Since Version 3.6, you may supply a comma-separated list of ports, e.g. B<-i 28:0,32> =item I<-o 128:0> or I<-o TiMidity> This option puts I into raw-midi mode and sets the ouput-port to which the midi output will be sent. You can check out the available ports with the command I or I. The default ouput-port (if only B<-i> option is present) is the environment variable $ALSA_OUTPUT_PORTS Since Version 3.6, you may supply a comma-separated list of ports, e.g. B<-o Roland,128:1> =item I<-N my_echo_1> This option sets the ALSA Client-Name, to I in this example, that I will adopt if an I<-i> or I<-o> option is used to put it into raw-midi mode, This is useful if starting up I, or especially multiple Is, from a script which will then need to connect them to other ALSA clients. The default ALSA-name is I or whatever the pid is of the midiecho process. =back =head1 AUTHOR Peter J Billam http://www.pjb.com.au/comp/contact.html =head1 CREDITS Based on the MIDI::Perl CPAN module in midi-file mode, and the MIDI::ALSA CPAN module in real-time mode. =head1 SEE ALSO http://search.cpan.org/perldoc?MIDI http://search.cpan.org/perldoc?MIDI::ALSA http://www.pjb.com.au/muscript http://www.pjb.com.au/midi http://www.pjb.com.au/midi/midiedit.html http://www.pjb.com.au/midi/midithru.html =cut MIDI-ALSA-1.22/examples/midiclick0000755000076400017500000003020711654450725014521 0ustar pjbpjb#! /usr/bin/perl ######################################################################### # This Perl script is Copyright (c) 2011, Peter J Billam # # c/o P J B Computing, GPO Box 669, Hobart TAS 7001, Australia # # # # This script is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### # Simulates a metronome, on real-time MIDI, as an ALSA client use Term::ReadKey; use Time::HiRes; use bytes; my $Version = '1.4'; # use the new MIDI-ALSA 1.11 to handle portnames my $VersionDate = '03nov2011'; my $Tempo = 120; # beats per minute my $BarLength = 0; # beats per bar my $Volume = 100; # MIDI velocity 0..127 my $Debug = 0; my $Quiet = 0; # no display; for use in background, and in scripts my $Paused = 0; my $OutputPort = q{}; # vt100 globals my $CursorRow = 5; my $Irow = 1; my $Icol = 1; my $MidCol = 32; eval 'require MIDI::ALSA'; if ($@) { die "you'll need to install the MIDI-ALSA module from www.cpan.org\n"; } # check format of options args... while ($ARGV[$[] =~ /^-(\w)/) { if ($1 eq 'V') { shift; my $n = $0; $n =~ s{^.*/([^/]+)$}{$1}; print "$n version $Version $VersionDate\n"; exit 0; } elsif ($1 eq 't') { shift; my $a = shift; if ($a !~ /^\d[\d.]*$/) { die "bad -t arg: $a\n"; } $Tempo = 0 + $a; } elsif ($1 eq 'b') { shift; my $a = shift; if ($a !~ /^\d+$/) { die "bad -b arg: $a\n"; } $BarLength = 0 + $a; } elsif ($1 eq 'v') { shift; my $a = shift; if ($a !~ /^\d+$/) { die "bad -v arg: $a\n"; } $Volume = 0 + $a; if ($Volume < 1) { $Volume = 1; } elsif ($Volume > 127) { $Volume = 127; } } elsif ($1 eq 'o') { shift; $OutputPort = shift; } elsif ($1 eq 'p') { shift; $Paused = 1; } elsif ($1 eq 'Q') { shift; $Quiet = 1; } elsif ($1 eq 'D') { shift; $Debug = 1; } else { my $n = $0; $n =~ s#^.*/([^/]+)$#$1#; print "usage:\n"; my $synopsis = 0; while () { if (/^=head1 SYNOPSIS/) { push @Synopsis,$_; $synopsis=1; next; } if ($synopsis && /^=head1/) { last; } if ($synopsis) { print $_; next; } } exit 1; } } if ($Quiet) { $Paused = 0; } my $RealTimeMode = 1; # an anacronism from midiecho; we're always RealTime. if ($RealTimeMode) { eval 'require MIDI::ALSA'; if ($@) { die "you need to install the MIDI::ALSA module from www.cpan.org\n"; } #if ($OutputPort =~ /^$|^\d+(:\d)?(,\d+(:\d)?)*$/) { #} else { die "bad -o arg: $OutputPort\n"; #} if (! MIDI::ALSA::client( "midiclick pid=$$", 0, 1, 1 )) { die "can't create the MIDI::ALSA::client\n"; } if (!$OutputPort) { $OutputPort = $ENV{'ALSA_OUTPUT_PORTS'}; } if (!$OutputPort) { warn "OutputPort not specified and ALSA_OUTPUT_PORTS not set\n"; } foreach my $cl_po (split /,/, $OutputPort) { # 3.6 #$cl_po =~ /^(\d+):?(\d*)$/; #my $cl = $1; my $po = $2 or 0; #if ($cl == MIDI::ALSA::id()) { # die "can't connect to $cl_po, which is myself\n"; #} if (! MIDI::ALSA::connectto( 1, $cl_po )) { # 1.4 die "can't connect to ALSA client $cl_po\n"; } } if (! MIDI::ALSA::start()) { die "can't start the queue of the ALSA client\n"; } # system "aconnect -oil"; display_alsa(); display_keystrokes(); display_tempo(); display_paused(); display_volume(); # The child responds to keystrokes and the parent emits the alsaevents if (! $Quiet) { # 3.1 my $parent_pid = $$; my $child_pid = open(CHILD_STDOUT, "-|"); sub handle_child_output { my $cmd = ; eval $cmd; if ($@) { warn "can't eval $cmd $@\n"; } } if (! $child_pid) { # The child does all the UI while (1) { ReadMode(4, STDIN); my $c = ReadKey(0, STDIN); if ($c =~ /^\e$/) { # reduce an escape sequence to just 1 char $c = ReadKey(0, STDIN); if ($c eq '[') { $c = ReadKey(0, STDIN); if ($c =~ /^\d$/) { # e.g. Delete; throw away the ~ my $tilde = ReadKey(0, STDIN); } } } if ($c =~ /^q$/i) { gotoxy(1, $CursorRow); display_keystrokes('quit'); ReadMode(0, STDIN); print STDOUT "wait; exit;\n"; kill 'HUP', $parent_pid; exit; } if ($c eq 't') { my $ch = get_int('tempo (beats per minute) ?'); if (defined $ch) { $Tempo = $ch; print STDOUT "\$Tempo = $ch;\n"; kill 'HUP', $parent_pid; } display_tempo(); display_keystrokes(); } elsif ($c eq 'b') { my $d = get_int('bar length (in beats) ?'); if (defined $d) { $BarLength = $d; print STDOUT "\$BarLength = $d;\n"; kill 'HUP', $parent_pid; } display_tempo(); display_keystrokes(); } elsif ($c eq 'v') { my $d = get_int('volume ?'); if (defined $d) { $Volume = $d; print STDOUT "\$Volume = $d;\n"; kill 'HUP', $parent_pid; } display_volume(); display_keystrokes(); } elsif ($c eq ' ') { if ($Paused) { $Paused=0; } else { $Paused = 1; } print STDOUT "\$Paused = $Paused;\n"; kill 'HUP', $parent_pid; display_paused(); display_keystrokes(); } # every second or so, the child should display_alsa() # print STDOUT "$cmd\n"; kill 'HUP', $parent_pid; } } $SIG{'HUP'} = \&handle_child_output; close STDIN; # end of child } # end of if(!$Quiet) my $beat = 0; # 0 .. ($BarLength-1) my $next_click = 0; while (1) { # the parent... # on my system, sleep is interrupted by HUP... if ($Paused) { $beat = 0; Time::HiRes::sleep(10.0); next; } MIDI::ALSA::syncoutput(); my ($is_running,$now,$nevents) = MIDI::ALSA::status(); my $pitch = 33; if ($beat == 0 and $BarLength > 0) { $pitch = 34; } $next_click += 60/$Tempo; my @alsaevent=MIDI::ALSA::noteevent(9,$pitch,$Volume,$next_click,0.3); my $rc = MIDI::ALSA::output(@alsaevent); # HUP aborts this sleep, therefore must syncoutput as well; Time::HiRes::sleep(60/$Tempo); # but on its own, syncoutput lurches on BarLength change, not sure why $beat += 1; if ($beat >= $BarLength) { $beat = 0; } } exit 0; # end of RealTime mode } #--------- RealTime UI and infrastructure, recycled from midikbd --------- sub display_alsa { return if $Quiet; @ConnectedTo = (); my $id = MIDI::ALSA::id(); foreach (MIDI::ALSA::listconnectedto()) { my @cl = @$_; push @ConnectedTo, "$cl[1]:$cl[2]" } @ConnectedFrom = (); foreach (MIDI::ALSA::listconnectedfrom()) { my @cl = @$_; push @ConnectedFrom, "$cl[1]:$cl[2]" } gotoxy(1,1); puts_30c("ALSA client $id"); gotoxy($MidCol,1); puts_clr("midiclick pid=$$"); gotoxy(1,2); puts_clr($s); my $s = "Ouput port $id:0 is "; if (@ConnectedTo) { $s .= "connected to ".join(',',@ConnectedTo); } else { $s .= "not connected to anything"; } gotoxy(1,2); puts_clr($s); gotoxy(1,$CursorRow); } sub display_tempo { return if $Quiet; gotoxy(1,3); puts_30c("Tempo $Tempo beats/min"); gotoxy($MidCol,3); puts_clr("BarLength $BarLength beats"); gotoxy(1,$CursorRow); } sub display_paused { return if $Quiet; gotoxy(1,4); if ($Paused) { puts_30c("PAUSED"); } else { puts_30c("Playing"); } gotoxy(1,$CursorRow); } sub display_volume { return if $Quiet; gotoxy($MidCol,4); puts_clr("Volume $Volume"); gotoxy(1,$CursorRow); } sub display_keystrokes { my $arg = $_[$[]; if ($Quiet) { return; } my $s = " t=Tempo b=Barlength ="; if ($Paused) { $s .= "Play"; } else { $s .= "Pause"; } $s .= " v=Volume q=Quit" ; if ($arg eq 'quit') { $s = ''; gotoxy(1,4); puts_30c("Quit"); } gotoxy(1, $CursorRow+1); puts_clr($s); gotoxy(1,$CursorRow); } sub get_int { my $s = $_[$[]; # this runs in the child my $min_int = 0; my $max_int = 127; if ($s =~ /bar/i) { $max_int = 50; } elsif ($s =~ /tempo/i) { $min_int = 30; $max_int = 300; } elsif ($s =~ /output/i) { $min_int = 10; $max_int = 200; } ReadMode(0, STDIN); my $int; while (1) { puts_clr("$s ($min_int..$max_int) ? "); $int = ; print STDERR "\e[A"; $Icol = 1; if ($int =~ /^-?[0-9]+$/ and $int >= $min_int and $int <= $max_int) { ReadMode(4, STDIN); puts_clr(''); return 0+$int; } if ($int =~ /^\s*$/) { ReadMode(4, STDIN); puts_clr(''); return undef; } } } # --------------- vt100 stuff, evolved from Term::Clui --------------- sub puts { my $s = join q{}, @_; $Irow += ($s =~ tr/\n/\n/); if ($s =~ /\r\n?$/) { $Icol = 0; } else { $Icol += length($s); # BUG, wrong on multiline strings! } # print STDERR "$s\e[K"; # and clear-to-eol # should be caller's responsibility ? or an option ? a different sub ? print STDERR $s; } sub puts_30c { my $s = $_[$[]; # assumes no newlines my $rest = 30-length($s); print STDERR $s, " "x$rest, "\e[D"x$rest; $Icol += length($s); } sub puts_clr { my $s = $_[$[]; # assumes no newlines my $rest = 30-length($s); print STDERR "$s\e[K"; $Icol += length($s); } sub clrtoeol { print STDERR "\e[K"; } sub up { # if ($_[$[] < 0) { down(0 - $_[$[]); return; } print STDERR "\e[A" x $_[$[]; $Irow -= $_[$[]; } sub down { # if ($_[$[] < 0) { up(0 - $_[$[]); return; } print STDERR "\n" x $_[$[]; $Irow += $_[$[]; } sub right { # if ($_[$[] < 0) { left(0 - $_[$[]); return; } print STDERR "\e[C" x $_[$[]; $Icol += $_[$[]; } sub left { # if ($_[$[] < 0) { right(0 - $_[$[]); return; } print STDERR "\e[D" x $_[$[]; $Icol -= $_[$[]; } sub gotoxy { my $newcol = shift; my $newrow = shift; if ($newcol == 0) { print STDERR "\r" ; $Icol = 0; } elsif ($newcol > $Icol) { right($newcol-$Icol); } elsif ($newcol < $Icol) { left($Icol-$newcol); } if ($newrow > $Irow) { down($newrow-$Irow); } elsif ($newrow < $Irow) { up($Irow-$newrow); } } #sub usecs { # my ($secs, $usecs) = Time::HiRes::gettimeofday(); # return 1000000*$secs + $usecs; #} __END__ =pod =head1 NAME midiclick - generates a metronome click-track on MIDI channel 9 =head1 SYNOPSIS midiclick -t 108 # tempo is (starts at) 108 beats/min midiclick -t 108 -b 4 # Four beats in a bar midiclick -Q -t 108 -b 4 # Quiet mode; no User-Interface midiclick -o 14:1 -t 108 # Output to ALSA-port 14:1 midiclick -p # starts up in Paused mode xterm -geometry 80x7-1+1 -exec 'midiclick -t 165 -b 5' & ~> midiclick -o TiMidity -t 144 -b 5 -p ALSA client 129 midiclick pid=2157 Output port 129:1 is connected to 128:0 Tempo 144 beats/min BarLength 5 beats PAUSED Volume 100 _ t=Tempo b=Barlength =Play v=Volume q=Quit http://www.pjb.com.au/midi/midiclick.html =head1 DESCRIPTION The MIDI::ALSA module is used to create an ALSA client. The keyboard interface, allows real-time adjustment of the delay parameters. If you don't want the interface (e.g. in a Makefile), the -Q option sets Quiet-mode. =head1 OPTIONS =over 3 =item I<-t 72> The Tempo will be set; to 72 beats per minute in this example. The default is 120. =item I<-b 3> The Bar length will be set; the bell will sound every 3 beats in this example The default is 0, which means every beat clicks and there are no bells. =item I<-v 80> This option sets the Volume (or Velocity) of the midi output. The default is 100. =item I<-p> This option starts I in Paused state; you can then start it Playing with spacebar. This option is ignored in -Q Quiet mode. =item I<-o 128:0> or I<-o TiMidity> This option sets the ouput-port to which the midi output will be sent. You can check out the available ports with the command I or I. The default ouput-port is the environment variable $ALSA_OUTPUT_PORTS =item I<-Q> This option runs I in Quiet mode; there is no user-interface, and the metronome just runs with its Tempo and BarLength as given on the command-line, until it is interrupted. It can be useful in scripts. =item I<-V> This option displays the Version number. =back =head1 AUTHOR Peter J Billam http://www.pjb.com.au/comp/contact.html =head1 CREDITS Based on the MIDI::Perl CPAN module in midi-file mode, and the MIDI::ALSA CPAN module in real-time mode. =head1 SEE ALSO http://search.cpan.org/perldoc?MIDI http://search.cpan.org/perldoc?MIDI::ALSA http://www.pjb.com.au/muscript http://www.pjb.com.au/midi =cut MIDI-ALSA-1.22/examples/midiedit0000755000076400017500000025166313007532625014366 0ustar pjbpjb#! /usr/bin/perl ######################################################################### # This Perl script is Copyright (c) 2006, Peter J Billam # # c/o P J B Computing, GPO Box 669, Hobart TAS 7001, Australia # # # # This script is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### # 20151106 # 1) Sometimes after 'w' the w remains displayed at the end of the current line # 2) introduce a Buffer: ry=range-yank or rd=range-delete, then p=paste # 3) could display the patch of the current event, if there's room somewhere; # perhaps lower right, at the end of the hline() # 4) do we _need_ to store Now? und_do,re_do $Now=$Track[$Ievent][$[+1]+1; # # Could do: # Option -R = ReadOnly ? # When editing a note-pitch, midi-keyboard input could be accepted, perhaps # even without a p=pitch first. Should it also edit the v=velocity ? # u=undo seems to mess up deltatimes ? :-( # Not convincing, because of 'z' = all sounds off ... # It should be possible to choose, when moving times (arrows,page): # terminate on-notes, or not terminate on-notes. # Perhaps HJKL could mean do-not-terminate, # and the Page keys could follow the previous u/l case of the hjkl keys ? # 20140303 # midiedit could display pitches mapped left-to-right like a miniature piano # C ab | Eb # C | Eb f~ # | Eb b f~ # If possible at least 3 characters per octave, plus '| ' unmoving; # bass is 3.3 octaves, treble 4 octaves = 22 chars; plus '| ' makes 24 # If less than 15 are available, revert to 'treble f~##' which uses 11. # Could also display the sounding chord, eg 'c233' or 'eb26' # see sub note2str ! # 20140622 To avoid having to type rw filename then fi filename, # we should have either ri=range-insert, or ir=insert-range, # or introduce a Buffer: ry=range-yank and rd=range-delete and p=paste # use Data::Dumper; $Data::Dumper::Indent = 0; $Data::Dumper::Sortkeys = 1; use Time::HiRes; # 5.3 my $Version = '7.8'; # -d on multi-track files resets ticks to 0 each track my $VersionDate = '20160701'; my $UseCurses = 1; my $TopKeystrokesLine; # set by display_keystrokes my $OutputPort = $ENV{'ALSA_OUTPUT_PORTS'}; while ($ARGV[$[] =~ /^-(\w)/) { if ($1 eq 'd') { $UseCurses = 0; shift; } elsif ($1 eq 'o') { shift; $OutputPort = shift; } else { my $n = $0; $n =~ s#^.*/([^/]+)$#$1#; print < 'gm 1', # "\x7E\x7F\x09\x01\xF7" => 'gm on', "\x7E\x7F\x09\x02\xF7" => 'gm off', "\x7E\x7F\x09\x03\xF7" => 'gm 2', ); my %Number2controller = ( 0=>'Bank Select (MSB)', 1=>'Modulation (MSB)', 2=>'Breath Control (MSB)', 4=>'Foot Control (MSB)', 5=>'Portamento Time MSB', 6=>'Data Entry (MSB)', 7=>'Channel Volume MSB', 8=>'Balance (MSB)', 10=>'Pan (MSB)', 11=>'Expression (MSB)', 12=>'Effects Controller 1', 13=>'Effects Controller 2', 16=>'Gen Purpose 1 (MSB)', 17=>'Gen Purpose 2 (MSB)', 18=>'Gen Purpose 3 (MSB)', 19=>'Gen Purpose 4 (MSB)', 32=>'Bank Select (LSB)', 33=>'Modulation (LSB)', 34=>'Breath Control (LSB)', 36=>'Foot Control (LSB)', 37=>'Portamento Time LSB', 38=>'Data Entry (LSB)', 39=>'Channel Volume LSB', 40=>'Balance (LSB)', 42=>'Pan (LSB)', 43=>'Expression (LSB)', 48=>'Gen Purpose 1 (LSB)', 49=>'Gen Purpose 2 (LSB)', 50=>'Gen Purpose 3 (LSB)', 51=>'Gen Purpose 4 (LSB)', 64=>'Sustain Pedal', 65=>'Portamento on/off', 66=>'Sostenuto Pedal', 67=>'Soft Pedal', 68=>'Legato Pedal', 69=>'Hold 2', 70=>'Sound Variation', 71=>'Resonance', 72=>'Release Time', 73=>'Attack Time', 74=>'Cut-off Frequency', 75=>'Decay Time', 76=>'Vibrato Rate', 77=>'Vibrato Depth', 78=>'Vibrato Delay', 80=>'Gen Purpose 5', 81=>'Gen Purpose 6', 82=>'Gen Purpose 7', 83=>'Gen Purpose 8', 84=>'Portamento Control', 91=>'Reverb Depth', 92=>'Tremolo Depth', 93=>'Chorus Depth', 94=>'Celeste (De-tune)', 95=>'Phaser Depth', 96=>'Data Increment', 97=>'Data Decrement', 98=>'non-reg param lsb', 99=>'non-reg param msb', 100=>'Reg-Param (LSB)', 101=>'Reg-Param (MSB)', 120=>'All Sound Off', 121=>'Reset All Controllers', 122=>'Local Control', 123=>'All Notes Off', 124=>'Omni Off', 125=>'Omni On', 126=>'Mono On (Poly Off)', 127=>'Poly On (Mono Off)', ); if (! $UseCurses) { use bytes; # 20150526 because of sysexes that need to end with \xF7 my $opus = MIDI::Opus->new({ 'from_file' => $ARGV[$[]}); open(SAVEOUT, ">&STDOUT") || die "couldn't dup STDOUT: $!"; close STDOUT; my $text; if (!open(STDOUT,'>',\$text)) { die "can't open STDOUT in-memory: $!\n"; } print "# see perldoc MIDI::Event\n\$newopus = "; $opus->dump({'dump_tracks'=>1}); close STDOUT; open(STDOUT, ">&SAVEOUT") || die "couldn't dup SAVEOUT: $!"; my @text = split(/\n/, $text); my $tmp = "/tmp/midiedit.$$"; if (! open(T, '>', $tmp)) { die "can't open $tmp: $!\n"; } local $ticks = 0; # 7.8 line2comment resets ticks with each new Track foreach my $line (@text) { print T $line.line2comment($line)."\n"; } close T; while (1) { Term::Clui::edit($tmp); unless ($return = do $tmp) { warn "couldn't parse $tmp: $@\n" if $@; warn "couldn't do $tmp: $!\n" unless defined $return; warn "couldn't run $tmp\n" unless $return; } last if $newopus; if (!Term::Clui::confirm("MIDI::Opus syntax error. OK to re-edit ?")) { unlink $tmp; exit 1; } } unlink $tmp; $Debug=0; if ($Debug) { $newopus->dump({'dump_tracks'=>1}); exit; } $newopus->write_to_file( $ARGV[$[] ); exit 0; } # ----- the Curses app... my $File = $ARGV[$[]; my @score = file2ms_score($File); # 1.7 # foreach my $e (@Track) { if (! defined $e->[$[]) { debug("UNDEF 1"); } } my @buggyTrack = sort {$$a[$[+1] <=> $$b[$[+1]} @{$score[1]}; # 7.2 my @Track = (); # 7.2 ARGGghhh... the sort introduces extra events with undefined types :-( foreach my $e (@buggyTrack) { if (defined $e->[$[]) { push @Track, $e; } } my $Now = 0; # ticks? secs? my $Ievent = $[; # perhaps $[-1 should mean before_the_first_event ? my $Paused = 1; my $Editing = 0; # 1.4 my $I_LastRefreshed = 0; # 6.7 stores when the display was last refreshed my @EditEvent = (); # 2.9 if event-type matches then '.' imposes the rest my @FindEvent = (); my $FindForwards = 1; my $FindSubstring = 1; # 7.6 currently not changed by anything; could be later my $NowBeforeFind = undef; my $Message = ''; my @History = (); # (\@score,$ievent,$now, \@score,$ievent,$now, ...); my $Ihistory = -1; my $IncrementalTimes = 1; my $RangeSettingState = 0; # 4.5 my $RangeStart = $[; # 4.5 my $RangeEnd = $[-1; # 4.5 my $ReplaySpeed = 1.0; # 3.1 varied by [ and ] my $RS = '1.0'; # 3.1 3-char sprintf of $ReplaySpeed my %c2s; # should set it here really; it's set by sub cc2str initscr(); cbreak(); noecho(); nonl(); clear(); # http://docstore.mik.ua/orelly/perl/cookbook/ch15_13.htm BUT: keypad(stdscr(),1); $SIG{'INT'} = sub {exit 0;}; $SIG{'TERM'} = sub {exit 0;}; add_to_history(); my $FileIsChanged = 0; if (! MIDI::ALSA::client( "midiedit pid=$$", 0, 1, 1 )) { die "can't start up the ALSA client\n"; } my $ID = MIDI::ALSA::id().":0"; display_screen($Now, $Ievent, @Track); # 2.0 shouldn't attempt to connect if $OutputPort is undefined or "0" if (! defined $OutputPort) { display_message( "no -o option, and no ALSA_OUTPUT_PORTS environment variable"); } elsif ($OutputPort eq '0') { display_message("not connecting to any ALSA client"); } else { foreach my $cl_po (split /,/, $OutputPort) { # 2.4 #$cl_po =~ /^(\d+):?(\d*)$/; #my $cl = $1; my $po = $2 or 0; #if ($cl == MIDI::ALSA::id()) { # display_message("can't connect to $cl_po, which is myself"); #} if (! MIDI::ALSA::connectto( 1, $cl_po )) { # display_message("can't connect to ALSA client $cl_po"); } } } if (! MIDI::ALSA::start()) { die "can't start the ALSA client queue\n"; } # mustn't create call to endwin in nonCurses mode eval 'sub END {all_sounds_off(); endwin();}'; while (1) { # the loop my $c = getch(); # debug("\$c = $c = decimal ".unpack('C*',$c)); # could use my $c = getchar(); returns either $c or (undef, $keyc) # debug('$c = '.join(" ",unpack('C*',$c))); if ($c == ERR()) { # debug("\$c = ERR()"); if ($Paused) { # see man ncurses ==> man inopts timeout(-1); # Shouldn't happen. Anyway, block next read # but could use this for a Message which vanishes after 2 sec } else { if ($Ievent < $#Track) { # output next event $Ievent += 1; $Now = $Track[$Ievent][$[+1] + 1; # 6.7 If Playing, and next event is <10ms away, don't refresh if ($Ievent == $#Track) { display_screen(); } elsif (($Track[$Ievent+1][$[+1] - $I_LastRefreshed) > (10.0/$ReplaySpeed)) { display_screen(); } # 7.7: could loop through _all_ such events within 10mS ? play_current_event(); } set_timeout_for_next_note(); } } elsif ($c eq 'w') { score2file($File, 1000,\@Track); display_message("Saved to $File"); $FileIsChanged = 0; } elsif ($c eq 'Q' or $c eq 'q') { if ($Paused) { quit(); } $Paused = 1; timeout(-1); display_screen(); } elsif ($c eq 'D' or $c == KEY_DL() or $c == KEY_DC()) { set_before_last_change($Ievent); # 7.5 if ($IncrementalTimes) { my $dt = delta_t($Ievent); foreach my $ie ($Ievent+1..$#Track) { $Track[$ie][$[+1] -= $dt; } } splice @Track, $Ievent, 1; if ($Ievent > $#Track) { $Ievent = $#Track; } if ($RangeStart >= $Ievent) { $RangeStart -= 1; } # 4.5 if ($RangeEnd >= $Ievent) { $RangeEnd -= 1; } add_to_history(); display_screen(); } elsif ($c eq 'e') { $Paused = 1; edit_event(); play_current_event(); display_screen(); } elsif ($c eq '.') { set_before_last_change($Ievent); # 7.5 edit_again(); display_screen(); # 2.9 } elsif ($c eq 'i') { set_before_last_change($Ievent); # 7.5 insert_event(); display_screen(); } elsif ($c eq ']' or $c eq '}') { $ReplaySpeed *= 1.41421356; $RS = sprintf('%.1f',$ReplaySpeed); display_screen(); #3.1 } elsif ($c eq '[' or $c eq '{') { $ReplaySpeed *= 0.70710678; $RS = sprintf('%.1f',$ReplaySpeed); display_screen(); #3.1 } elsif ($c eq 'R') { set_range(); display_screen(); } elsif ($c eq 'f') { file_menu(); display_screen(); } elsif ($c eq 'r') { range(); display_screen(); } elsif ($c eq 'u') { un_do(); display_screen(); } elsif ($c eq "\cR") { re_do(); display_screen(); } elsif ($c eq '+') { $IncrementalTimes = 1; display_screen(); } elsif ($c eq '-' or $c eq '=') { $IncrementalTimes = 0; display_screen(); #} elsif ($c eq 'B' or $c eq 'b') { # 20120916 this is deprecated. # metronome_event($c); display_screen(); } elsif ($c eq '/') { # f added 4.1, removed again 4.7 if (! $Paused) { $Paused = 1; timeout(-1); display_screen(); } $FindForwards = 1; find(); display_screen(); } elsif ($c eq '?') { if (! $Paused) { $Paused = 1; timeout(-1); display_screen(); } $FindForwards = 0; find(); display_screen(); } elsif ($c eq 'n') { if (! $Paused) { $Paused = 1; timeout(-1); display_screen(); } find_next($FindForwards); display_screen(); } elsif ($c eq 'N') { if (! $Paused) { $Paused = 1; timeout(-1); display_screen(); } find_next(! $FindForwards); display_screen(); } elsif ($c eq "\x08" or $c eq KEY_BACKSPACE()) { # 7.7 back to before find if (defined $NowBeforeFind) { time_travel($NowBeforeFind - $Now); display_screen(); } } elsif ($c eq ' ') { if ($Paused) { $Paused = 0; set_timeout_for_next_note(); } else { $Paused = 1; timeout(-1); } display_screen(); } elsif ($c eq 'z') { all_sounds_off(); } elsif ($c == KEY_UP() or $c eq 'k') { if ($Ievent > $[) { event_travel(-1); display_screen(); # 5.2 } } elsif ($c == KEY_DOWN() or $c eq 'j') { if ($Ievent < $#Track) { event_travel(1); display_screen(); # 5.2 } } elsif ($c == KEY_LEFT() or $c eq 'K') { time_travel(-1000); display_screen(); } elsif ($c == KEY_RIGHT() or $c eq 'J') { time_travel(1000); display_screen(); } elsif ($c == KEY_PPAGE()) { time_travel(-10000); display_screen(); } elsif ($c == KEY_NPAGE()) { time_travel(10000); display_screen(); } elsif ($c == KEY_HOME()) { $Ievent = $[; $Now = $Track[$Ievent][$[+1]; $Paused = 1; display_screen(); timeout(-1); } elsif ($c == KEY_END()) { $Ievent = $#Track; $Now = $Track[$Ievent][$[+1]; $Paused = 1; display_screen(); timeout(-1); } } #-------------- Infrastructure for the Curses version ------------- sub addl { my ($lin,$col,$str) = @_; if ($col < 2) { $col = 2; $str = substr($str, $[, $[+$COLS-4); } # 4.8 move($lin,$col); addstr($str); clrtoeol(); } sub set_before_last_change { my $i_event = $_[$[]; # 7.5 $History[$Ihistory-1] = $i_event; $History[$Ihistory] = $Track[$i_event][$[+1] + 1; # so should we really store Now ? why not just restore it from Ievent ? } sub add_to_history { #debug("add_to_h1: Ihistory=$Ihistory #History=$#History History=@History"); my @copy_track = deepcopy(@Track); if ((1+$Ihistory) % 3) { # check that 1+Ihistory is a multiple of 3 _warn("add_to_history: Ihistory should be 3*n - 1, not $Ihistory"); $Ihistory -= ((1+$Ihistory)%3); if ($Ihistory < 0) { $Ihistory = -1; } } if ((scalar @History) % 3) { _warn("add_to_history: History should be multiple of 3, not " .scalar @History); # if ($Ihistory < $[) { $Ihistory = $[; } } if ($#History > $Ihistory) { $#History = $Ihistory; } # truncate here push @History, \@copy_track, $Ievent, $Now; # hardly space-efficient :-( # could dump into text-format and use diff, or use a direct diff module: # Diff::LibXDiff Algorithm::Diff in Lua: Diff ltdiff # http://search.cpan.org/~tyemq/Algorithm-Diff-1.1903/lib/Algorithm/Diff.pm $Ihistory = $#History; $FileIsChanged = 1; $NowBeforeFind = undef; # 7.7 #debug("add_to_h2: Ihistory=$Ihistory History=$#History History=@History"); } sub all_sounds_off { # 2.2 foreach my $c (0..15) { MIDI::ALSA::output(MIDI::ALSA::controllerevent($c,120,0)); MIDI::ALSA::output(MIDI::ALSA::controllerevent($c,123,0)); # 6.9 } } sub cc2str { my $m = $_[$[]; if (! %c2s) { %c2s = ( 0, 'Bank Select (MSB)', 32, 'Bank Select (LSB)', 64, 'Sustain Pedal', 96, 'Data Increment', 1, 'Modulation (MSB)', 33, 'Modulation (LSB)', 65, 'Portamento on/off', 97, 'Data Decrement', 2, 'Breath Control (MSB)', 34, 'Breath Control (LSB)', 66, 'Sostenuto Pedal', 98, 'non-reg param lsb', 67, 'Soft Pedal', 99, 'non-reg param msb', 4, 'Foot Control (MSB)', 36, 'Foot Control (LSB)', 68, 'Legato Pedal', 100, 'Reg Param (LSB)', 5, 'Portamento Time (MSB)', 37, 'Portamento Time (LSB)', 69, 'Hold 2', 101, 'Reg Param (MSB)', 6, 'Data Entry (MSB)', 38, 'Data Entry (LSB)', 70, 'Sound Variation', 7, 'Channel Volume (MSB)', 39, 'Channel Volume (LSB)', 71, 'Resonance, Q', 8, 'Balance (MSB)', 40, 'Balance (LSB)', 72, 'Release Time', 73, 'Attack Time', 10, 'Pan (MSB)', 42, 'Pan (LSB)', 74, 'Cut-off Frequency', 11, 'Expression (MSB)', 43, 'Expression (LSB)', 75, 'Decay Time', 12, 'Effects Controller 1', 76, 'Vibrato Rate', 13, 'Effects Controller 2', 77, 'Vibrato Depth', 78, 'Vibrato Delay', 84, 'Portamento Control', 120, 'All Sound Off', 121, 'Reset All Controllers', 122, 'Local Control', 91, 'Reverb Depth', 123, 'All Notes Off', 92, 'Tremolo Depth', 124, 'Omni Off', 93, 'Chorus Depth', 125, 'Omni On', 94, 'Celeste (De-tune)', 126, 'Mono On (Poly off)', 95, 'Phaser Depth', # 1.9 127, 'Poly On (Mono off)', # 1.9, 5.1 ); } return $c2s{$_[$[]} || ''; } sub debug { open (T, '>>', '/tmp/debug'); print T $_[$[],"\n"; close T; } sub delta_t { my $ie = $_[$[]; my $dt; if ($ie == $[) { $dt = $Track[$ie][$[+1]; } else { $dt = $Track[$ie][$[+1] - $Track[$ie-1][$[+1]; } return $dt; } sub display_events { my ($i_top, $i_now, $i_bot) = row_nums(); my %seen_a_ped = (); # 6.0 remember by channel my %seen_a_endped = (); my %seen_a_cc = (); # 6.5 remember by channel and cc my $note_str = ''; my $iline=$i_now-1; while ($iline >= $i_top) { # go upwards to show the most recent Ped and * only; more elegant my $now = $Ievent-$i_now+$iline; my $note_str = note2str(@{$Track[$now]}); addl($iline, 0, event2str($now)); if ($Track[$now][$[] =~ /note/) { if (($Track[$now][$[+1] + $Track[$now][$[+2]) > $Now) { addl($iline, 57, note2str(@{$Track[$now]})); if ($note_str) { # 4.1 attrset(A_BOLD()); move($iline,31); # "31" depends on event2str # 4.8 addstr(sprintf('%5d %5d', $Track[$now][$[+3],$Track[$now][$[+4])); attrset(A_NORMAL()); } } } elsif ($Track[$now][$[] =~ /control_change/) { my $cha = $Track[$now][$[+2]; if ($Track[$now][$[+3] == 64) { if ($Track[$now][$[+4] >= 64) { if (! $seen_a_ped{$cha}) { addl($iline, 57, 'Ped'); } # 6.0 $seen_a_ped{$cha} = 1; } else { if (! $seen_a_endped{$cha}) { addl($iline, 57, '*'); } # 6.0 $seen_a_endped{$cha} = 1; } } else { # 6.5 my $cc = $Track[$now][$[+3]; if (! $seen_a_cc{$cha}{$cc}) { addl($iline, 57, cc2str($cc)); } $seen_a_cc{$cha}{$cc} = 1; } } elsif ($Track[$now][$[] =~ /patch_change/) { my $patch = $MIDI::number2patch{$Track[$now][$[+3]}; addl($iline, 57, $patch); # 6.4 } elsif ($Track[$now][$[] =~ /^sysex/) { if ($sysex2str{$Track[$now][$[+2]}) { # 3.6 addl($iline, 57, $sysex2str{$Track[$now][$[+2]}); } } $iline -= 1; } refresh(); foreach my $iline (($i_now+1)..$i_bot) { my $iev = $Ievent-$i_now+$iline; addl($iline, 0, event2str($iev)); # 4.7 } attrset(A_BOLD()); addl($i_now, 0, event2str($Ievent)); my $notestr = ''; # 2.1 if ($Track[$Ievent][$[] eq 'note') { $notestr = note2str(@{$Track[$Ievent]}); } elsif ($Track[$Ievent][$[] eq 'patch_change') { # 6.4 $notestr = $MIDI::number2patch{$Track[$Ievent][$[+3]} } elsif ($Track[$Ievent][$[] eq 'control_change') { # 6.5 # ideally, I'd like this to set $seen_a_cc{$cha}{$cc}, see 28 lines up $notestr = cc2str($Track[$Ievent][$[+3]) } if ($Editing) { addl($i_now,49, "EDITING $notestr "); # 1.4 } elsif ($Paused) { addl($i_now,49, "PAUSED $notestr "); # 2.1 } else { addl($i_now,49, "PLAYING $notestr "); # 2.1 } attrset(A_NORMAL()); refresh(); } sub display_keystrokes { $TopKeystrokesLine = $LINES-4; # addstr("Ievent=$Ievent KEY_UP=".KEY_UP()." stdscr=$stdscr"); if ($Message) { move($LINES-4,2); clrtoeol(); addl($LINES-4, round(0.4*($COLS - length $Message)) ,$Message); move($LINES-3,2); clrtoeol(); $Message = ''; } else { my $dot = ''; if ((@EditEvent>1) and $EditEvent[$[] eq $Track[$Ievent][$[]) { $dot = ' .=again'; } my $ran = 'f=file R=set_range'; if ($RangeStart < $RangeEnd) { $ran .= ' r=range'; } my $tim = '+=incrementaltimes'; if ($IncrementalTimes) { $tim = '-=absolutetimes'; } addl($LINES-4,2, "$tim $ran i=insert e=edit$dot"); # 6.6 addl($LINES-3,2, 'k/Up/j/Down=+-1event ' . 'Right/Left=+-1sec PageDown/PageUp=+-10sec'); # 4.3 } # p=paste y=yank ? dd ? 4dd ? 4j etc ? my $s = 'D=Delete u=undo ^R=redo /=find '; if (defined $NowBeforeFind) { # 7.7 $s = $s . '?=reverse n=next N=previous Backspace '; } else { $s = $s . '?=reversefind n=findnext N=findprevious '; } addl($LINES-2,2, $s); if ($Paused) { # if event is editable, then t,d,c,n,v and Space=play addl($LINES-1,2, 'Space=play ]/[=speed Home=start End=end z=allsoundsoff w=write q=quit'); } else { addl($LINES-1,2, 'Space=pause ]/[=speed Home=start End=end z=allsoundsoff w=write q=quit'); } refresh(); } sub display_fields { # 4.4 my $event_type = $Track[$Ievent][$[]; if ($RangeSettingState == 1) { # 4.5 attrset(A_BOLD()); addl(0,5,' move to other end of range and press R'); attrset(A_NORMAL()); } elsif ($NewFileState == 1) { # 4.9 attrset(A_BOLD()); my $f = $File; # if filename too long use basename; 41=24+12+5; 5.0 if (length($f) > ($COLS-length($ID)-41)) { $f =~ s/^.*\///; } addl(0,5,"now editing $f"); attrset(A_NORMAL()); } elsif ($event_type eq 'note') { addl(0,5,' Event Ticks Dura Chan Pitch Vol'); } elsif ($event_type eq 'control_change') { addl(0,5,' Event Ticks Chan Contrlr Value'); } elsif ($event_type eq 'patch_change') { addl(0,5,' Event Ticks Chan Patch'); } else { addl(0,5,' Event Ticks Data'); } move(0,$COLS-length($ID)-24); addstr("ReplaySpeed=$RS"); # 3.1 move(0,$COLS-length($ID)-8); addstr("Output=$ID"); } sub display_screen { display_fields(); move(1,1); hline($ACS_HLINE,$COLS-2); my $last = $Track[$#Track][$[+1]; move(1,$COLS-length($ID)-25); addstr(" Now at $Now / $last mS "); # 3.1 move($LINES-5,1); hline($ACS_HLINE,$COLS-2); if ($Ievent == $#Track) { $Paused = 1; } # 4.1 display_keystrokes(); display_events(); refresh(); $I_LastRefreshed = $Now; # 6.7 } sub display_message { my ($y,$x); getyx($y,$x); $Message = $_[$[]; display_keystrokes(); move($y,$x); refresh(); } sub edit_event { my $initial_ch = $_[$[]; # 2.9 must keep @EditEvent updated... $Editing = 1; my $prompt_y; my $prompt_x; sub time_prompt_to { my ($y, $x, $clr) = @_; if ($IncrementalTimes) { addstr($y,$x-6,'time=+'.delta_t($Ievent)); } else { addstr($y,$x-5,'time='.$Track[$Ievent][$[+1]); } if ($clr) { clrtoeol(); } } sub keystroke_prompt { my $k = $_[$[]; if ($IncrementalTimes) { $k .= " -=absolutetimes"; } else { $k .= " +=incrementaltimes"; } if ($Ievent == $[) { $k .= ' Down '; } elsif ($Ievent == $#Track) { $k .= ' Up '; } else { $k .= ' Up/Down '; } $k .= 'Space=Paused '; addl($LINES-1,round(0.45*($COLS-length($k))),$k); refresh(); getyx($prompt_y,$prompt_x); # why ? } sub display_this_event { my @event = @_; # 1.4 my $k; move($LINES-4,1); clrtobot(); if ($event[$[] eq 'note') { time_prompt_to($LINES-4,13,1); addl($LINES-3,15,'duration='.$event[$[+2]); addl($LINES-4,26,'channel='.$event[$[+3]); addl($LINES-3,35,'pitch='.$event[$[+4]); # 5.0 addl($LINES-3,46,note2str(@event)); addl($LINES-4,43,'volume='.$event[$[+5]); $k = 't=time d=duration c=chan p=pitch v=vol'; } elsif ($event[$[] eq 'control_change') { time_prompt_to($LINES-4,14,1); addl($LINES-3,19,'channel='.$event[$[+2]); addl($LINES-4,29,'midi-controller='.$event[$[+3]); addl($LINES-4,49,cc2str($Track[$Ievent][$[+3])); addl($LINES-3,41,'value='.$event[$[+4]); $k = 't=time c=chan m=midicontroller v=value'; } elsif ($event[$[] eq 'patch_change') { time_prompt_to($LINES-4,14,1); addl($LINES-4,25,'channel='.$event[$[+2]); addl($LINES-4,44,'patch='.$event[$[+3]); addl($LINES-4,55,$MIDI::number2patch{$Track[$Ievent][$[+3]}); $k = 't=time c=channel p=patch'; } elsif ($event[$[] =~ /^marker|^text|^sysex_f0/) { time_prompt_to($LINES-4,14,1); addl($LINES-4,25,'message='.$event[$[+2]); $k = 't=time m=message'; } # 3.8 offer edit_again if applicable # (perhaps if Ievent != LastEditedIevent) if ((@EditEvent>1) and $EditEvent[$[] eq $Track[$Ievent][$[]) { $k .= ' .=again'; } display_events(); keystroke_prompt($k); move($prompt_y,$prompt_x); refresh(); } my @event = @{$Track[$Ievent]}; @EditEvent = ($event[$[]); # 2.9 remember the event_type my $changed = 0; timeout(-1); my $i_before_edit = $Ievent; while (1) { display_this_event(@event); if ($event[$[] eq 'note') { while (1) { my $c = getch(); if ($c eq 't') { get_n($LINES-4,13,6,1); $changed=1; } elsif ($c eq 'd') { get_n($LINES-3,24,6,2); $changed=1; } elsif ($c eq 'c') { get_n($LINES-4,34,3,3); $changed=1; addl($LINES-3,46,note2str(@{$Track[$Ievent]})); } elsif ($c eq 'p') { get_n($LINES-3,41,5,4); $changed=1; #5.0 addl($LINES-3,46,note2str(@{$Track[$Ievent]})); } elsif ($c eq 'v') { get_n($LINES-4,50,6,5); $changed=1; } elsif ($c eq '+' and !$IncrementalTimes) { $IncrementalTimes = 1; display_this_event(@event); } elsif (($c eq '-' || $c eq '=') and $IncrementalTimes) { $IncrementalTimes = 0; display_this_event(@event); } elsif ($c == KEY_UP() or $c eq 'k') { # 1.4, 4.0 if ($Ievent > $[) { event_travel(-1); # 5.2 @event = @{$Track[$Ievent]}; display_this_event(@event); display_fields(); # 4.4 last; # 1.5 } } elsif ($c == KEY_DOWN() or $c eq 'j') { # 1.4, 4.0 if ($Ievent < $#Track) { event_travel(1); # 5.2 @event = @{$Track[$Ievent]}; display_this_event(@event); display_fields(); # 4.4 last; # 1.5 } } elsif ($c eq 'e') { next; # 1.4 } elsif ($c eq '.') { set_before_last_change($i_before_edit); # 7.5 edit_again(); # 3.8 display_screen(); } else { if ($changed) { set_before_last_change($i_before_edit); # 7.5 add_to_history(); } $Editing = 0; # press / ? n N during Editing should Pause, call ind_event and exit return; } # display_events(); move($prompt_y,$prompt_x); refresh(); @event = @{$Track[$Ievent]}; # 2.7 display_this_event(@event); } } elsif ($event[$[] eq 'control_change') { while (1) { my $c = getch(); if ($c eq 't') { get_n($LINES-4,14,6,1); $changed=1; } elsif ($c eq 'c') { get_n($LINES-3,27,2,2); $changed=1; } elsif ($c eq 'm') { get_n($LINES-4,45,3,3); $changed=1; addl($LINES-4,49,cc2str($Track[$Ievent][$[+3])); } elsif ($c eq 'v') { get_n($LINES-3,47,3,4); $changed=1; } elsif ($c eq '+' and !$IncrementalTimes) { $IncrementalTimes = 1; display_this_event(@event); } elsif (($c eq '-' || $c eq '=') and $IncrementalTimes) { $IncrementalTimes = 0; display_this_event(@event); } elsif ($c == KEY_UP() or $c eq 'k') { # 1.4, 4.0 if ($Ievent > $[) { if ($Now - $Track[$Ievent-1][$[+1] < 2) { # 4.8 $Track[$Ievent-1][$[+1] -= 1; } time_travel($Track[$Ievent-1][$[+1] + 1 - $Now); @event = @{$Track[$Ievent]}; display_this_event(@event); play_current_event(); last; # 1.5 } } elsif ($c == KEY_DOWN() or $c eq 'j') { # 1.4, 4.0 if ($Ievent < $#Track) { $Ievent += 1; $Now = $Track[$Ievent][$[+1] + 1; @event = @{$Track[$Ievent]}; display_this_event(@event); play_current_event(); last; # 1.5 } } elsif ($c eq 'e') { next; # 1.4 } elsif ($c eq '.') { edit_again(); # 3.8 display_screen(); } else { if ($changed) { set_before_last_change($i_before_edit); # 7.5 add_to_history(); } $Editing = 0; return; } # display_events(); move($prompt_y,$prompt_x); refresh(); @event = @{$Track[$Ievent]}; # 1.6 display_this_event(@event); } } elsif ($event[$[] eq 'patch_change') { while (1) { #get_n($LINES-4,50,3,3); $changed=1; # XXX #addl($LINES-4,55,$MIDI::number2patch{$Track[$Ievent][$[+3]}); my $c; if ($initial_ch) { $c = $initial_ch; $initial_ch = undef; } else { $c = getch(); } if ($c eq 't') { get_n($LINES-4,14,6,1); $changed=1; } elsif ($c eq 'c') { get_n($LINES-4,33,3,2); $changed=1; } elsif ($c eq 'p') { get_n($LINES-4,50,3,3); $changed=1; addl($LINES-4,55,$MIDI::number2patch{$Track[$Ievent][$[+3]}); } elsif ($c eq '+' and !$IncrementalTimes) { $IncrementalTimes = 1; display_this_event(@event); } elsif (($c eq '-' || $c eq '=') and $IncrementalTimes) { $IncrementalTimes = 0; display_this_event(@event); } elsif ($c == KEY_UP() or $c eq 'k') { # 1.4, 4.0 if ($Ievent > $[) { if ($Now - $Track[$Ievent-1][$[+1] < 2) { # 4.8 $Track[$Ievent-1][$[+1] -= 1; } time_travel($Track[$Ievent-1][$[+1] + 1 - $Now); # 4.8 @event = @{$Track[$Ievent]}; display_this_event(@event); play_current_event(); last; # 1.5 } } elsif ($c == KEY_DOWN() or $c eq 'j') { # 1.4, 4.0 if ($Ievent < $#Track) { $Ievent += 1; $Now = $Track[$Ievent][$[+1] + 1; @event = @{$Track[$Ievent]}; display_this_event(@event); play_current_event(); last; # 1.5 } } elsif ($c eq 'e') { next; # 1.4 } elsif ($c eq '.') { edit_again(); # 3.8 display_screen(); } else { if ($changed) { set_before_last_change($i_before_edit); # 7.5 add_to_history(); } $Editing = 0; return; } @event = @{$Track[$Ievent]}; # 2.7 display_this_event(@event); } } elsif ($event[$[] =~ /^marker|^text|^sysex_f0/) { while (1) { my $c; if ($initial_ch) { $c = $initial_ch; $initial_ch = undef; } else { $c = getch(); } if ($c eq 't') { get_n($LINES-4,14,6,1); $changed=1; } elsif ($c eq 'm') { my $s=''; move($LINES-4,33); clrtoeol(); echo(); getnstr($s,52); noecho(); $changed=1; $Track[$Ievent][$[+2] = $s; $EditEvent[$[+2] = $s; # 7.3 } elsif ($c eq '+' and !$IncrementalTimes) { $IncrementalTimes = 1; display_events(); time_prompt_to($LINES-4,14,0); keystroke_prompt($k); refresh(); } elsif (($c eq '-' || $c eq '=') and $IncrementalTimes) { $IncrementalTimes = 0; display_events(); time_prompt_to($LINES-4,14,0); keystroke_prompt($k); refresh(); } elsif ($c == KEY_UP() or $c eq 'k') { # 1.4, 4.0 if ($Ievent > $[) { $Ievent -= 1; $Now = $Track[$Ievent][$[+1] + 1; @event = @{$Track[$Ievent]}; display_this_event(@event); last; } } elsif ($c == KEY_DOWN() or $c eq 'j') { # 1.4, 4.0 if ($Ievent < $#Track) { $Ievent += 1; $Now = $Track[$Ievent][$[+1] + 1; @event = @{$Track[$Ievent]}; display_this_event(@event); last; } } elsif ($c eq 'e') { next; # 1.4 } elsif ($c eq '.') { edit_again(); # 3.8 display_screen(); } else { if ($changed) { set_before_last_change($i_before_edit); # 7.5 add_to_history(); } $Editing = 0; return; } # display_events(); move($prompt_y,$prompt_x); refresh(); @event = @{$Track[$Ievent]}; # 2.7 display_this_event(@event); } } else { time_prompt_to($LINES-4,14,1); my $k = 't=time, '; keystroke_prompt($k); refresh(); while (1) { my $c = getch(); if ($c eq 't') { get_n($LINES-4,14,6,1); $changed=1; } elsif ($c eq '+' and !$IncrementalTimes) { $IncrementalTimes = 1; display_events(); time_prompt_to($LINES-4,14,0); keystroke_prompt($k); refresh(); } elsif (($c eq '-' || $c eq '=') and $IncrementalTimes) { $IncrementalTimes = 0; display_events(); time_prompt_to($LINES-4,14,0); keystroke_prompt($k); refresh(); } elsif ($c == KEY_UP() or $c eq 'k') { # 1.4, 4.0 if ($Ievent > $[) { $Ievent -= 1; $Now = $Track[$Ievent][$[+1] + 1; @event = @{$Track[$Ievent]}; display_this_event(@event); last; } } elsif ($c == KEY_DOWN() or $c eq 'j') { # 1.4, 4.0 if ($Ievent < $#Track) { $Ievent += 1; $Now = $Track[$Ievent][$[+1] + 1; @event = @{$Track[$Ievent]}; display_this_event(@event); last; } } elsif ($c eq 'e') { next; # 1.4 } elsif ($c eq '.') { edit_again(); # 3.8 display_screen(); } else { if ($changed or $called_from_insert_event) { # 4.3 play_current_event(); # 4.4 set_before_last_change($i_before_edit); # 7.5 add_to_history(); } $Editing = 0; return; } # display_events(); move($prompt_y,$prompt_x); refresh(); @event = @{$Track[$Ievent]}; # 2.7 display_this_event(@event); # !!! should play the event !!! } } } } sub sanitise_event_text { my @event = @_; # 7.2 $event[$[+2] =~ tr/][A-Za-z0-9 _'"`.+:\/@&)(=*^%$#!?}{|\\~-//cd; # 7.1 $event[$[+2] =~ s/\s+/ /g; $event[$[+2] =~ s/^\s+//; return @event; } sub event2str { my ($ie) = @_; if ($ie > $#Track) { return ''; } # 4.7 needed after a big range_delete if ($ie < $[) { debug("event2str($ie)"); } my @event = @{$Track[$ie]}; my $str = ' '; if ($IncrementalTimes) { if ($ie > $[) { $event[$[+1] -= $Track[$ie-1][$[+1]; } $event[$[+1] = "+".$event[$[+1]; if ($event[$[] =~ /marker|sysex|text|track_name/) { # 7.2 track_name $str = sprintf(' %14s %6s %s', sanitise_event_text(@event)); } elsif (6 == scalar @event) { $str = sprintf(' %14s %6s %5d %5d %5d %5d', @event); } elsif (5 == scalar @event) { $str = sprintf(' %14s %6s %5d %5d %5d', @event); } elsif ($event[$[] eq 'pitch_wheel_change') { $str = sprintf('%s %5s %4d %6d', @event); } elsif (! defined $event[$[]) { } elsif (4 == scalar @event) { if ($event[$[] eq 'channel_after_touch') { # 6.8 $event[$[] = 'cha_aftertouch'; } $str = sprintf(' %14s %6s %5d %5d', @event); } elsif (3 == scalar @event) { $str = sprintf(' %14s %6s %5d', @event); } } else { if ($event[$[] =~ /marker|sysex|text|track_name/) { # 7.2 track_name $str = sprintf(' %14s %6s %s', sanitise_event_text(@event)); } elsif (6 == scalar @event) { $str = sprintf(' %14s %6d %5d %5d %5d %5d', @event); } elsif (5 == scalar @event) { $str = sprintf(' %14s %6d %5d %5d %5d', @event); } elsif ($event[$[] eq 'pitch_wheel_change') { $str = sprintf('%s %5s %4d %6d', @event); } elsif (! defined $event[$[]) { } elsif (4 == scalar @event) { if ($event[$[] eq 'channel_after_touch') { # 6.8 $event[$[] = 'cha_aftertouch'; } $str = sprintf(' %14s %6d %5d %5d', @event); } elsif (3 == scalar @event) { $str = sprintf(' %14s %6d %5d', @event); } } if (($ie == $RangeStart) || ($ie == $RangeEnd)) { $str =~ s/^./-/; # 4.5 # $str =~ s/^./\e[31m-/; # Nope, this just gets displayed in ascii # $str .= "\e[39m"; # and perl Curses doesn't support any color # man color; perldoc Curses | grep color } elsif (($ie > $RangeStart) && ($ie < $RangeEnd)) { $str =~ s/^./|/; # $str =~ s/^./\e[31m|/; # Nope, this just gets displayed in ascii # $str .= "\e[39m"; # and perl Curses doesn't support any color } return $str; } sub event_type { # this dialogue is used by insert_event(); if (! $Paused) { $Paused = 1; timeout(-1); display_events(); } move($LINES-4,2); clrtobot(); addstr('Insert event type ? '); my $s = 'n=note, c=control_change, p=patch_change, m=marker, b=bank_change '; addl($LINES-2, round(0.4*($COLS - length $s)) ,$s); move($LINES-4,22); refresh(); my %c2event_type = qw{ b bank_change n note c control_change p patch_change m marker }; return $c2event_type{getch()}; } sub file_menu { # 4.8 if (! $Paused) { $Paused = 1; timeout(-1); display_events(); } move($LINES-4,0); clrtobot(); my $x=13; # addl($LINES-2,$x,'f=fork n=new s=save w=write q=quit'); addl($LINES-2,$x,'f=fork i=insert n=new s=save w=write q=quit'); addl($LINES-3,4,'which file operation ? '); my $x=27; my $c = getch(); clrtobot(); echo(); if ($c eq 'f') { addl($LINES-3,$x,'fork'); if ($FileIsChanged) { addl($LINES-2,4,"save $File first (y/n) ? "); my $c = getch(); if ($c eq 'y' or $c eq 'w') { score2file($File, 1000,\@Track); } } my $new_filename = $File; foreach $s ('a'..'z') { $new_filename = $File; $new_filename =~ s/(_[a-z][a-z])?\.mid$/$s$1.mid/i; if (! -e $new_filename) { last ; } } $File = $new_filename; $NewFileState = 1; $FileIsChanged = 0; } elsif ($c eq 'i') { # 6.2 my $filename = ask_filename($LINES-2, 'insert which file ? '); if (! $filename) { return; } if (! -e $filename) { _warn("$filename does not exist"); return; } my @new_score = file2ms_score($filename); my @new_track = @{$new_score[$[+1]}; if ($new_track[$[][$[] eq 'set_tempo') { shift @new_track; } if (! @new_track) { _warn("$filename contains no events"); return; } # evolved from range_repeat ... @new_track = sort { $a->[$[+1] <=> $b->[$[+1] } @new_track; my $delta = $new_track[$#new_track][$[+1]; # one note short? my $start_time = $Track[$Ievent][$[+1]; my $k = $[; while ($k <= $#new_track) { $new_track[$k][$[+1]+=$start_time; $k+=1; } $k = $Ievent; while ($k <= $#Track) { $Track[$k][$[+1] += $delta; $k += 1; } # XXX should insert a marker at the start "inserted from $filename" splice @Track, $Ievent, 0, @new_track; # time_travel($delta); No: leave Ievent at the start (to edit patches) $RangeStart = $Ievent; $RangeEnd = $Ievent - 1 + scalar @new_track; $Message = sprintf("%d new events", scalar @new_track); set_before_last_change($Ievent); # 7.5 add_to_history(); } elsif ($c eq 'n') { new_file(); my $filename = ask_filename($LINES-2,'new filename ? '); if (! $filename) { return; } # 6.2 if (! -e $filename) { _warn("$filename does not exist"); return; } $File = $filename; @score = file2ms_score($File); # 1.7 @Track = sort {$$a[$[+1] <=> $$b[$[+1]} @{$score[1]}; $Now = 0; $Ievent = $[; $Paused = 1; $Editing = 0; $NewFileState = 1; all_sounds_off(); } elsif ($c eq 's' or $c eq 'w') { addl($LINES-3,$x,'save file'); # same as 'w' = write score2file($File, 1000,\@Track); _warn("Saved to $File"); $FileIsChanged = 0; } elsif ($c eq 'q') { # same as 'q' = quit if ($Paused) { quit(); } $Paused = 1; timeout(-1); # display_screen(); } } sub find_type { # used by find(); since 3.7 different from event_type if (! $Paused) { $Paused = 1; timeout(-1); display_events(); } move($LINES-4,2); clrtobot(); addstr('Find event type ? '); my $s = 'n=note, c=control_change, p=patch_change, m=marker, b=bank_change '; addl($LINES-2, round(0.4*($COLS - length $s)) ,$s); $s = 'l=long_gap, s=short_gap, t=time'; my %c2event_type = qw{ b bank_change n note c control_change p patch_change m marker l long_gap s short_gap t time }; if ($RangeStart < $RangeEnd) { $s .= ', r=range_start R=range_end'; $c2event_type{'r'} = 'range_start'; # 7.6 only if a range is defined! $c2event_type{'R'} = 'range_end'; # 7.6 } addl($LINES-1, round(0.4*($COLS - length $s)) ,$s); move($LINES-4,20); refresh(); return $c2event_type{getch()}; } sub find { my $event_type = find_type(); if (! $event_type) { return; } addl($LINES-4,20,$event_type); if ($event_type eq 'time') { go_to(); return; } # 3.7 if ($event_type =~ /_gap$/) { find_gap($event_type); return; } # 4.2 if ($event_type ne 'marker') { my $help = 'e.g. 64, >63, <65, !=93, >47&<73'; # 3.1 addl($LINES-4,$COLS-length($help)-2,$help); } if ($event_type eq 'range_start') { # 4.5 time_travel($Track[$RangeStart][$[+1]-$Track[$Ievent][$[+1]); return; } if ($event_type eq 'range_end') { # 4.5 time_travel($Track[$RangeEnd][$[+1]-$Track[$Ievent][$[+1]); return; } refresh; @FindEvent = ($event_type); if ($event_type eq 'note') { addl($LINES-3,2,' Duration ?'); addl($LINES-2,2,' Channel (0..15) ?'); addl($LINES-1,2,' Pitch (0..127) ?'); # shame about Volume not fitting on the screen... refresh(); my $iline = 3; while ($iline > 0) { move($LINES-$iline,24); my $str; my $n; echo(); getnstr($str,20); noecho(); if (length $str) { $FindEvent[$[+5-$iline] = $str; } # 2.8, 3.0 $iline -= 1; } #warn "FindEvent = ".join(', ',@FindEvent)."\r\n"; } elsif ($event_type eq 'control_change') { addl($LINES-3,2,' Channel (0..15) ?'); addl($LINES-2,2,'Controller (0..127) ?'); addl($LINES-1,2,' Value (0..127) ?'); refresh(); my $iline = 3; while ($iline > 0) { move($LINES-$iline,24); my $str; my $n; echo(); getnstr($str,20); noecho(); if (length $str) { $FindEvent[$[+5-$iline] = $str; } # 2.8 $iline -= 1; } # warn "FindEvent = ".join(', ',@FindEvent)."\r\n"; sleep 5; } elsif ($event_type eq 'patch_change') { addl($LINES-3,2,' Channel (0..15) ?'); addl($LINES-2,2,' Patch (0..127) ?'); clrtobot(); refresh(); my $iline = 3; while ($iline > 1) { move($LINES-$iline,24); my $str; my $n; echo(); getnstr($str,20); noecho(); if (length $str) { $FindEvent[$[+5-$iline] = $str; } # 2.8 $iline -= 1; } } elsif ($event_type eq 'marker') { addl($LINES-3,2,' Text ? '); clrtobot(); refresh(); my $str; my $n; echo(); $n = getnstr($str,50); noecho(); if ($str) { $FindEvent[$[+2] = $str; } # 5.9 } else { return; } find_next($FindForwards); } sub find_gap { my $event_type = $_[$[]; # 4.2 # we roll the search into find_next(), so that 'n' or 'N' work if ($event_type eq 'long_gap') { addl($LINES-3,2,'gap longer than (mS) ? '); } elsif ($event_type eq 'short_gap') { addl($LINES-3,2,'gap shorter than (mS) ? '); } else { return; } clrtobot(); refresh(); echo(); $n = getnstr($str,50); noecho(); if (! defined $str) { return; } @FindEvent = ($event_type,0+$str); find_next($FindForwards); } sub find_match { my ($search_str, $num) = @_; # 3.0 if (! defined $search_str) { return 1; } if ($str =~ /^\d+$/) { if ((0+$num)==(0+$search_str)) { return 1; } else { return 0; } } foreach my $str (split /&/, $search_str) { if ($str =~ /^>(\d+)$/) { if (!((0+$num)> (0+$1))) { return 0; } } elsif ($str =~ /^<(\d+)$/) { if (!((0+$num)< (0+$1))) { return 0; } } elsif ($str =~ /^>=(\d+)$/) { if (!((0+$num)>=(0+$1))) { return 0; } } elsif ($str =~ /^<=(\d+)$/) { if (!((0+$num)<=(0+$1))) { return 0; } } elsif ($str =~ /^!=(\d+)$/) { if (!((0+$num)!=(0+$1))) { return 0; } } else { if (!($num eq $str)) { return 0; } } } return 1; } sub event_matches { my ($f, $e) = @_; my @fe = @$f; my @ev = @$e; # factored out as a subroutine, 7.6 if ($FindSubstring and $fe[$[] eq 'marker') { # 7.6 if (! defined $fe[$[+2]) { return 1; } # blank text finds all markers if (index($ev[$[+2], $fe[$[+2]) < $[) { return 0; } } else { foreach my $i ($[+1 .. $#fe) { if (defined $fe[$i] and !find_match($fe[$i],$ev[$i])) { return 0; } } } return 1; } sub find_next { my $find_forwards = $_[$[]; #warn "FindEvent=@FindEvent\n"; sleep 3; my $iev = $Ievent; my $found = 0; if ($find_forwards) { while ($iev < $#Track) { $iev += 1; if ($FindEvent[$[] eq $Track[$iev]->[$[]) { if (event_matches(\@FindEvent,$Track[$iev])) {$found=1; last;} } elsif ($FindEvent[$[] eq 'long_gap') { if (delta_t($iev) > $FindEvent[$[+1]) { $found = 1; last; } } elsif ($FindEvent[$[] eq 'short_gap') { if (delta_t($iev) < $FindEvent[$[+1]) { $found = 1; last; } } } } else { while ($iev > $[) { $iev -= 1; if ($FindEvent[$[] eq $Track[$iev]->[$[]) { if (event_matches(\@FindEvent,$Track[$iev])) {$found=1; last;} } elsif ($FindEvent[$[] eq 'long_gap') { if (delta_t($iev) > $FindEvent[$[+1]) { $found = 1; last; } } elsif ($FindEvent[$[] eq 'short_gap') { if (delta_t($iev) < $FindEvent[$[+1]) { $found = 1; last; } } } } if ($found) { $NowBeforeFind = $Now; # 7.7 time_travel($Track[$iev][$[+1] - $Now); # 4.3 $Ievent = $iev; # in case there are following events with zero dt display_screen(); } else { $Message = "Event (".join(', ',@FindEvent).") not found"; } } sub get_n { my ($y, $x, $l, $i) = @_; move($y,$x); addstr(' 'x$l); move($y,$x); refresh(); my $t; echo(); getnstr($t, $l); noecho(); if ($t =~ /^\d+$/) { if ($i == 1 and $IncrementalTimes and $Ievent>$[) { my $dt = $t - delta_t($Ievent); $Track[$Ievent][$[+1] = $Track[$Ievent-1][$[+1]+$t; foreach my $ie ($Ievent+1..$#Track) { $Track[$ie][$[+1] += $dt; } $EditEvent[$[+$i] = $t; # 3.7 BUG if IncrementalTimes has changed } elsif ($i == 1 and ! $IncrementalTimes) { $Track[$Ievent][$[+1] = 0+$t; # it might have changed order :-( @Track = sort {$$a[$[+1] <=> $$b[$[+1]} @Track; } else { $Track[$Ievent][$[+$i] = 0+$t; $EditEvent[$[+$i] = $t; # 2.9 } } elsif ($t =~ /^[-+]\d+$/) { # 3.0 increments, e.g +10 or -15 if ($i > 1) { $Track[$Ievent][$[+$i] += 0+$t; $EditEvent[$[+$i] = $t; # it's still a string } } } sub go_to { if (! $Paused) { $Paused = 1; timeout(-1); display_events(); } my $q = ' Go to time (ms) ? '; addl($LINES-3,2,$q); clrtobot(); refresh(); my $str; my $n; echo(); $n = getnstr($str,10); noecho(); time_travel($str-$Now); play_current_event(); return; } sub insert_event { my $event_type = event_type(); if (! $event_type) { return; } # 4.8 patch_change must be earlier than just 1 tick before my $gap_to_previous_event = $Track[$Ievent][$[+1]-$Track[$Ievent-1][$[+1]; my $gap_to_inserted_event = round(0.5 * $gap_to_previous_event); if ($gap_to_inserted_event < 1) { $gap_to_inserted_event = 1; } my $t = $Track[$Ievent][$[+1] - $gap_to_inserted_event; # 4.8 if ($t < 0) { $t = 0; } my @InsertEvent = ($event_type, $t); if ($event_type eq 'note') { push @InsertEvent, 200,0,60,100; # 5.4 } elsif ($event_type eq 'patch_change') { push @InsertEvent, 0, 0; } elsif ($event_type eq 'control_change') { push @InsertEvent, 0, 10, 64; } elsif ($event_type eq 'marker') { push @InsertEvent, 'NEW SECTION'; } elsif ($event_type eq 'bank_change') { $InsertEvent[$[] = 'control_change'; my @msb = (@InsertEvent, 0, 0, 5); splice @Track, $Ievent, 0, \@msb; $Ievent += 1; push @InsertEvent, 0, 32, 5; } splice @Track, $Ievent, 0, \@InsertEvent; $FileIsChanged = 1; # could add_to_history, but normally it will be edited if ($RangeStart >= $Ievent) { $RangeStart += 1; } # 4.5 if ($RangeEnd >= $Ievent) { $RangeEnd += 1; } local $called_from_insert_event = 1; # 4.3 # after ip we could often go straight to the patch number 'p', # (so ip4 not ipp4) but it's a drag if you only want to edit the channel. edit_event(); play_current_event(); # should play_current_event perhaps here, perhaps in edit_event ... # in edit_event there are many returns, and there are only two calls } sub metronome_event { my $c = $_[$[]; # must work in Play mode # how do we set whether to insert a click or insert a marker or both ? # Is this really necessary anyway ? # it was just part of a crazy scheme to make midi2muscript easier... my $pitch = 33; my $text = 'NEW BEAT'; if ($c eq 'B') { $pitch = 34; $text = 'NEW BAR'; } # In Play mode, we want to insert just before the note currently playing. # But Ievent doesn't necessarily point there; it might be pointing # to a control_change event that has been output subsequently. my $ievent = $Ievent; my $time = $Track[$ievent][$[+1] - 1; # just before the current event if ($time < 0) { $time = 0; } # my @event = ('note',$time, 500,9,$pitch,80); my @event = ('marker',$time, $text); splice @Track, $ievent, 0, \@event; $Ievent += 1; $FileIsChanged = 1; } sub note2str { my ($s,$t,$dt,$cha,$note,$vol) = @_; if ($s eq "control_change") { if ($dt==64) { # cc= if ($note > 63) { return "Ped"; } else { return "*"; } } return ''; } if (0+$cha == 9) { if ($note == 33) { return 'Metronome Click'; } # 7.0 if ($note == 34) { return 'Metronome Bell'; } # 7.0 return $MIDI::notenum2percussion{$note}; } # XXX By default, midiedit should display pitches # mapped left-to-right like a miniature piano: # C ab | Eb # C | Eb f~ # | Eb b f~ # If possible at least 3 characters per octave, plus '| ' unmoving; # bass is 3.3 octaves, treble 4 octaves = 22 chars; plus '| ' makes 24 # If less than 15 are available, revert to 'treble f~##' which uses 11. # Could also display the sounding chord, eg 'c233' or 'eb26' or 'Eb F B' my $clef = 'bass'; if ($note >= 60) { $clef = 'treble'; $note -= 24; } my $octave = ''; if ($note < 36) { my $o = int((47-$note)/12); $octave = '_' x $o; $note += 12 * $o; # 1.8 } elsif ($note >= 60) { my $o = int(($note-48)/12); $octave = '~' x $o; $note -= 12 * $o; # 1.8 } $note -= 36; return "$clef $note2letter[$note%24]$octave$note2acc[$note%12]"; } sub play_current_event { my @event = @{$Track[$Ievent]}; if ($event[$[] eq 'note') { # 3.1 and 5.1 adjust the duration $event[$[+2] = round($event[$[+2] / $ReplaySpeed); # millisec } my @alsaevent = MIDI::ALSA::scoreevent2alsa(@event); my ($status, $time,$events) = MIDI::ALSA::status(); $alsaevent[$[+4] = $time+0.005; MIDI::ALSA::output(@alsaevent); } sub edit_again { if (@EditEvent < 2) { return; } my @event = @{$Track[$Ievent]}; # if only ticks is involved, .=again should work even on different-types if (($EditEvent[$[] ne $event[$[]) and (2 < @EditEvent)) { $Message = "can't apply a (" . join(',',@EditEvent) . ") edit to a $event[$[] event"; # 4.3 return; } my $i = $[+1; if (defined $EditEvent[$i]) { # 3.7 my $t = $EditEvent[$i]; if ($IncrementalTimes and $Ievent>$[) { # similar to sub get_n above my $dt = $t - delta_t($Ievent); $event[$i] = $Track[$Ievent-1][$i] + $t; foreach my $ie ($Ievent+1..$#Track) { $Track[$ie][$i] += $dt; } } } for $i ($[+2 .. $#EditEvent) { if (defined $EditEvent[$i]) { if ($EditEvent[$i] =~ /^\d+$/) { $event[$i] = 0+$EditEvent[$i]; } elsif ($EditEvent[$i] =~ /^[-+]\d+$/) { $event[$i] += 0+$EditEvent[$i]; } elsif ($event[$[] =~ /^(marker|text)/) { # 7.3 $event[$i] = $EditEvent[$i]; } } } $Track[$Ievent] = \@event; set_before_last_change($Ievent); # 7.5 add_to_history(); } sub new_file { $Paused = 1; if (! $FileIsChanged) { return; } move($LINES-4,2); clrtobot(); addl($LINES-2,10, "y = yes, save n = no, don't save"); my $s = "Save $File first (y/n) ? "; addl($LINES-4,round(0.4*($COLS-length($s))),$s); timeout(-1); my $c = getch(); if ($c eq 'y' or $c eq 'w') { score2file($File, 1000,\@Track); } # move($LINES-4,0); clrtobot(); } sub quit { $Paused = 1; if (! $FileIsChanged) { exit 0; } move($LINES-4,2); clrtobot(); addl($LINES-2,10,"y = save file, n=just quit, anything else cancels."); my $s = "Save $File first (y/n) ? "; addl($LINES-4,round(0.4*($COLS-length($s))),$s); timeout(-1); my $c = getch(); if ($c eq 'y' or $c eq 'w') { score2file($File, 1000,\@Track); exit 0; } elsif ($c eq 'n') { exit 0; } display_keystrokes(); } sub replay_setup { my ($from, $to) = @_; # The arguments are _times_ in millisec. # If going forwards, we seek patches and ccs from $from to $to; # else we seek patches and ccs from $[ to $to. my $ievent = $[; if ($to > $from) { # 5.3 while ($ievent < $#Track) { # skip from beginning to $from if ($Track[$ievent][$[+1] >= $from) { last; } $ievent = $ievent + 1; } } my %cha2latest_patch = (); my %cha_cc2latest_val = (); while ($ievent < $#Track) { # scan to $to, looking for patch and cc if ($Track[$ievent][$[+1] >= $to) { last; } if ($Track[$ievent][$[] eq 'patch_change') { $cha2latest_patch{$Track[$ievent][$[+2]} = $Track[$ievent][$[+3]; } elsif ($Track[$ievent][$[] eq 'control_change') { $cha_cc2latest_val{"$Track[$ievent][$[+2],$Track[$ievent][$[+3]"} = $Track[$ievent][$[+4]; } $ievent = $ievent + 1; } # output the latest of each my ($cha,$pat); while (($cha,$pat) = each %cha2latest_patch) { my ($status, $time,$events) = MIDI::ALSA::status(); my @alsaevent = MIDI::ALSA::pgmchangeevent($cha,$pat,$time+0.001); MIDI::ALSA::output(@alsaevent); } # 20121018 while (my ($cha_cc,$val) = each %cha_cc2latest_val) { my ($cha,$cc) = split /,/, $cha_cc, 2; my ($status, $time,$events) = MIDI::ALSA::status(); # the bank-change events must come _before_ the patch-change ! # the other controller-events must come after the patch-change ... if (($cc != 0) and ($cc != 32)) { $time = $time + 0.002; } # 5.4 my @alsaevent = MIDI::ALSA::controllerevent($cha,$cc,$val,$time); MIDI::ALSA::output(@alsaevent); } if (%cha2latest_patch) { Time::HiRes::usleep(5000); # wait for the synth to load the patches } } sub range { $Paused = 1; # the effect (or write-to-file, or global edit, or delete etc) # there will typically be one set_range then several operations on it # forget pan (ic), pad (+et) if ($RangeStart >= $RangeEnd) { $Message = "sorry, no range is set; try R"; return; } move($LINES-4,0); clrtobot(); addl($LINES-4,4,"range is ".range_string()); # 4.6 my $x=19; addl($LINES-2,$x,'c=compand d=delete f=fade m=mixer p=pitch'); addl($LINES-1,$x,'q=quantise r=repeat t=tempo v=vol w=write_to_file'); addl($LINES-3,4,'apply effect ? '); my $x=19; my $c = getch(); clrtobot(); echo(); if ($c eq 'c') { addl($LINES-3,$x,'compand'); addl($LINES-2,4,'compand gradient ? '); # should display help about the 0.7 3:0.2 per-channel possibility $n = getnstr(my $params,6); range_compand(split(' ',$params)); } elsif ($c eq 'd') { range_delete(); } elsif ($c eq 'p') { addl($LINES-3,$x,'pitch'); addl($LINES-2,4,'pitch-change (cents) ? '); $n = getnstr(my $cents,20); range_pitch(split(' ',$cents)); } elsif ($c eq 'q') { addl($LINES-3,$x,'quantise'); addl($LINES-2,4,'quantise interval (mS) ? '); $n = getnstr(my $quan,6); range_quantise(0+$quan); } elsif ($c eq 'r') { addl($LINES-3,$x,'repeat'); addl($LINES-2,4,'how many times altogether ? '); $n = getnstr(my $times,6); range_repeat(0+$times); } elsif ($c eq 't') { addl($LINES-3,$x,'tempo'); addl($LINES-2,4,'tempo speed-ratio ? '); $n = getnstr(my $tempo,6); range_tempo(0+$tempo); } elsif ($c eq 'v') { addl($LINES-3,$x,'volume'); addl($LINES-2,4,'volume increment ? '); $n = getnstr(my $volume,6); range_volume(split(' ',$volume)); } elsif ($c eq 'w') { # 4.6 my $filename = ask_filename($LINES-3,'write to which filename ? '); return unless $filename; if ($filename !~ /\./) { $filename .= '.mid'; } if (-e $filename) { _warn("$filename exists already"); return; } range_write($filename); } } sub ask_filename { my ($y, $prompt) = @_; # 6.3 my $filename; addl($y,0,''); # from 0 to COLS-1, apparently refresh(); eval 'require Term::ReadLine'; if ($@) { _warn("you should install Term::ReadLine::Gnu from www.cpan.org"); echo(); getnstr($filename,52); noecho(); } else { system 'stty echo'; # Rough :-( $term = new Term::ReadLine 'midiedit'; # ugly underline, but backspace $filename = $term->readline(" $prompt"); system 'stty -echo'; # must be a better way than this... print STDERR "\e[A\r\e[0K"; # very ugly, asking for trouble :-( if ($filename) { $term->addhistory($filename); } $filename =~ s/ $//; # 6.2 no trailing space after completion } return $filename; } # 20120616 # in Edit mode, / should go PAUSED and then propose the find dialogue # after Inserting, the field labels at the top should get updated sub range_delete { # 4.5 should defend against $RangeEnd == $#Track set_before_last_change($Ievent); # 7.5 my $delta = $Track[$RangeEnd+1][$[+1] - $Track[$RangeStart][$[+1]; my $n_deleted = $RangeEnd-$RangeStart+1; splice @Track, $RangeStart, $n_deleted; $Message = "$n_deleted events deleted"; my $k = $RangeStart; while ($k <= $#Track) { $Track[$k][$[+1] -= $delta; $k += 1; } if ($Ievent > $#Track) { $Ievent = $#Track; # 4.7 } elsif ($Ievent > $RangeEnd) { $Ievent -= $n_deleted; # 5.6 } elsif ($Ievent > $RangeStart) { $Ievent = $RangeStart; # 5.6 } time_travel($Track[$Ievent][$[+1] - $Now); # 5.6 $RangeEnd = $[-1; add_to_history(); } sub range_pitch { my @params = @_; # 4.5; borrowed from midisox_pl set_before_last_change($Ievent); # 7.5 my $h = ', see midisox --help-effect=pitch'; if (! @params) { return; } my $default_incr; my %channel_incr = (); foreach my $param (@params) { if ($param =~ /^[-+]?\d+$/) { $default_incr = round($param/100); } else { if ($param =~ /^(\d+):([-+]?\d+)$/) { $channel_incr{0+$1} = round($2/100); } else { $Message = "pitch: strange parameter $param$h\n"; } } } if (not $default_incr) { if (%channel_incr) { $default_incr = 0; } else { return; } } my $k = $RangeStart; while ($k <= $RangeEnd) { if ($Track[$k][$[] eq 'note' and $Track[$k][$[+3] != 9) { my $incr = $default_incr; # don't shift drumkit if ($channel_incr{$Track[$k][$[+3]}) { $incr = $channel_incr{$Track[$k][$[+3]}; } $Track[$k][4] += $incr; if ($Track[$k][$[+4] > 127) { $Track[$k][$[+4] = 127; } elsif ($Track[$k][$[+4] < 0) { $Track[$k][$[+4] = 0; } } $k += 1; } set_before_last_change($Ievent); # 7.5 add_to_history(); } sub range_compand { my @params = @_; # 4.5; borrowed from midisox_pl set_before_last_change($Ievent); # 7.5 if (@params < 1) { $params[$[] = '0.5' } my $default_gradient; my %channel_gradient = (); my $iparam = $[; while ($iparam <= $#params) { my $param = $params[$iparam]; if ($param =~ /^-?\.?\d+$|^-?\d+\.\d*$/) { $default_gradient = 0 + $param; } elsif ($param =~ '^(\d+):(-?[.\d]+)$') { $channel_gradient{0+$1} = 0+$2; } else { _warn("compand: strange parameter $param$h"); return; } $iparam = $iparam + 1; } if (! defined $default_gradient) { if (%channel_gradient) { # test for empty table $default_gradient = 1.0; } else { $default_gradient = 0.5; } } # warn("channel_gradient=".Dumper(\%channel_gradient)); my $previous_note_time = 0; my $k = $RangeStart; while ($k <= $RangeEnd) { my $event_ref = $Track[$k]; if ($$event_ref[$[] eq 'note') { my $gradient = $default_gradient; if ($channel_gradient{$$event_ref[$[+3]}) { $gradient = $channel_gradient{$$event_ref[$[+3]}; } $$event_ref[$[+5]=100+round($gradient*($$event_ref[$[+5]-100)); if ($$event_ref[$[+5] > 127) { $$event_ref[$[+5] = 127; } elsif ($$event_ref[$[+5] < 1) { $$event_ref[$[+5] = 1; # v=0 sometimes means v=default } } $k += 1; } } sub range_quantise { my $quantum = $_[$[]; # 4.5; borrowed from midisox_pl set_before_last_change($Ievent); # 7.5 if ($quantum <= 0) { $Message = "the quantise interval must be positive"; return; } my $old_previous_note_time = $Track[$RangeStart][$[+1]; my $new_previous_note_time = $Track[$RangeStart][$[+1]; my $k = $RangeStart+1; while ($k <= $RangeEnd) { if ($Track[$k][$[] eq 'note') { my $old_this_note_time = $Track[$k][$[+1]; my $dt = $old_this_note_time - $old_previous_note_time; my $dn = round($dt/$quantum); # quantum must not be zero $Track[$k][$[+1] = $new_previous_note_time + $quantum*$dn; my $new_this_note_time = $Track[$k][$[+1]; # readjust non-note events to lie between the adjusted times # in the same proportion as they lay between the old times my $k2 = $k - 1; while ($k2 >= $[ and $Track[$k2][$[] ne 'note') { my $old_non_note_time = $Track[$k2][$[+1]; if ($old_this_note_time > $old_previous_note_time) { $Track[$k2][$[+1] = round($new_previous_note_time + ($old_non_note_time - $old_previous_note_time) * ($new_this_note_time - $new_previous_note_time) / ($old_this_note_time - $old_previous_note_time) ); } else { $Track[$k2][$[+1] = $new_previous_note_time; } $k2 = $k2 - 1; } if ($dn > 0) { # 5.8, see midisox* versions 5.4 $old_previous_note_time = $old_this_note_time; $new_previous_note_time = $new_this_note_time; } } $k += 1; } # now timeshift from $RangeEnd to $#Track ... my $delta = $new_previous_note_time - $old_previous_note_time; while ($k <= $#Track) { $Track[$k][$[+1] += $delta; $k += 1; } add_to_history(); } sub range_repeat { my $times = round($_[$[]); set_before_last_change($Ievent); # 7.5 if ($times == 0) { $Message = "to repeat zero times, just use delete"; return; } if ($times == 1) { $Message = "repeat once leaves the file unchanged"; return; } my $r_end = $RangeEnd; if ($RangeEnd == $#Track) { $r_end = $RangeEnd-1; } my $delta = $Track[$r_end+1][$[+1] - $Track[$RangeStart][$[+1]; my $n_in_range = $r_end-$RangeStart+1; # debug("r_end=$r_end delta=$delta n_in_range=$n_in_range"); my $k = $r_end; foreach my $time (2 .. $times) { splice @Track, $k+1, 0, deepcopy(@Track[$RangeStart..$r_end]); foreach my $i (1 .. $n_in_range) { $k += 1; $Track[$k][$[+1] += $delta*($time-1); } } $k += 1; while ($k <= $#Track) { $Track[$k][$[+1] += $delta*($times-1); $k += 1; } # 5.7 move cursor, if it lay after RangeEnd (see range_delete 5.6) if ($Ievent > $RangeEnd) { # 5.7 my $t = ($times-1)*$delta; # debug("times=$times delta=$delta t=$t"); time_travel(($times-1)*$delta); } $Message = sprintf("%d new events", $n_in_range*($times-1)); add_to_history(); } sub range_tempo { my $tempo = $_[$[]; # 4.5 set_before_last_change($Ievent); # 7.5 if ($tempo == 1.0) { return; } if ($tempo <= 0) { $tempo = 0.1; } # following midisox_pl usage my $range_start_time = $Track[$RangeStart][$[+1]; my $old_range_end_time = $Track[$RangeEnd][$[+1]; my $k = $RangeStart+1; while ($k <= $RangeEnd) { $Track[$k][$[+1] = $range_start_time + round(($Track[$k][$[+1]-$range_start_time)/$tempo); if ($Track[$k][$[] eq 'note') { # fix the duration $Track[$k][$[+2] = round($Track[$k][$[+2]/$tempo); } $k += 1; } my $new_range_end_time = $Track[$RangeEnd][$[+1]; # now timeshift from $RangeEnd to $#Track ... my $delta = $new_range_end_time - $old_range_end_time; while ($k <= $#Track) { $Track[$k][$[+1] += $delta; $k += 1; } add_to_history(); } sub range_volume { my @params = @_; # 4.5 set_before_last_change($Ievent); # 7.5 my $h = ', see midisox --help-effect=vol'; if (! @params) { return; } my $default_incr; my %channel_incr = (); foreach my $param (@params) { if ($param =~ /^[-+]?\d+$/) { $default_incr = 0 + $param; } else { if ($param =~ /^(\d+):([-+]?\d+)$/) { $channel_incr{0+$1} = 0+$2; } else { die "vol: strange parameter $param$h\n"; } } } if (not $default_incr) { if (%channel_incr) { $default_incr = 0; } else { return; } } my $k = $RangeStart; while ($k <= $RangeEnd) { if ($Track[$k][$[] eq 'note') { my $incr = $default_incr; if ($channel_incr{$Track[$k][$[+3]}) { $incr = $channel_incr{$Track[$k][$[+3]}; } $Track[$k][5] += $incr; if ($Track[$k][$[+5] > 127) { $Track[$k][$[+5] = 127; } elsif ($Track[$k][$[+5] < 0) { $Track[$k][$[+5] = 0; } } $k += 1; } add_to_history(); } sub range_write { my $filename = $_[$[]; # 4.6, 6.1 return unless $filename; my @range_score = ( 1000, [ ['set_tempo', 1, 1000000], ] ); # 6.1 a score uses absolute times; must subtract first t1 from all events my $t1 = $Track[$RangeStart][$[+1]; my $k = $RangeStart; while ($k <= $RangeEnd) { my @event = @{$Track[$k]}; $event[$[+1] -= $t1; # 6.1 push @{$range_score[$[+1]}, \@event; $k += 1; } # 6.2 append a marker to represent the time-to-next-note # XXX should iterate to find a NOTE ! my $time_next_note = $Track[$RangeEnd+1][$[+1]; if ($time_next_note) { my $file = $File; # 6.3 give filename it came from, and $t1 if (20 < length $file) { $file =~ s#^.*/([^/]+)$#$1#; } my $s = "from $file at $t1 mS"; push @{$range_score[$[+1]}, ['marker', $time_next_note-$t1, $s]; } score2file($filename, @range_score); _warn("range written to $filename"); } sub re_do { set_before_last_change($Ievent); # 7.5 #debug("re_do1: Ihistory=$Ihistory #History=$#History History=@History"); if ($Ihistory > ($#History-3)) { $Message="Already at newest change"; return; } $Ihistory += 1; my $r = $History[$Ihistory]; if (ref $r ne ARRAY) { $Message="ref r was ".ref $r; } @Track = deepcopy(@$r); $Ihistory += 1; $Ievent = $History[$Ihistory]; $Ihistory += 1; $Now = $History[$Ihistory]; #debug("re_do2: Ihistory=$Ihistory #History=$#History History=@History"); } sub row_nums { my $i_top = 2; # row-number if (!$TopKeystrokesLine) { display_keystrokes(); } my $i_bot = $TopKeystrokesLine - 2; # row-number if ($i_top > ($i_bot-4)) { die "not enough rows on screen\n"; } my $i_now; # row-number if ((scalar @Track) <= ($i_bot-$i_top+1)) { $i_now = $i_top + $Ievent -$[; } elsif ($Ievent < 0.5*($i_bot-$i_top+1)) { $i_now = $i_top + $Ievent -$[; } elsif (($#Track-$Ievent) < 0.5*($i_bot-$i_top+1)) { $i_now = $i_bot + $Ievent - $#Track; } else { $i_now = round(0.5*($i_top+$i_bot)); } return ($i_top, $i_now, $i_bot); } sub set_range { # 4.5 if ($RangeSettingState == 0) { $RangeStart = $Ievent; $RangeEnd = $[-1; $RangeSettingState = 1; } elsif ($RangeStart == $Ievent) { $RangeEnd = $[-1; $Message = "empty range"; $RangeSettingState = 0; } else { $RangeEnd = $Ievent; if ($RangeEnd < $RangeStart) { my $t=$RangeStart; $RangeStart=$RangeEnd; $RangeEnd=$t; } _warn("new range ".range_string()); $RangeSettingState = 0; } } sub range_string { my $start_ms = $Track[$RangeStart][$[+1]; my $end_ms = $Track[$RangeEnd][$[+1]; return "from $start_ms to $end_ms mS"; } sub set_timeout_for_next_note { if ($Ievent < $#Track) { # set the timeout for the one after my $delay_ms = $Track[$Ievent+1][$[+1] - $Now; $delay_ms = round($delay_ms / $ReplaySpeed); # 3.1 if ($delay_ms < 1) { $delay_ms = 1; } timeout($delay_ms); } } sub time_travel { my $dt = $_[$[]; if (! $dt) { return; } my $then = $Now; $Now = $Now + $dt; if ($dt > 0) { my $found = 0; while ($Ievent < $#Track) { if ($Track[$Ievent+1][$[+1] > $Now) { $found = 1; last; } $Ievent = $Ievent + 1; } if (! $found) { $Ievent = $#Track; $Now = $Track[$Ievent][$[+1]; } replay_setup($then, $Now); } else { my $found = 0; while ($Ievent >= $[) { if ($Track[$Ievent][$[+1] < $Now) { $found = 1; last; } $Ievent = $Ievent - 1; } if (! $found) { $Ievent = $[; $Now = $Track[$Ievent][$[+1]; } replay_setup(0, $Now); } play_current_event(); if (! $Paused) { set_timeout_for_next_note(); } } sub event_travel { my $di = $_[$[]; # 5.2 # 20120930 stripped down from time_travel, for use by UP and DOWN if (! $di) { return; } my $then = $Now; $Ievent = $Ievent + $di; if ($Ievent > $#Track) { $Ievent = $#Track } elsif ($Ievent < $[) { $Ievent = $[; } $Now = $Track[$Ievent][$[+1]; replay_setup($then, $Now); play_current_event(); if (! $Paused) { set_timeout_for_next_note(); } } sub un_do { if ($Ihistory < $[+3) { $Message = "Already at oldest change"; return; } $Ihistory -= 3; $Now = $History[$Ihistory]; $Ievent = $History[$Ihistory-1]; # 7.5 re-instated my $r = $History[$Ihistory-2]; @Track = deepcopy(@$r); } #------------ MIDI infrastructure from midisox_pl ------------ sub _print { print ($_[$[]."\n"); } sub _warn { $Message = $_[$[]; } # wiped by display_keystrokes() sub warning { _warn('warning: '.$_[$[]); } sub _die { die($_[$[]."\n"); } sub round { my $x = $_[$[]; if ($x > 0.0) { return int ($x + 0.5); } if ($x < 0.0) { return int ($x - 0.5); } return 0; } sub deepcopy { use Storable; if (1 == @_ and ref($_[$[])) { return Storable::dclone($_[$[]); } else { my $b_ref = Storable::dclone(\@_); return @$b_ref; } } sub vol_mul { my $vol = $_[$[] || 100; my $mul = $_[$[+1] || 1.0; my $new_vol = round($vol*$mul); if ($new_vol < 0) { $new_vol = 0 - $new_vol; } if ($new_vol > 127) { $new_vol = 127; } elsif ($new_vol < 1) { $new_vol = 1; # some synths see vol=0 as default } return $new_vol; } #---------------------- Encoding stuff ----------------------- sub opus2file { my ($filename, @opus) = @_; my $format = 1; if (2 == @opus) { $format = 0; } my $cpan_opus = MIDI::Opus->new( {'format'=>$format, 'ticks' => 1000, 'tracks' => []}); my @list_of_tracks = (); my $itrack = $[+1; while ($itrack <= $#opus) { push @list_of_tracks, MIDI::Track->new({ 'type' => 'MTrk', 'events' => $opus[$itrack]}); $itrack += 1; } $cpan_opus->tracks(@list_of_tracks); if ($filename eq '-') { $cpan_opus->write_to_file( '>-' ); } elsif ($filename eq '-d') { $PID = fork; if (! $PID) { if (!open(P, '| aplaymidi -')) { die "can't run aplaymidi: $!\n"; } $cpan_opus->write_to_handle( *P{IO}, {} ); close P; exit 0; } } else { $cpan_opus->write_to_file($filename); } } sub score2opus { if (2 > @_) { return (1000, []); } my ($ticks, @tracks) = @_; my @opus = ($ticks,); my $itrack = $[; while ($itrack <= $#tracks) { my %time2events = (); foreach my $scoreevent_ref (@{$tracks[$itrack]}) { my @scoreevent = @{$scoreevent_ref}; if ($scoreevent[0] eq 'note') { my @note_on_event = ('note_on',$scoreevent[1], $scoreevent[3],$scoreevent[4],$scoreevent[5]); my @note_off_event = ('note_off',$scoreevent[1]+$scoreevent[2], $scoreevent[3],$scoreevent[4],$scoreevent[5]); if ($time2events{$note_on_event[1]}) { push @{$time2events{$note_on_event[1]}}, \@note_on_event; } else { @{$time2events{$note_on_event[1]}} = (\@note_on_event,); } if ($time2events{$note_off_event[1]}) { push @{$time2events{$note_off_event[1]}}, \@note_off_event; } else { @{$time2events{$note_off_event[1]}} = (\@note_off_event,); } } elsif ($time2events{$scoreevent[1]}) { push @{$time2events{$scoreevent[1]}}, \@scoreevent; } else { @{$time2events{$scoreevent[1]}} = (\@scoreevent,); } } my @sorted_events = (); # list of event_refs sorted by time for my $time (sort {$a <=> $b} keys %time2events) { push @sorted_events, @{$time2events{$time}}; } my $abs_time = 0; for my $event_ref (@sorted_events) { # convert abs times => delta times my $delta_time = ${$event_ref}[1] - $abs_time; $abs_time = ${$event_ref}[1]; ${$event_ref}[1] = $delta_time; } push @opus, \@sorted_events; $itrack += 1; } return (@opus); } sub score2file { my ($filename, @score) = @_; my @opus = score2opus(@score); return opus2file($filename, @opus); } #--------------------------- Decoding stuff ------------------------ sub file2opus { my $opus_ref; if ($_[$[] eq '-') { $opus_ref = MIDI::Opus->new({'from_handle' => *STDIN{IO}}); } elsif ($_[$[] =~ /^[a-z]+:\//) { eval 'require LWP::Simple'; if ($@) { _die "you need to install libwww-perl from www.cpan.org"; } $midi = LWP::Simple::get($_[$[]); if (! defined $midi) { _die("can't fetch $_[$[]"); } open(P, '<', \$midi) or _die("can't open FileHandle, need Perl5.8"); $opus_ref = MIDI::Opus->new({'from_handle' => *P{IO}}); close P; } else { $opus_ref = MIDI::Opus->new({'from_file' => $_[$[]}); } # $opus_ref->dump({'dump_tracks'=>1}); my @my_opus = (${$opus_ref}{'ticks'},); foreach my $track ($opus_ref->tracks) { push @my_opus, $track->events_r; } # print "3:\n", Dumper(\@my_opus); return @my_opus; } sub opus2score { my ($ticks, @opus_tracks) = @_; # print "opus2score: ticks=$ticks opus_tracks=@opus_tracks\n"; if (!@opus_tracks) { return (1000,[],); } my @score = ($ticks,); #foreach my $i ($[+1 .. $#_) { # push @score, MIDI::Score::events_r_to_score_r($score[$i]); #} my @tracks = deepcopy(@opus_tracks); # couple of slices probably quicker... # print "opus2score: tracks is ", Dumper(@tracks); foreach my $opus_track_ref (@tracks) { my $ticks_so_far = 0; my @score_track = (); my %chapitch2note_on_events = (); # 4.4 XXX!!! Must be by Channel !! foreach $opus_event_ref (@{$opus_track_ref}) { my @opus_event = @{$opus_event_ref}; $ticks_so_far += $opus_event[1]; if ($opus_event[0] eq 'note_off' or ($opus_event[0] eq 'note_on' and $opus_event[4]==0)) { # YY my $cha = $opus_event[2]; my $pitch = $opus_event[3]; my $key = $cha*128 + $pitch; if ($chapitch2note_on_events{$key}) { my $new_event_ref = shift @{$chapitch2note_on_events{$key}}; ${$new_event_ref}[2] = $ticks_so_far - ${$new_event_ref}[1]; push @score_track, $new_event_ref; } else { _warn("note_off without a note_on, cha=$cha pitch=$pitch") } } elsif ($opus_event[0] eq 'note_on') { my $cha = $opus_event[2]; # 4.4 my $pitch = $opus_event[3]; my $new_event_ref = ['note', $ticks_so_far, 0, $cha, $pitch, $opus_event[4]]; my $key = $cha*128 + $pitch; push @{$chapitch2note_on_events{$key}}, $new_event_ref; } else { $opus_event[1] = $ticks_so_far; push @score_track, \@opus_event; } } # 4.7 check for unterminated notes, see: ~/lua/lib/MIDI.lua while (my ($k1,$v1) = each %chapitch2note_on_events) { foreach my $new_e_ref (@{$v1}) { ${$new_e_ref}[2] = $ticks_so_far - ${$new_e_ref}[1]; push @score_track, $new_e_ref; warn("opus2score: note_on with no note_off cha=" . ${$new_e_ref}[3] . ' pitch=' . ${$new_e_ref}[4] . "; adding note_off at end\n"); } } push @score, \@score_track; } return @score; } sub file2score { return opus2score(file2opus($_[$[])); } sub file2ms_score { my @opus = file2opus($_[$[]); my @ms = to_millisecs(@opus); my @score = opus2score(@ms); # must merge the tracks of a format-2 file; could perhaps even # extend the @event to indicate which Track it originated in... my $itrack = $#score; while ($itrack > ($[+1.5)) { foreach my $event_ref (@{$score[$itrack]}) { push @{$score[$[+1]}, $event_ref; # push them onto track 1 } $itrack -= 1; $#score = $itrack; # and jettison the last track } return @score; } #------------------------ Other Transformations --------------------- sub to_millisecs { # 20160702 rewrite, following MIDI.lua 6.7 my @old_opus = @_; if (!@old_opus) { return (1000,[],); } my $old_tpq = $old_opus[$[]; my @new_opus = (1000,); # 6.7 first go through building a table of set_tempos by absolute-tick my %ticks2tempo = (); $itrack = $[+1; while ($itrack <= $#old_opus) { my $ticks_so_far = 0; foreach my $old_event_ref (@{$old_opus[$itrack]}) { my @old_event = @{$old_event_ref}; if ($old_event[0] eq 'note') { _die 'to_millisecs needs an opus, not a score'; } $ticks_so_far += $old_event[1]; if ($old_event[0] eq 'set_tempo') { $ticks2tempo{$ticks_so_far} = $old_event[2]; } } $itrack += 1; } # then get the sorted-array of their keys my @tempo_ticks = sort { $a <=> $b; } keys %ticks2tempo; # then go through converting to millisec, testing if the next # set_tempo lies before the next track-event, and using it if so. $itrack = $[+1; while ($itrack <= $#old_opus) { my $ms_per_old_tick = 1000.0 / $old_tpq; # will round later my $i_tempo_ticks = 0; my $ticks_so_far = 0; my $ms_so_far = 0.0; my $previous_ms_so_far = 0.0; my @new_track = (['set_tempo',0,1000000],); # new "crochet" is 1 sec foreach my $old_event_ref (@{$old_opus[$itrack]}) { # detect if ticks2tempo has something before this event # 20160702 if ticks2tempo is at the same time, leave it my @old_event = @{$old_event_ref}; my $event_delta_ticks = $old_event[1]; if ($i_tempo_ticks <= $#tempo_ticks and $tempo_ticks[$i_tempo_ticks] < ($ticks_so_far+$old_event[1])) { my $delta_ticks = $tempo_ticks[$i_tempo_ticks]-$ticks_so_far; $ms_so_far += ($ms_per_old_tick * $delta_ticks); $ticks_so_far = $tempo_ticks[$i_tempo_ticks]; $ms_per_old_tick=$ticks2tempo{$ticks_so_far}/(1000*$old_tpq); $i_tempo_ticks += 1; $event_delta_ticks -= $delta_ticks; } # now handle the new event my @new_event = deepcopy(@old_event); # copy.deepcopy ? $ms_so_far += ($ms_per_old_tick * $old_event[1]); $new_event[1] = round($ms_so_far-$previous_ms_so_far); if ($old_event[0] ne 'set_tempo') { # set_tempos already handled! $previous_ms_so_far = $ms_so_far; push @new_track, \@new_event; } $ticks_so_far += $event_delta_ticks; } push @new_opus, \@new_track; $itrack += 1; } # print "to_millisecs new_opus = ", Dumper(\@new_opus); return @new_opus; } #----------------- non-Curses infrastructure ----------------- sub line2comment { my $line = $_[$[]; if ($line =~ /[a-z]', (\d+), /) { $ticks += $1; } elsif ($line =~ /MIDI::Track->new/) { $ticks = 0; return q{}; # 7.8 } else { return q{}; } my $len = length $line; my $spaces = " "; if ($len < 37) { $spaces = " " x (38-$len); } my $event_type; my $remainder; if ($line =~ /\['([a-z_]+)', (.+)\]/) { $event_type = $1; $remainder = $2; } if ($event_type =~ /^note_/) { my ($dt,$cha,$note,$vol) = split(/,\s*/, $remainder); my $str = note2str('',0,0,$cha,$note,$vol); if ($event_type eq 'note_off' or $vol eq '0') { return "$spaces# ticks=$ticks cha=$cha $str off"; } else { return "$spaces# ticks=$ticks cha=$cha $str"; } } elsif ($event_type eq 'control_change') { my ($dt,$cha,$cc,$val) = split(/,\s*/, $remainder); return "$spaces# ticks=$ticks cha=$cha cc$cc=$val"; } elsif ($event_type eq 'patch_change') { my ($dt,$cha,$patch) = split(/,\s*/, $remainder); return "$spaces# ticks=$ticks cha=$cha patch=$patch"; } else { return "$spaces# ticks=$ticks"; } } =pod =head1 NAME midiedit - Edits a MIDI file =head1 SYNOPSIS midiedit filename.mid # uses the new Curses app, with sound midiedit -o 128:0 filename.mid # uses ALSA port 128:0 as synth midiedit -d filename.mid # uses your EDITOR on a MIDI::Perl dump midiedit -v # prints the Version number =head1 DESCRIPTION B is a MIDI-file editor which now (since version 1.3) has a choice of two user-interface modes. In the new default mode, it uses I to offer a purpose-designed user-interface and I to play the notes to your synth. In the older lower-tech mode, it uses your favourite text-editor to edit the human-readable text-format provided by I's $opus->dump function. =head1 CURSES MODE In the Curses mode, which is the default, I edits a MIDI file with a purpose-designed user-interface which re-uses some keystrokes inspired by B: for example, B=insert B=mark B=+-1event B=undo B<^R>=redo B=find B=reversefind B=findnext B=findprevious B=write B=quit B<.>=last_edit_again, plus a few others, e.g.: B=edit_event, B=delete_event, B=define_a_range, B=operate_on_that_range, B=file_operations, B=all_sounds_off, and B<^H/Backspace>=return_where_you_were_before_the_I As in I, the spacebar toggles between Play and Pause, the Left and Right arrow keys move by 1 second, the Up and Down arrow keys move by 10 seconds, and the Home and End keys move to the start and end of the file, and B<[> and B<]> or B<{> and B<}> change the Replay-speed. The available keystrokes are displayed in the bottom four lines of the screen. The events are displayed in B-form, i.e. with a start-time and a duration. There are no separate note_on and note_off events, which solves the matching-ons-and-offs problem. All times are displayed in milliseconds. The start-times can be displayed either as incremental times (since the previous event), or as absolute times (since the beginning). The B<+> and B<-> keys switch between these modes; the default mode is incremental. The behaviour of Edit, Insert and Delete adapts to the display-mode; for example with incremental times, deleting a note shortens the whole file by the deleted millisecond increment, but with absolute times deleting a note just removes that note and leaves the duration of the whole file unchanged. Since version 3.0, B=find allows search criteria such as >62 or <25 or >=60 or <=72 or !=9 or >59&<73 which, when combined with B<.>=last_edit_again make it easier to do things like "move that high bit of the piano solo into a different channel". Since version 4.5, a I can be defined by pressing upper-case B once at each end of the desired range. Once defined, the I can be operated on, using a lower-case B, in various ways ( B=compand B=delete B=mixer B

=pitch B=quantise B=repeat B=tempo B=vol B=write_to_file ) largely modelled on the corresponding I effects. For details of what the I effect does, see: midisox --help-effect=compand Since version 7.7, after a I (B, B, B or B), B or B returns you to where you were before the I. You can specify your choice of synth at the command line with a B<-o 128:0> option, or else with the I environment variable. The special value B<-o 0> silences the output (e.g. you might want to edit something while listening to something else). Since Version 2.4, you may supply a comma-separated list of ports, e.g. B<-o 20,128:1> As well as the B CPAN module, this mode also uses the B module for the user-interface, and the B module to play the file to your synth. =head1 DUMP MODE In the older, low-tech B<-d> mode, I edits a MIDI file in the human-readable text-format provided by I's $opus->dump function. The text format representing the MIDI is executable Perl source, so as you edit, you should preserve valid Perl syntax. If the edited file has syntax errors, you will be asked if you want to re-edit it, and if you reply No then the original file will not get over-written. If you've changed the text, and then decide you want to quit without overwriting the MIDI file, then you have to deliberately mess up the Perl syntax (e.g. make sure the brackets are unbalanced). Assuming you've installed MIDI::Perl, then C should document the format in which the various MIDI-events are represented. They are represented with incremental times (in ticks) and with separate note_on and note_off events, so you have to keep track of matching note_ons and note_offs. =head1 CHANGES 7.8 20160701, -d with multi-track midi-files resets ticks to 0 each track 7.7 20151106, after a Find, ctrl-H or Backspace returns to where you were 7.6 20151105, finding a marker matches on a substring 7.5 20151031, like 7.4, except it also works for multiple un-do's 7.4 20151030, 'u' leaves Ievent as before last edit, not after the previous 7.3 20151008, edit_again now works for markers and text events 7.2 20151003, fix bug which introduced undefined events 7.1 20151002, event2str defends against unprintable chars in text events 7.0 20150513, displays also Metronome Click and Metronome Bell 6.9 20150411, all_sounds_off also turns all notes off 6.8 20150223, display channel_after_touch column-aligned as cha_aftertouch 6.7 20141201, skip refreshes if <10ms to next event 6.6 20141104, removed misleading 'm=mark' help-text 6.5 20140703, controller_change events display controller-names 6.4 20140702, display_events patch_change events display GM patch-names 6.3 20140612, ask_filename does backspace, range_write won't overwrite 6.2 20140611, range_write appends marker to represent time-to-next-note 6.2 20140611, filename-completion gets its trailing space stripped 6.2 20140611, File Include works, corresponding to range_write 6.1 20140610, range_write no longer has big pause at the start 6.0 20130404, display_events remembers the Ped/* state by channel 5.9 20130323, find_marker with null text finds the next marker 5.8 20130321, bug fixed in range_quantise effect 5.7 20130302, range_repeat moves cursor down if it lay after RangeEnd 5.6 20130301, range_delete moves cursor up if it lay after RangeEnd 5.5 20130218, u=undo and ^R=redo seem to work 5.4 20121028, replay_setup outputs bankchange before the patchchange 5.3 20121001, replay_setup (hence time_travel) works for- and backward 5.2 20120930, KEY_UP uses event_travel() to cope with dt=0 5.1 20120930, works with MIDI::ALSA 1.15; PolyOn=127 fixed 5.0 20120916, edit_event uses p=pitch not n=note 4.9 20120910, f=file_menu: f=fork n=new s=save q=quit 4.8 20120908, KEY_UP uses time_travel(), so as to get the right patch 4.7 20120903, display_events clears lines after EOF, range_delete 4.6 20120628, rw = range_write now works 4.5 20120624, R and r range-operations largely work 4.4 20120613, event-fields correctly displayed also in edit-mode 4.3 20120612, consistent redo and undo; find_event uses time_travel 4.2 20120609, can search for long gaps or short gaps 4.1 20120608, becomes Paused at EOF; channel,note in bold if note-on 4.0 20120604, j,k keys also available in Edit Mode 3.9 20120604, '.'=repeat also offered in Edit Mode, if applicable 3.8 20120604, find offers s=short_gap, l=long_gap and t=time (==go_to) 3.7 20120604, '.' repeats also edit of dt if IncrementalTimes 3.6 20120529, tracks shorter than screen-height don't get extended 3.5 20120527, add g = go_to() 3.4 20120525, displays most recent Ped and * 3.3 20120510, displays currently on notes 3.2 20120502, can now insert bank_change (= 2 control_changes) 3.1 20120326, # ] and [ or } and { change the ReplaySpeed 3.0 20120110, find_match gives find >5&<15&!=9 searches 2.9 20120108, '.' repeats last edit (if event-types match) 2.8 20111126, find works if cha=0 or value=0 2.7 20111107, edit_event dialogue updated as changes are made 2.6 20111103, use the new MIDI-ALSA 1.11 to handle portnames 2.5 20111029, column-titles better reflect the event-types 2.4 20111028, OutputPort can be a comma-separated list 2.3 20111027, merges multiple tracks; z=all_sounds_off 2.2 20111027, entering PAUSED mode causes all_sounds_off 2.1 20111027, displays note-string in main window 2.0 20111027, doesn't try to connect if $OutputPort undefined or "0" 1.9 20111022, Phaser Depth and Poly On displayed correctly 1.8 20111021, displays notes with ~ and _ correctly 1.7 20110926, handles non-millisec-tick files correctly 1.6 20110917, display_this_event shows changes as they are made 1.5 20110910, Up/Down in edit-mode play the new note 1.4 20110909, in edit mode, Up and Down don't leave edit-mode 1.3 20110820, the new Curses app is the default 1.2 20110708, displays helpful comments 1.1 20060728, first working version =head1 AUTHOR Peter J Billam http://www.pjb.com.au/comp/contact.html =head1 CREDITS Based on the I and I and I CPAN modules. The non-Curses mode also uses Peter Billam's I CPAN module. =head1 SEE ALSO http://search.cpan.org/perldoc?MIDI http://search.cpan.org/perldoc?Curses http://search.cpan.org/perldoc?MIDI::ALSA http://search.cpan.org/perldoc?Term::Clui http://www.pjb.com.au/muscript http://www.pjb.com.au/midi =cut MIDI-ALSA-1.22/examples/midifade0000755000076400017500000004223413007532625014330 0ustar pjbpjb#! /usr/bin/perl ######################################################################### # This Perl script is Copyright (c) 2006, Peter J Billam # # c/o P J B Computing, GPO Box 669, Hobart TAS 7001, Australia # # # # This script is free software; you can redistribute it and/or # # modify it under the same terms as Perl itself. # ######################################################################### # # see 20111002 midislide ? # 20140306 seconded ! : for pitch-adjusting the midi # when there are midi files and audio-files # so that the synth can be tuned by hand to an arbitrary wav file # could simply offer pitchbend as a alternative to cc=? # perhaps just the letter "p" instead of the cc number ! # Or, should always apply to all channels ? This will be the common case... # # Also: an audiofile-mixer option, which starts up a suitable ecasound # and offers vol,pan,filter on each audiofile ! # midifade -audio v,p gtr.wav v,f,q str.wav v brass.wav backing.wav # and could record its fadermovements in a midi file # which (or several of which) can be replayed behind subsequent passes # should contain a comment on which vpfq and which audiofile, # so the ecasound commands can be reconstructed. # midifade -audio -replay mix0.mid,mix1.mid v,p,f,q vocal.wav final.wav # those midifiles should automatically replay their audio-file. # However the whole mechanism only redoes what can be done by producing # a mixed-down .wav, and then using that as subsequent audio input. # Therefore forget the -replay option and the custom midi-comments. # Curses interface from midiedit, midi stuff from midikbd. # On exit, could print the equivalent muscript, or Perl,Python,or Lua ? # 20130814: midifade could conceiveably take an a=auto for the value, # asking somehow for min, max, period, perhaps sin/tri/sawup/sawdown, and # then behave like panfarm on MIDI::ALSA. Probably need a child process... # 20130815: Also, then what would the Up/Down/PgUp/PgDown/Home/End keys do ? # or, instead of n=new, perhaps w=wahwah and p=pan ? 74 wants also 71 # should this be in our hypothetical midihub? Only really applies to 11,74 my $Version = '2.0'; # a new fader with val=0 does not get given val=64 my $VersionDate = '09aug2015'; my $OutputPort = $ENV{'ALSA_OUTPUT_PORTS'}; my $ColsPerFader = 6; my $AlsaName = "midifade"; eval 'require Curses'; if ($@) { die "you'll need to install the Curses module from www.cpan.org\n"; } import Curses; eval 'require MIDI::ALSA'; if ($@) { die "you'll need to install the MIDI::ALSA module from www.cpan.org\n"; } import MIDI::ALSA; # use Data::Dumper; while ($ARGV[$[] =~ /^-(\w)/) { if ($1 eq 'd') { $UseCurses = 0; shift; } elsif ($1 eq 'o') { shift; $OutputPort = shift; } elsif ($1 eq 'N') { shift; $AlsaName = shift; } else { print < man inopts timeout(-1); # Shouldn't happen. Anyway, block next read # but could use this for a Message which vanishes after 2 sec } elsif ($c eq 'q') { quit(); } elsif ($c eq 'Q') { exit 0; } elsif ($c eq 'D') { # or $c==KEY_DL() or $c==KEY_DC()) { too close to End if (@Faders) { splice @Faders, $IFader, 1; if ($IFader > $#Faders) { $IFader = $#Faders; } } display_screen(); } elsif ($c eq 'n') { my ($c,$m,$v) = new_fader_dialogue(); if (defined $m) { add_new_fader($c,$m,$v); } display_screen(); } elsif ($c == KEY_UP() or $c eq 'k') { my ($c,$m,$v) = @{$Faders[$IFader]}; $v += 1; if ($v > 127) { $v = 127; } $Faders[$IFader] = [$c,$m,$v]; output_fader($IFader); display_screen(); } elsif ($c == KEY_DOWN() or $c eq 'j') { my ($c,$m,$v) = @{$Faders[$IFader]}; $v -= 1; if ($v < 0) { $v = 0; } $Faders[$IFader] = [$c,$m,$v]; output_fader($IFader); display_screen(); } elsif ($c == KEY_LEFT() or $c eq 'h') { if ($IFader>$[) { $IFader -= 1; } display_screen(); } elsif ($c == KEY_RIGHT() or $c eq 'l') { if ($IFader<$#Faders) { $IFader += 1; } display_screen(); } elsif ($c eq "\t") { if ($IFader<$#Faders) { $IFader += 1; } else { $IFader = $[; } display_screen(); } elsif ($c == KEY_PPAGE() or $c eq 'K') { my ($c,$m,$v) = @{$Faders[$IFader]}; $v += 10; if ($v > 127) { $v = 127; } $Faders[$IFader] = [$c,$m,$v]; output_fader($IFader); display_screen(); } elsif ($c == KEY_NPAGE() or $c eq 'J') { my ($c,$m,$v) = @{$Faders[$IFader]}; $v -= 10; if ($v < 0) { $v = 0; } $Faders[$IFader] = [$c,$m,$v]; output_fader($IFader); display_screen(); } elsif ($c == KEY_HOME()) { my ($c,$m,$v) = @{$Faders[$IFader]}; $Faders[$IFader] = [$c,$m,127]; output_fader($IFader); display_screen(); } elsif ($c == KEY_END()) { # all_sounds_off ? or v=0? my ($c,$m,$v) = @{$Faders[$IFader]}; $Faders[$IFader] = [$c,$m,0]; output_fader($IFader); display_screen(); } } #-------------- Infrastructure for the Curses version ------------- sub addl { my ($lin,$col,$str) = @_; move($lin,$col); addstr($str); clrtoeol(); } sub all_sounds_off { foreach my $c (0..15) { MIDI::ALSA::output(MIDI::ALSA::controllerevent($c,120,0)); } MIDI::ALSA::stop(); } sub cc2str { my $m = $_[$[]; if (! %c2s) { %c2s = ( 0, 'Bank Select (MSB)', 32, 'Bank Select (LSB)', 64, 'Sustain Pedal', 96, 'Data Increment', 1, 'Modulation (MSB)', 33, 'Modulation (LSB)', 65, 'Portamento on/off', 97, 'Data Decrement', 2, 'Breath Control (MSB)', 34, 'Breath Control (LSB)', 66, 'Sostenuto Pedal', 98, 'non-reg param lsb', 67, 'Soft Pedal', 99, 'non-reg param msb', 4, 'Foot Control (MSB)', 36, 'Foot Control (LSB)', 68, 'Legato Pedal', 100, 'Reg Param (LSB)', 5, 'Portamento Time (MSB)', 37, 'Portamento Time (LSB)', 69, 'Hold 2', 101, 'Reg Param (MSB)', 6, 'Data Entry (MSB)', 38, 'Data Entry (LSB)', 70, 'Sound Variation', 7, 'Channel Volume (MSB)', 39, 'Channel Volume (LSB)', 71, 'Resonance, Q', 8, 'Balance (MSB)', 40, 'Balance (LSB)', 72, 'Release Time', 73, 'Attack Time', 10, 'Pan (MSB)', 42, 'Pan (LSB)', 74, 'Cut-off Frequency', 11, 'Expression (MSB)', 43, 'Expression (LSB)', 75, 'Decay Time', 12, 'Effects Controller 1', 76, 'Vibrato Rate', 13, 'Effects Controller 2', 77, 'Vibrato Depth', 78, 'Vibrato Delay', 84, 'Portamento Control', 120, 'All Sound Off', 121, 'Reset All Controllers', 122, 'Local Control', 91, 'Reverb Depth', 123, 'All Notes Off', 92, 'Tremolo Depth', 124, 'Omni Off', 93, 'Chorus Depth', 125, 'Omni On', 94, 'Celeste (De-tune)', 126, 'Mono On (Poly off)', 95, 'Phaser Depth', 127, 'Poly On (Mono off)', ); } return $c2s{$_[$[]} || ''; } sub debug { open (T, '>>', '/tmp/debug'); print T $_[$[],"\n"; close T; } sub add_new_fader { my ($c,$m,$v) = @_; if (! defined $v) { $v = 64; } $c = 0+$c; $m = 0+$m; $v = 0+$v; my $i = $[; while ($i <= $#Faders) { my ($this_c,$this_m,$this_v) = @{$Faders[$i]}; if ($this_c == $c and $this_m == $m) { # a duplicate; update $v $Faders[$i] = [$c,$m,$v]; $IFader = $i; output_fader($IFader); return 1; } elsif ($this_c > $c or ($this_c == $c and $this_m > $m)) { splice @Faders, $i, 0, [$c,$m,$v]; $IFader = $i; output_fader($IFader); return 1; } $i += 1; } push @Faders, [$c,$m,$v]; $IFader = $#Faders; output_fader($IFader); return 1; } sub display_faders { foreach my $irow (1..$LINES-4) { move($irow, 0); clrtoeol(); } # XXX foreach my $i ($[ .. $#Faders) { display_fader($i); } refresh(); } sub output_fader { my $i = $_[$[]; if ($i < $[ or $i > $#Faders) { die "output_fader: i=$i\n"; } my ($c,$m,$v) = @{$Faders[$i]}; my ($status,$time,$events ) = MIDI::ALSA::status(); MIDI::ALSA::output(MIDI::ALSA::controllerevent($c,$m,$v,$time)); MIDI::ALSA::syncoutput(); } sub display_fader { my $i = $_[$[]; if ($i < $[ or $i > $#Faders) { die "display_fader: i=$i\n"; } my $icol = 2 + $ColsPerFader * ($i-$[); my ($c,$m,$v) = @{$Faders[$i]}; move($LINES-6,$icol); addstr(substr " c=$c ",$[,6); move($LINES-5,$icol); addstr(substr " m=$m ",$[,6); move($LINES-4,$icol); addstr(substr " v=$v ",$[,6); my $top_of_fader = 0 + round(($LINES-7) * (128-$v) / 128); my $irow = 1; while ($irow < $top_of_fader) { move($irow, $icol); attrset(A_NORMAL()); addstr(q{ } x $ColsPerFader); $irow += 1; } while ($irow < ($LINES-6)) { move($irow, $icol+2); if ($i == $IFader) { attrset(A_REVERSE()); addstr(' '); attrset(A_NORMAL()); } else { # attrset(A_REVERSE()); attrset(COLOR_PAIR(2)); addstr('XX'); # addstr("\e[41m \e[0m"); # addstr escapes the escapes :-( # refresh(); print STDERR "\e[41m \e[0m\e[D\e[D"; leaves bg wrong # attrset(A_NORMAL()); attrset(COLOR_PAIR(1)); } $irow += 1; } if ($i == $IFader) { move(0,0); clrtoeol(); my $s1 = cc2str($m); my $x = $icol + 4 - round(0.5 * length($s1)); if ($x < 0) { $x = 0; } elsif ($x > $COLS) { $x = $COLS - length $s1; } display_clientstr(); move(0,$x); addstr("$s1 "); # cc-str overwrites client-str if conflict } if ($i == $#Faders) { foreach my $irow (1..$LINES-4) { move($irow, $icol+6); clrtoeol(); } } move($LINES-4, ($IFader-$[) * $ColsPerFader + 4); } sub display_clientstr { # 1.6 my $s2 = "client $ID, $AlsaName"; if (($icol+4) > 0.5*$COLS) { move(0,0); } else { move(0, $COLS-length($s2)-1); } addstr($s2); refresh(); } sub display_keystrokes { $TopKeystrokesLine = $LINES-4; if ($Message) { move($LINES-2,2); clrtoeol(); addl($LINES-2, round(0.4*($COLS - length $Message)) ,$Message); # move($LINES-3,2); clrtoeol(); $Message = ''; } else { addl($LINES-2,2, 'Left,Right,Tab=move between faders n=new D=Delete q=quit'); } addl($LINES-1,2, 'k/Up/j/Down=+-1, K/PageUp/J/PageDown=+-10, Home=127, End=0'); refresh(); } sub display_screen { move($LINES-3,1); hline($ACS_HLINE,$COLS-2); display_keystrokes(); display_faders(); refresh(); } sub display_message { my ($y,$x); getyx($y,$x); $Message = $_[$[]; display_keystrokes(); move($y,$x); refresh(); } sub new_fader_dialogue { # Could introduce value=A meaning Auto like panfarm # and then ask for min, max, period, perhaps sin/tri/sawup/sawdown addl($LINES-3,2,' Channel (0..15) ?'); addl($LINES-2,2,'MIDI-Controller (0..127) ?'); addl($LINES-1,2,' Value (0..127) ?'); refresh(); my @newfader = (); my $iline = 3; while ($iline > 0) { move($LINES-$iline,29); my $str; my $n; echo(); if ($iline == 3) { $n = getnstr($str,2); # 1.2 } else { $n = getnstr($str,3); } noecho(); if (length $str) { $newfader[$[+3-$iline] = 0 + $str; } # 2.0 length $iline -= 1; } return @newfader; } sub quit { move($LINES-2,2); clrtobot(); addl($LINES-2,round(0.4*($COLS-24)),"OK to quit (y/n) ? "); my $c = getch(); if ($c eq 'y') { exit 0; } display_keystrokes(); move($LINES-4, ($IFader-$[) * $ColsPerFader + 4); refresh(); } # ----------------------- infrastructure -------------------- sub round { my $x = $_[$[]; if ($x > 0.0) { return int ($x + 0.5); } if ($x < 0.0) { return int ($x - 0.5); } return 0; } sub deepcopy { use Storable; if (1 == @_ and ref($_[$[])) { return Storable::dclone($_[$[]); } else { my $b_ref = Storable::dclone(\@_); return @$b_ref; } } =pod =head1 NAME midifade - Provides faders generating midi-controller events =head1 SYNOPSIS midifade c13m71v120 c2m11v80 # 2 faders: cha2 cc11=80, cha13 cc71=120 midifade -o 128:0 # outputs to port 0 of client 128 midifade -o TiMidity # outputs to TiMidity midifade -N fad9 # sets AlsaClientName to 'fad9' midifade -v # prints the Version number perldoc midifade # read the manual :-) =head1 DESCRIPTION B is a Curses and ALSA application which provides on-screen faders, to control various midi-controllers on various midi-channels. It uses a simple user-interface: The Left and Right arrow keys move from one fader to the next, the Up and Down arrow keys adjust the value of the current fader by 1, the PageUp and PageDown keys adjust the value by 10, and the Home and End keys set it to maximum (127) or minimum (0). The faders are always displayed sorted by channel-number then by midi-controller-number. The available keystrokes are displayed in the bottom three lines of the screen. It uses the B CPAN module for the user-interface, and the B CPAN module to set up an ALSA client which can communicate with your synth. =head1 OPTIONS =over 3 =item I<-o 128:0> This example plays into the ALSA port 128:0. This option allows I to use the same port-specification as the other alsa-utils, e.g. I and I. For port 0 of a client, the ":0" part of the port specification can be omitted. The port specification is taken from the ALSA_OUTPUT_PORTS environment variable if none is given on the command line. Since Version 1.3, you may supply a comma-separated list of ports, e.g. B<-o 20,128:1> If the ALSA port is specified as B<0> then I will start up without connecting to anything. This allows you, for example, to use I (assumed here to be starting up as ALSA-client 129 ; check with I) to control I: midifade -o 0 c0m9v102 c1m9v105 c2m9v96 c3m9v64 ecasound -c -r -Md:alsaseq,midifade:0 \ -a:1 -i drums.wav -ea:200 -km:1,0,250,9,1 \ -a:2 -i synth-chords.wav -epp:30 -ea:120 -km:1,0,150,9,2 \ -a:3 -i bass-guitar_take-2.ewf -ea:75 -km:1,0,100,9,3 \ -a:4 -i brass-lead.wav -epp:70 -ea:50 -km:1,0,100,9,4 \ -a:1,2,3,4 -o loop,1 \ -a:5,6 -i loop,1 \ -a:5 -o alsa \ -a:6 -o current-mix.wav Here I chose midi-controller 9 because it isn't defined in General-MIDI, and therefore General-MIDI-labels, useless in this context, do not appear in the I screen. See I and I in the I documentation for details of the B<-ea> and B<-km> options. =item I<-N my_fade> Sets the Alsa-Client name, to I in this example. This is useful in scripts, to be able to connect from a specific I by a known name. The default Alsa-Client name is "I" =item I<-v> Prints version number. =back =head1 ARGUMENTS =over 3 =item I This example starts I up with a fader on channel 14 (0..15), midi-controller 74 (0..127), set initially to a value of 123 (0..127). ( In I, that would be expressed I ) Multiple arguments can be specified. The B and B and B bits must be in that order, all in one word with no spaces. The B bit is optional; its default value is 64. =back =head1 CHANGES 2.0, 20150809, a new fader with val=0 does not get given val=64 1.9, 20140907, -N my_name sets the AlsaClientName 1.8, 20130323, D can now delete the only fader 1.7, 20120831, -o "string" works 1.6, 20120820, display_clientstr called at start 1.5, 20111216, if -o 0 then midifade starts up but connects to nothing 1.4, 20111103, use the new MIDI-ALSA 1.11 to handle portnames 1.3, 20111028, OutputPort can be a comma-separated list 1.2, 20111027, add-new-fader dialogue allows 3-digit controller-nums 1.1, 20111023, much irrelevant code eliminated; q asks y/n first 1.0, 20111022, first working version =head1 AUTHOR Peter J Billam http://www.pjb.com.au/comp/contact.html =head1 CREDITS Based on the I and I CPAN modules. =head1 SEE ALSO aconnect -oil http://www.pjb.com.au/muscript/index.html#midi_in_a_stave http://www.pjb.com.au/muscript/gm.html#cc http://ecasound.sourceforge.net/ecasound/Documentation/examples.html http://search.cpan.org/perldoc?Curses http://search.cpan.org/perldoc?MIDI::ALSA http://www.pjb.com.au/midi =cut