Win32API::MIDI::SysEX::MIDIbox - Perl Module for MIDIbox System

  use Win32API::MIDI::SysEX::MIDIbox;
  # by default 'MIDIbox16E'
  $se = new Win32API::MIDI::SysEX::MIDIbox(modelName => 'MIDIbox64');

#!/usr/local/bin/perl
#
#	MIDIbox.pm : MIDIbox 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.
#
#	$Id: MIDIbox.pm,v 1.2 2003-04-13 22:54:26-05 hiroo Exp $

# http://www.uCApps.de/
# Free MIDI DIY Projects by Thorsten Klose

package Win32API::MIDI::SysEX::MIDIbox;
my $ver = '$Id: MIDIbox.pm,v 1.2 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	writeDump data size
	   'MIDIbox Plus'	=> [0x2,	1024],
	   'MIDIbox64'		=> [0x3,	4096],
	   'MIDIIO128'		=> [0x4,	4096], # ?
	   'MIDIbox16E'		=> [0x5,	4096],
	  );

sub default_deviceID {
    5;
}

sub default_manufacturersID {
    #0x7e0000;			# Otari???
    0x7D,			# non-commercial use
}

sub default_modelName {
    'MIDIbox16E';		# TBD
}

sub new_hook {
    my $self = shift;
    $self->{mdlID}  = $fmt{$self->{mdlName}}->[0] unless defined $self->{mdlID};
    # manufacturers ID for 'Otari' was used accidentally on old machines.
    $self->{mID} = 0x7e0000
	if ($self->{mdlName} eq 'MIDIbox Plus'
	    || $self->{mdlName} eq 'MIDIbox64'
	    || $self->{mdlName} eq 'MIDIIO128'
	    || $self->{mdlName} eq 'MIDIbox16E');

    # data size for writeDump()
    $self->{_WDSize} = $fmt{$self->{mdlName}}->[1];
}

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

#    F0 00 00 7E 45 01 F7                - Read Request
sub  readRequest {
    my $self = shift;

    pack('C*', SOX, $self->mID2array(),
	 ((($self->{devID} - 1) & 7) << 4) | $self->{mdlID} & 0xf,
	 0x01,
	 EOX);
}

#    F0 00 00 7E 45 02 ..dump.. F7       - Write Dump
sub  writeDump {
    my ($self, $data) = @_;

    my $size = $self->{_WDSize};
    pack('C*', SOX, $self->mID2array(),
	 ((($self->{devID} - 1) & 7) << 4) | $self->{mdlID} & 0xf,
	 0x02)
	. pack("a${size}C1", $data, EOX);
}

#    F0 00 00 7E 45 04 AH AL ..dump.. F7 - Write Partial Dump

sub  writePartialDump {
    my ($self, $address, $data) = @_;

    pack('C*', SOX, $self->mID2array(),
	 ((($self->{devID} - 1) & 7) << 4) | $self->{mdlID} & 0xf,
	 0x04,
	 ($address >> 8) & 0x7f,
	 ($address >> 1) & 0x7f,
	 ($data >> 8) & 0x7f,
	 ($data >> 1) & 0x7f,
	 EOX);
}

#    F0 00 00 7E 45 08 0n F7             - Request Bank
sub  requestBank {
    my ($self, $m, $n) = @_;

    pack('C*', SOX, $self->mID2array(),
	 ((($self->{devID} - 1) & 7) << 4) | $self->{mdlID} & 0xf,
	 0x08,
	 (($m & 7) << 4) | $n & 0xf,
	 EOX);
}

#    F0 00 00 7E 45 0F F7                - Acknowledge/Ping
sub acknowledgePing {
    my $self = shift;

    pack('C*', SOX, $self->mID2array(),
	 ((($self->{devID} - 1) & 7) << 4) | $self->{mdlID} & 0xf,
	 0x0f,
	 EOX);
}

#    F0 00 00 7E 40 <device-id> 02 <AH> <AL> <CH> <CL> <dump> <checksum> F7
#
#    <AH>/<AL>: address calculated with following formula:
#       AH = (address >> 10) & 0x7f
#       AL = (address >> 3)  & 0x7f
#       address = (AH << 10) | (AL << 3)
#       if address <  0x8000: program memory
#       if address >= 0x8000: data EEPROM
#
#    <CH>/<CL>: byte counter * 8
#       CH = (counter >> 10) & 0x7f
#       CL = (counter >> 3) & 0x7f
#       counter = (CH << 10) | (CL << 3)
#
#    <dump>: the data which has to be written, scrambled to a sequence
#    of 7-bit values
#
#    <checksum>: the checksum, from <AH> to last byte of the dump
#                -(sum of bytes) & 0x7f
sub dumpProgramData {
    my ($self, $address, $data8) = @_;
    # MIDI spec recommends max data size should be 128 bytes.
    # 112 = 128 * 7/8 : MAX data length
    #$data8 = substr($data8, 0, 112);
    # 8 bit -> 7 bit encoding
    my $data7 = $self->fileDumpEncode8to7($data8);
    my $len = length $data7;
    my $checksum = $self->checkSum_XOR(($address >> 10) & 0x7f,
				       ($address >> 3) & 0x7f,
				       ($len >> 10) & 0x7f,
				       ($len >> 3) & 0x7f,
				       unpack('C*', $data7));

    pack('C*', SOX, $self->mID2array(),
	 ($self->{mdlID} << 4) & 0x7f,
	 ($self->{devID} - 1) & 0x7f,
	 0x02,
	 ($address >> 10) & 0x7f,
	 ($address >> 3) & 0x7f,
	 ($len >> 10) & 0x7f,
	 ($len >> 3) & 0x7f)
	. pack("a${len}C2", $data7, $checksum, EOX);
}

1;