sysex.pl

use autodie;
use strict;
use Data::Dump 'dump';

use autodie;
open my $fh, '<:raw', 'dreamy-r8.syx';

my @data=();
my @asounds,my @acopy, my @arom,my @aperf,my @afeel,my @aassign,my @aoutput,my @amidi,my @asystem;
my $area = -1;
while (read($fh,my $bytes,1) == 1) {
    my ($byte) = unpack('C',$bytes);
    if ($byte == 0xf0) {
        die "read header" unless read($fh,my $h,4) == 4;
        my ($a,$b,$c,$d) = unpack 'CCCC',$h;
        #printf "header %X %X %X %X \n",$a,$b,$c,$d;
        die "bad header" unless ($a == 0x41 && $c == 0x28 && $d == 0x12);
        die "read addy" unless read($fh,$h,4) == 4;
        ($a,$b,$c,$d) = unpack 'CCCC',$h;
        # printf "addy %X %X %X %X \n",$a,$b,$c,$d;
        if ($b != $area) {
            # printf "new area: $b \n";
            if ($area == 0) {
                @asounds = @data;
            } elsif ($area == 1) {
                @acopy = @data;
            } elsif ($area == 2) {
                @arom = @data;
            } elsif ($area == 3) {
                @aperf = @data;
            } elsif ($area == 4) {
                @afeel = @data;
            } elsif ($area == 5) {
                @aassign = @data;
            } elsif ($area == 6) {
                @aoutput = @data;
            } elsif ($area == 7) {
                @amidi = @data;
            } elsif ($area == 8) {
                @asystem = @data;
            }
            $area = $b;
            @data = ();
        }
    } elsif ($byte == 0xf7) {
        pop @data;
        # printf "eof\n";
    } else {
        push(@data,($byte));
    }
}
@asystem = @data;

my @insts=split(/\n/,"DRY_K1
DRY_K2
WOOD_K1
DBLH_K1
DBLH_K2
SOLID_K
ROOM_K1
ROOM_K2
MONDO_K
WOOD_S1
OPEN_S1
TIGHT_S
NICE_S1
FAT_S1
IMPCT_S
SNAP_S1
OUCH_S
RVB_S1
PICL_S1
RIMSHT1
RIMSHT2
SIDSTK1
SIDSTK2
DRY_T1
DRY_T2
DRY_T3
DRY_T4
ROOM_T1
ROOM_T2
ROOM_T3
ROOM_T4
POWR_T1
POWR_T2
POWR_T3
POWR_T4
DOOM_T1
CLSD_H1
OPEN_H1
PDAL_H1
CRSH_C1
MLLT_C1
RIDE_C1
RDBL_C1
BELL_C1
808CLAP
OPEN_D1
TAIKO1
CLAVE1
CABASA1
COWBEL1
TAMBRN1
SHAKER1
MUTE_CG
SLAP_CG
LOW_CG
SLID_CG
AGOGO1
OCT_AGG
WHISTL1
WHISTL2
CAN1
BACK_S1
BACK_T1
BACK_C1
SPARK1
SURF
WHEEL1
REST");

my @snr804=split(/\n/,
"ELEC_K
CTRL_K
FLANG_K
808_K
ELEC_S
RVB_S2
FLANG_S
808_S
808SIDE
BEND_T
ELEC_T
808_T
808CHH
808OHH
EL_CRSH
808RIDE
EL_BELL
808CNG
808MARC
808CLAV
808COW
SLAP2
HIGH_Q
RAPNOIS
WOODBOX
SY_BASS");


my @outs = ("L3","L2","L1","CTR","R1","R2","R3","M1","M2","M3","M4","M5","M6","M7","M8");
my @banks = ("A","B","C","D","E");
my %pads = {};
my @passigns = splice @aassign,0,0x50;
my $p = 0;
foreach (@passigns) {
    my $pad = ($p % 16) + 1;
    my $bank = int($p / 16);
    $pads{$_} = sprintf "%s:%d",$banks[$bank],$pad;
    $p++;
}
my @copys=splice @acopy,0x1A,0x150;
while (@copys) {
    my @namebs=splice @copys,0,7;
    my $name=sprintf "%s*",pack('C*',@namebs);
    push @insts,($name);
}

push @insts,@snr804;

my @massigns = splice @amidi,0x7C,0x140;

my @keys=split(/,/,"C,C#,D,Eb,E,F,F#,G,Ab,A,Bb,B");

my $i = 0;
while (@asounds) {
    my @bytes = splice @asounds,0,10;
    my $note = $massigns[$i*2];
    my $on = $massigns[($i*2)+1];
    my $key = $on ? sprintf "%s%d",$keys[$note % 12],int($note/12) : "";
    my $id = $i < 68 ? sprintf("I%0d",$i+1) :
        ($i < 94 ? sprintf("C%0d",$i-67) : sprintf("E%0d",$i-93));

    printf "%-10s %3s output: %3s  note: %3s  pad: %s\n", $insts[$i], $id, $outs[$bytes[7]], $key,$pads{$i};
    $i++;
}
close $fh;