/lib/Audio/Nama/Midi.pm

https://github.com/gitpan/Audio-Nama · Perl · 87 lines · 59 code · 9 blank · 19 comment · 5 complexity · bcb7ce5f51d3488446585dab17e32b7f MD5 · raw file

  1. # ------------- MIDI routines -----------
  2. package Audio::Nama;
  3. use Modern::Perl;
  4. use Carp;
  5. {
  6. my($error,$answer)=('','');
  7. my ($pid, $sel);
  8. my @handles = my ($fh_midish_write, $fh_midish_read, $fh_midish_error) = map{ IO::Handle->new() } 1..3;
  9. map{ $_->autoflush(1) } @handles;
  10. sub start_midish {
  11. my $executable = qx(which midish);
  12. chomp $executable;
  13. $executable or say("Midish not found!"), return;
  14. $pid = open3($fh_midish_write, $fh_midish_read, $fh_midish_error,"$executable -v")
  15. or warn "Midish failed to start!";
  16. $sel = IO::Select->new();
  17. $sel->add($fh_midish_read);
  18. $sel->add($fh_midish_error);
  19. midish_command( qq(print "Midish is ready.") );
  20. }
  21. sub start_midish_transport {
  22. my $sync = $mode->{midish_transport_sync};
  23. my $start_command;
  24. $start_command = 'p' if $sync eq 'play';
  25. $start_command = 'r' if $sync eq 'record';
  26. defined $start_command
  27. or die "$mode->{midish_transport_sync}: illegal midish_transport_sync mode";
  28. midish_command($start_command);
  29. }
  30. sub stop_midish_transport { midish_command('s') }
  31. sub midish_command {
  32. my $query = shift;
  33. print "\n";
  34. #$config->{use_midish} or say( qq($query: cannot execute Midish command
  35. #unless you set "midish_enable: 1" in .namarc)), return;
  36. #$query eq 'exit' and say("Will exit Midish on closing Nama."), return;
  37. #send query to midish
  38. print $fh_midish_write "$query\n";
  39. my $length = 2**16;
  40. sleeper(0.05);
  41. foreach my $h ($sel->can_read)
  42. {
  43. my $buf = '';
  44. if ($h eq $fh_midish_error)
  45. {
  46. sysread($fh_midish_error,$buf,$length);
  47. if($buf){print "MIDISH ERR-> $buf\n"}
  48. }
  49. else
  50. {
  51. sysread($fh_midish_read,$buf,$length);
  52. if($buf){map{say} grep{ !/\+ready/ } split "\n", $buf}
  53. }
  54. }
  55. print "\n";
  56. }
  57. sub close_midish {
  58. my $save_file = join_path(project_dir(), "$project->{name}.msh");
  59. say "saving midish as $save_file";
  60. midish_command("save $save_file");
  61. #my $fh;
  62. #$_->close for $fh_midish_read, $fh_midish_write, $fh_midish_error;
  63. #sleeper(0.2);
  64. #say "exiting midish";
  65. #midish_command("exit"); # isn't necessary, triggers a warning
  66. #$_->flush for @handles; # doesn't help warning
  67. # sleeper(0.1);
  68. # kill 15,$pid;
  69. # sleeper(0.1);
  70. # kill 9,$pid;
  71. # sleeper(0.1);
  72. # waitpid($pid, 1);
  73. # It is important to waitpid on your child process,
  74. # otherwise zombies could be created.
  75. }
  76. }
  77. 1;
  78. __END__