Win32API::MIDI::SysEX::Roland - Perl Module for Roland MIDI System Exclusive Message.

  use Win32API::MIDI::SysEX::Roland;
  # SC-55mkII GS Sound Module
  $se = new Win32API::MIDI::SysEX::Roland(mdlName => 'GS'); # 'GS' can be omitted
  # GS Reset
  $d = $se->GSReset;
  # Turn General MIDI System Off
  $d = $se->turnGeneralMIDISystemOff;
  # Turn General MIDI System On
  $d = $se->turnGeneralMIDISystemOn;
  # Set Master Volume
  $d = $se->masterVolume(0xD20);
  # example 2 (manual P.104): Request the level for a drum note.
  $d = $se->RQ1(0x41024b, 0x01);
  # bulk dump: system parameter and all patch parameter
  $d = $se->RQ1(0x480000, 0x1D10);
  # bulk dump: system parameter
  $d = $se->RQ1(0x480000, 0x10);
  # bulk dump: common patch parameter
  $d = $se->RQ1(0x480010, 0x100);
  # bulk dump: drum map1 all
  $d = $se->RQ1(0x490000, 0xe18);

#!/usr/local/bin/perl
#
#	Roland.pm : Roland MIDI System Exculsive support functions
#
#	Copyright (c) 2003 Hiroo Hayashi.  All rights reserved.
#
#	This program is free software; you can redistribute it and/or
#	modify it under the same terms as Perl itself.

# GS document (in Japanese)
#   http://www.b-sharp.com/midi/spec1/pdf/2-5.pdf

package Win32API::MIDI::SysEX::Roland;
my $ver = '$Id: Roland.pm,v 1.3 2003-04-13 22:54:26-05 hiroo Exp $';

use Carp;
use strict;

#BEGIN { $Exporter::Verbose=1 }
use vars qw($VERSION @ISA);
$VERSION = $ver =~ m/\s+(\d+\.\d+)\s+/;
@ISA = qw(Win32API::MIDI::SysEX);
use Win32API::MIDI::SysEX qw(SOX EOX);

# The following data is gathered by WWW searching.
# Report to author if you know about other models.
my %fmt = (#		     model ID	2byteID	address size
	   'S-10'	=> [ 0x10,	1,	3 ],
	   'GS'		=> [ 0x42,	1,	3 ],
	   'SC-88'	=> [ 0x42,	1,	3 ],
	   'SC-55'	=> [ 0x45,	1,	3 ],
	   'SC-155'	=> [ 0x45,	1,	3 ],
	   'JV-1010'	=> [ 0x6a,	1,	4 ],
	   'VS-880'	=> [ 0x7c,	1,	3 ],
	   'GR-30'	=> [ 0x0007,	2,	4 ],
	   'TD-6'	=> [ 0x003f,	2,	4 ],
	  );

sub default_deviceID {
    17;				# my all of my 3 Roland devices use 17.
}

sub default_manufacturersID {
    0x41;			# Roland
}

sub default_modelName {
    'GS';
}

sub new_hook {
    my ($self, %params) = @_;
    # Roland Specific
    $self->{mdlID} = $fmt{$self->{mdlName}}->[0] unless defined $self->{mdlID};
    # byte size of model ID
    $self->{idSize} = $fmt{$self->{mdlName}}->[1];
    # byte size of adderss/data for RQ1/DT1 message
    $self->{adSize} = $fmt{$self->{mdlName}}->[2];
}

########################################################################

sub RQ1 {
    my ($self, $addr, $size) = @_;
    my @mdlID = ($self->{idSize} == 1 ? ($self->{mdlID} & 0x7f)
		 : $self->unpack2_8($self->{mdlID}));
    my @addr  = ($self->{adSize} == 3
		 ? $self->unpack3_8($addr) : $self->unpack4_8($addr));
    my @size  = ($self->{adSize} == 3
		 ? $self->unpack3_8($size) : $self->unpack4_8($size));

    pack('C*', SOX, $self->mID2array(),
	 $self->{devID} - 1,
	 @mdlID,
	 0x11,			# command ID: RQ1
	 @addr,
	 @size,
	 $self->checkSum(@addr, @size),
	 EOX);
}

sub DT1 {
    my ($self, $addr, $data) = @_;
    my $dev   = $self->{devID} - 1;
    my @mdlID = ($self->{idSize} == 1
		 ? ($self->{mdlID} & 0x7f) : $self->unpack2_8($self->{mdlID}));
    my @addr  = ($self->{adSize} == 3
		 ? $self->unpack3_8($addr) : $self->unpack4_8($addr));

    pack('C*', SOX, $self->mID2array(),
	 $self->{devID} - 1,
	 @mdlID,
	 0x12,			# command ID: DT1
	 @addr)
	. $data
	    . pack('C*', $self->checkSum(@addr, unpack('C*', $data)), EOX);
}

sub GSReset {
    my $self = shift;
    # The model ID 0x42 (GS) is required.
    my $save_mdlID = $self->{mdlID};
    $self->{mdlID} = 0x42;	# GS
    my $d = $self->DT1(0x40007f, "\x00"); # GS reset
    $self->{mdlID} = $save_mdlID;
    $d;
}

sub ExitGSMode {
    my $self = shift;
    # The model ID 0x42 (GS) is required.
    my $save_mdlID = $self->{mdlID};
    $self->{mdlID} = 0x42;	# GS
    my $d = $self->DT1(0x40007f, "\x7f"); # exit GS mode
    $self->{mdlID} = $save_mdlID;
    $d;
}

sub SystemModeSet {
    my ($self, $mode) = @_;
    # The model ID 0x42 (GS) is required.
    my $save_mdlID = $self->{mdlID};
    $self->{mdlID} = 0x42;	# GS
    my $d = $self->DT1(0x00007f, $mode);
    $self->{mdlID} = $save_mdlID;
    $d;
}

1;