line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#! perl |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
package Data::BiaB; |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
Data::BiaB - Analyze Band-in-a-Box data files |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=cut |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '0.10'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 SYNOPSIS |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
This module provides methods to read Band-in-a-Box data files and |
16
|
|
|
|
|
|
|
extract some useful information from them. |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
Band-in-a-Box is an excellent tool for creating professional music and |
19
|
|
|
|
|
|
|
accompanying tracks. I've been using it for many years but had to |
20
|
|
|
|
|
|
|
abandon it when I phased out Microsoft Windows PCs. |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Example: |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
use Data::BiaB; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# Load an existing song. |
27
|
|
|
|
|
|
|
my $biab = Data::BiaB->new(); |
28
|
|
|
|
|
|
|
$biab->load("Vaya_Con_Dios.mgu"); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# This will show what was gathered. |
31
|
|
|
|
|
|
|
use Data::Dumper; |
32
|
|
|
|
|
|
|
print Dumper($biab); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 NOTE |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
Many BiaB files fail loading and parsing. If you have a recent version |
37
|
|
|
|
|
|
|
of Band-in-a-Box its MusicXML export feature will be a much better |
38
|
|
|
|
|
|
|
alternative. |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
This is a hobby project. It is pre-alpha, under development, works for |
41
|
|
|
|
|
|
|
me, caveat emptor and so on. Have fun! |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=cut |
44
|
|
|
|
|
|
|
|
45
|
1
|
|
|
1
|
|
26818
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
28
|
|
46
|
1
|
|
|
1
|
|
3
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
18
|
|
47
|
1
|
|
|
1
|
|
2
|
use Carp qw( carp croak ); |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
36
|
|
48
|
1
|
|
|
1
|
|
522
|
use Data::Dumper; |
|
1
|
|
|
|
|
4112
|
|
|
1
|
|
|
|
|
44
|
|
49
|
1
|
|
|
1
|
|
4
|
use Data::Hexify; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
1344
|
|
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
$Data::Dumper::Indent = 1; |
52
|
|
|
|
|
|
|
$Data::Dumper::Sortkeys = 1; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub new { |
55
|
0
|
|
|
0
|
0
|
|
my ( $pkg, %opts ) = @_; |
56
|
0
|
|
|
|
|
|
bless { %opts }, $pkg; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub load { |
60
|
0
|
|
|
0
|
0
|
|
my ( $self, $file ) = @_; |
61
|
0
|
|
|
|
|
|
$self->{_file} = $file; |
62
|
0
|
|
|
|
|
|
$self->{_size} = -s $file; |
63
|
0
|
0
|
|
|
|
|
open( my $fh, '<:raw', $file ) |
64
|
|
|
|
|
|
|
or croak("$file: $!"); |
65
|
0
|
|
|
|
|
|
$self->{_raw} = do { local $/; <$fh> }; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
66
|
0
|
|
|
|
|
|
close($fh); |
67
|
|
|
|
|
|
|
|
68
|
0
|
|
|
|
|
|
$self; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub parse { |
72
|
0
|
|
|
0
|
0
|
|
my ( $self ) = @_; |
73
|
|
|
|
|
|
|
|
74
|
0
|
|
|
|
|
|
my $data = $self->{_raw}; |
75
|
0
|
|
|
|
|
|
my $inx = 0; |
76
|
0
|
|
|
|
|
|
my $i; |
77
|
|
|
|
|
|
|
my $val; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
my $dd1 = sub { |
80
|
|
|
|
|
|
|
warn(Hexify( $data, { start => $_[0], length => $_[1] } )) |
81
|
0
|
0
|
|
0
|
|
|
if $self->{debug} >= 1; |
82
|
0
|
|
|
|
|
|
}; |
83
|
|
|
|
|
|
|
my $dd2 = sub { |
84
|
|
|
|
|
|
|
warn(Hexify( $data, { start => $_[0], length => $_[1] } )) |
85
|
0
|
0
|
|
0
|
|
|
if $self->{debug} >= 2; |
86
|
0
|
|
|
|
|
|
}; |
87
|
0
|
|
|
0
|
|
|
my $gb = sub { unpack( "C", substr($data, $inx++, 1) ) }; |
|
0
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
# Skip 1. |
90
|
0
|
|
|
|
|
|
$dd1->( $inx, 1 ); |
91
|
0
|
|
|
|
|
|
$inx++; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# Ttitle. |
94
|
0
|
|
|
|
|
|
$val = $gb->(); |
95
|
0
|
0
|
|
|
|
|
warn("Title length = $val\n") if $self->{debug} > 2; |
96
|
0
|
|
|
|
|
|
$dd2->( $inx-1, 1+$val ); |
97
|
0
|
|
|
|
|
|
$self->{title} = substr($data, $inx, $val ); |
98
|
0
|
|
|
|
|
|
warn("Title = $self->{title}\n"); |
99
|
0
|
|
|
|
|
|
$inx += $val; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
# Skip 2. |
102
|
0
|
|
|
|
|
|
$dd1->( $inx, 2 ); |
103
|
0
|
|
|
|
|
|
$inx += 2; |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# Style/Key/BPM. |
106
|
0
|
|
|
|
|
|
$dd2->( $inx, 3 ); |
107
|
0
|
|
|
|
|
|
$self->{basic_style} = $gb->(); |
108
|
0
|
|
|
|
|
|
$self->{key_nr} = $gb->(); |
109
|
0
|
|
|
|
|
|
$self->{bpm} = $gb->(); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# Styles; |
112
|
0
|
|
|
|
|
|
$i = 0; |
113
|
0
|
|
|
|
|
|
my $tally = 0; |
114
|
0
|
|
|
|
|
|
my $first = 0; |
115
|
0
|
|
|
|
|
|
$self->{stylemap} = {}; |
116
|
0
|
|
|
|
|
|
while ( $i < 256 ) { |
117
|
0
|
|
|
|
|
|
$val = $gb->(); |
118
|
0
|
0
|
|
|
|
|
if ( $val ) { |
119
|
0
|
|
|
|
|
|
$dd2->( $inx-1, 1 ); |
120
|
0
|
|
|
|
|
|
$self->{stylemap}->{$i-1} = $val; |
121
|
0
|
0
|
|
|
|
|
warn("Style: $val @ $i\n") if $self->{debug} > 2; |
122
|
0
|
|
|
|
|
|
$tally++; |
123
|
0
|
|
|
|
|
|
$i++; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
else { |
126
|
0
|
|
|
|
|
|
$dd2->( $inx-1, 2 ); |
127
|
0
|
|
|
|
|
|
$val = $gb->(); |
128
|
0
|
0
|
|
|
|
|
croak("Format error (zero offset) in styles") unless $val; |
129
|
0
|
|
|
|
|
|
$i += $val; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
} |
132
|
0
|
0
|
|
|
|
|
if ( $i > 256 ) { |
133
|
0
|
|
|
|
|
|
croak("Format error (offset $i mismatch) in styles"); |
134
|
|
|
|
|
|
|
} |
135
|
0
|
|
|
|
|
|
warn("Read: $tally styles\n"); |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# Chord types. |
138
|
0
|
|
|
|
|
|
$i = 1; |
139
|
0
|
|
|
|
|
|
$self->{ctypes} = []; |
140
|
0
|
|
|
|
|
|
$tally = 0; |
141
|
|
|
|
|
|
|
# 1021 = 4 * 255 + 1 |
142
|
|
|
|
|
|
|
# 255 measures of 4 chords. |
143
|
0
|
|
|
|
|
|
while ( $i < 1021 ) { |
144
|
0
|
|
|
|
|
|
$val = $gb->(); |
145
|
0
|
0
|
|
|
|
|
if ( $val ) { |
146
|
0
|
|
|
|
|
|
$dd2->( $inx-1, 1 ); |
147
|
0
|
|
|
|
|
|
$self->{ctypes}->[$i-1] = $val; |
148
|
0
|
|
0
|
|
|
|
$first //= $i-1; |
149
|
0
|
0
|
|
|
|
|
warn("Ctype: [", $inx-1, "] $val @ $i\n") if $self->{debug} > 1; |
150
|
0
|
|
|
|
|
|
$tally++; |
151
|
0
|
|
|
|
|
|
$i++; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
else { |
154
|
0
|
|
|
|
|
|
$dd2->( $inx-1, 2 ); |
155
|
0
|
|
|
|
|
|
$val = $gb->(); |
156
|
0
|
0
|
|
|
|
|
croak("Format error (zero offset) in ctypes") unless $val; |
157
|
0
|
|
|
|
|
|
$i += $val; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
# The sequence ends with 00 ff 00 ff 00 nn to sum up to 1021. |
161
|
0
|
0
|
|
|
|
|
if ( $i > 1021 ) { |
162
|
0
|
|
|
|
|
|
croak("Format error (offset $i mismatch) in ctypes"); |
163
|
|
|
|
|
|
|
} |
164
|
0
|
|
|
|
|
|
$first++; |
165
|
0
|
|
|
|
|
|
warn("Read: $tally ctypes, first @ $first, last @ ", scalar(@{$self->{ctypes}}), "\n"); |
|
0
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
# Chord names. |
168
|
0
|
|
|
|
|
|
$i = 1; |
169
|
0
|
|
|
|
|
|
$self->{cnames} = []; |
170
|
0
|
|
|
|
|
|
$tally = 0; |
171
|
0
|
|
|
|
|
|
$first = undef; |
172
|
0
|
|
|
|
|
|
while ( $i < 1022 ) { |
173
|
0
|
|
|
|
|
|
$val = $gb->(); |
174
|
0
|
0
|
|
|
|
|
if ( $val ) { |
175
|
0
|
|
|
|
|
|
$dd2->( $inx-1, 1 ); |
176
|
0
|
|
|
|
|
|
$self->{cnames}->[$i-1] = $val; |
177
|
0
|
|
0
|
|
|
|
$first //= $i-1; |
178
|
0
|
0
|
|
|
|
|
warn("Cname: [", $inx-1, "] $val @ $i\n") if $self->{debug} > 1; |
179
|
0
|
|
|
|
|
|
$tally++; |
180
|
0
|
|
|
|
|
|
$i++; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
else { |
183
|
0
|
|
|
|
|
|
$dd2->( $inx-1, 2 ); |
184
|
0
|
|
|
|
|
|
$val = $gb->(); |
185
|
0
|
0
|
|
|
|
|
croak("Format error (zero offset) in cnames") unless $val; |
186
|
0
|
|
|
|
|
|
$i += $val; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
# The sequence ends with 00 ff 00 ff 00 nn to sum up to 1022. |
190
|
|
|
|
|
|
|
# Yes, really...??? |
191
|
0
|
0
|
|
|
|
|
if ( $i > 1022 ) { |
192
|
0
|
|
|
|
|
|
croak("Format error (offset $i mismatch) in cnames"); |
193
|
|
|
|
|
|
|
} |
194
|
0
|
|
|
|
|
|
$first++; |
195
|
0
|
|
|
|
|
|
warn("Read: $tally cnames, first @ $first, last @ ", scalar(@{$self->{cnames}}), "\n"); |
|
0
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
|
197
|
0
|
|
|
|
|
|
$dd2->( $inx, 3 ); |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# A song consists of lead-in (bar 0), intro, chorus, and coda. |
200
|
|
|
|
|
|
|
# The chorus is repeated a number of times. |
201
|
0
|
|
|
|
|
|
$self->{start_chorus_bar} = $gb->(); # chorus start |
202
|
0
|
|
|
|
|
|
$self->{end_chorus_bar} = $gb->(); # chorus ends |
203
|
0
|
|
|
|
|
|
$self->{number_of_repeats} = $gb->(); |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
#$dd1->($inx, 1024); |
206
|
|
|
|
|
|
|
|
207
|
0
|
0
|
|
|
|
|
if ( substr($data, $inx, $inx+2560) |
208
|
|
|
|
|
|
|
=~ /^(.*?\x{42})((?:\x{5}.|\x{6}..|\x{7}...|\x{8}....|\x{9}.....|\x{a}......|\x{b}.......|\x{c}........)\.STY)/ ) { |
209
|
0
|
|
|
|
|
|
$val = substr($2,1); |
210
|
0
|
|
|
|
|
|
$self->{stylefile} = $val; |
211
|
0
|
|
|
|
|
|
warn("Style $val @ ", $inx+length($1), " ($inx+", length($1), ")\n"); |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
# Although the length is flexible, it seems to be filled to the max |
214
|
|
|
|
|
|
|
# with garbage (or a default XXXXXXXX.STY). |
215
|
0
|
|
|
|
|
|
$inx += length($1); |
216
|
0
|
|
|
|
|
|
$inx += 13; |
217
|
|
|
|
|
|
|
|
218
|
0
|
0
|
|
|
|
|
if ( substr($data, $inx, $inx+256) =~ /^(.*?)\x{00}\x{ff}\x{00}\x{0d}(..)/ ) { |
219
|
0
|
|
|
|
|
|
$val = unpack("v", $2); |
220
|
0
|
|
|
|
|
|
warn("NumNotes $val @ ", $inx+length($1), " ($inx+", length($1), ")\n"); |
221
|
0
|
|
|
|
|
|
$self->{numnotes} = $val; |
222
|
0
|
|
|
|
|
|
$inx += length($1) + 6; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
0
|
|
|
|
|
|
my ( $onset, $chan, $pitch, $velo, $dur, $unk ); |
226
|
0
|
|
|
|
|
|
my @m; |
227
|
|
|
|
|
|
|
RETRY: |
228
|
0
|
0
|
|
|
|
|
warn("Search for melody from $inx...\n") if $self->{debug}; |
229
|
0
|
0
|
|
|
|
|
if ( substr($data, $inx) =~ /^(.*?)\x{a0}\x{b0}(\x{c0}|\x{c1})/s ) { |
230
|
0
|
|
|
|
|
|
$inx += 3 + length($1); |
231
|
|
|
|
|
|
|
warn( sprintf("melody %02x @ %d, %d notes\n", |
232
|
0
|
|
|
|
|
|
ord($2), $inx, $self->{numnotes}) ); |
233
|
0
|
|
|
|
|
|
while ( $inx < length($data)-12 ) { |
234
|
0
|
|
|
|
|
|
$dd2->($inx,12); |
235
|
0
|
|
|
|
|
|
( $onset, $unk, $pitch, $velo, $chan, $dur ) = |
236
|
|
|
|
|
|
|
unpack("VCCCCV", substr($data, $inx, 12)); |
237
|
|
|
|
|
|
|
|
238
|
0
|
0
|
0
|
|
|
|
if ( @m == 0 |
|
|
|
0
|
|
|
|
|
239
|
|
|
|
|
|
|
&& ( $pitch > 100 || $velo > 127 || $chan > 15 |
240
|
|
|
|
|
|
|
|| $dur > 7200 || $onset > 7200 ) ) { |
241
|
0
|
|
|
|
|
|
$dd1->($inx,12); |
242
|
0
|
|
|
|
|
|
warn("insane values in melody -- retrying...\n"); |
243
|
0
|
|
|
|
|
|
goto RETRY; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
# $pitch = pitchname($pitch); |
246
|
0
|
|
|
|
|
|
push( @m, [ $onset, $chan, $pitch, $velo, $unk, $dur ] ); |
247
|
0
|
|
|
|
|
|
$inx += 12; |
248
|
0
|
0
|
|
|
|
|
if ( @m == $self->{numnotes} - 1) { |
249
|
0
|
|
|
|
|
|
last; |
250
|
|
|
|
|
|
|
} |
251
|
0
|
0
|
|
|
|
|
if ( $inx >= length($data)-12 ) { |
252
|
0
|
|
|
|
|
|
warn("Oops"); |
253
|
0
|
|
|
|
|
|
last; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
else { |
258
|
0
|
|
|
|
|
|
warn("No melody found\n"); |
259
|
|
|
|
|
|
|
} |
260
|
0
|
0
|
|
|
|
|
if ( @m != $self->{numnotes} ) { |
261
|
|
|
|
|
|
|
warn("Missing or incomplete melody (", |
262
|
|
|
|
|
|
|
scalar(@m), " notes, should have been ", |
263
|
0
|
|
|
|
|
|
$self->{numnotes}, ")\n"); |
264
|
|
|
|
|
|
|
} |
265
|
0
|
|
|
|
|
|
$self->{melody} = \@m; |
266
|
|
|
|
|
|
|
|
267
|
0
|
0
|
|
|
|
|
if ( $inx < length($data) ) { |
268
|
0
|
|
|
|
|
|
$dd1->( $inx, length($data) - $inx ); |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
0
|
|
|
|
|
|
$self; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
sub pitchname { |
275
|
0
|
|
|
0
|
0
|
|
my ( $p ) = @_; |
276
|
0
|
|
|
|
|
|
my $n = [ "C", "C#", "D", "D#", "E", "F", "F#", |
277
|
|
|
|
|
|
|
"G", "G#", "A", "A#", "B" ]->[$p % 12]; |
278
|
|
|
|
|
|
|
# BiaB pitch is 1 octave low. |
279
|
0
|
|
|
|
|
|
$n . int($p/12); |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
my %ctypes = |
283
|
|
|
|
|
|
|
( "0" => "", |
284
|
|
|
|
|
|
|
"1" => "", |
285
|
|
|
|
|
|
|
"2" => "maj", |
286
|
|
|
|
|
|
|
"3" => "5b", |
287
|
|
|
|
|
|
|
"4" => "aug", |
288
|
|
|
|
|
|
|
"5" => "6", |
289
|
|
|
|
|
|
|
"6" => "maj7", |
290
|
|
|
|
|
|
|
"7" => "maj9", |
291
|
|
|
|
|
|
|
"8" => "maj9#11", |
292
|
|
|
|
|
|
|
"9" => "maj13#11", |
293
|
|
|
|
|
|
|
"10" => "maj13", |
294
|
|
|
|
|
|
|
"12" => "+", |
295
|
|
|
|
|
|
|
"13" => "maj7#5", |
296
|
|
|
|
|
|
|
"14" => "69", |
297
|
|
|
|
|
|
|
"15" => "2", |
298
|
|
|
|
|
|
|
"16" => "m", |
299
|
|
|
|
|
|
|
"17" => "maug", |
300
|
|
|
|
|
|
|
"18" => "mM7", |
301
|
|
|
|
|
|
|
"19" => "m7", |
302
|
|
|
|
|
|
|
"20" => "m9", |
303
|
|
|
|
|
|
|
"21" => "m11", |
304
|
|
|
|
|
|
|
"22" => "m13", |
305
|
|
|
|
|
|
|
"23" => "m6", |
306
|
|
|
|
|
|
|
"24" => "m#5", |
307
|
|
|
|
|
|
|
"25" => "m7#5", |
308
|
|
|
|
|
|
|
"26" => "m69", |
309
|
|
|
|
|
|
|
"32" => "m7b5", |
310
|
|
|
|
|
|
|
"33" => "dim", |
311
|
|
|
|
|
|
|
"34" => "m9b5", |
312
|
|
|
|
|
|
|
"40" => "5", |
313
|
|
|
|
|
|
|
"56" => "7+", |
314
|
|
|
|
|
|
|
"57" => "+", |
315
|
|
|
|
|
|
|
"58" => "13+", |
316
|
|
|
|
|
|
|
"64" => "7", |
317
|
|
|
|
|
|
|
"65" => "13", |
318
|
|
|
|
|
|
|
"66" => "7b13", |
319
|
|
|
|
|
|
|
"67" => "7#11", |
320
|
|
|
|
|
|
|
"70" => "9", |
321
|
|
|
|
|
|
|
# "70" => "9b13", |
322
|
|
|
|
|
|
|
"73" => "9#11", |
323
|
|
|
|
|
|
|
"74" => "13#11", |
324
|
|
|
|
|
|
|
"76" => "7b9", |
325
|
|
|
|
|
|
|
"77" => "13b9", |
326
|
|
|
|
|
|
|
"79" => "7b9#11", |
327
|
|
|
|
|
|
|
"82" => "7#9", |
328
|
|
|
|
|
|
|
"83" => "13#9", |
329
|
|
|
|
|
|
|
"84" => "7#9b13", |
330
|
|
|
|
|
|
|
"85" => "9#11", |
331
|
|
|
|
|
|
|
"88" => "7b5", |
332
|
|
|
|
|
|
|
"89" => "13b5", |
333
|
|
|
|
|
|
|
"91" => "9b5", |
334
|
|
|
|
|
|
|
"93" => "7b5b9", |
335
|
|
|
|
|
|
|
"96" => "7b5#9", |
336
|
|
|
|
|
|
|
"99" => "7#5", |
337
|
|
|
|
|
|
|
"103" => "9#5", |
338
|
|
|
|
|
|
|
"105" => "7#5b9", |
339
|
|
|
|
|
|
|
"109" => "7#5#9", |
340
|
|
|
|
|
|
|
"113" => "7alt", |
341
|
|
|
|
|
|
|
"128" => "7sus", |
342
|
|
|
|
|
|
|
"129" => "13sus", |
343
|
|
|
|
|
|
|
"134" => "11", |
344
|
|
|
|
|
|
|
"140" => "7susb9", |
345
|
|
|
|
|
|
|
"146" => "7sus#9", |
346
|
|
|
|
|
|
|
"163" => "7sus#5", |
347
|
|
|
|
|
|
|
"177" => "4", |
348
|
|
|
|
|
|
|
"184" => "sus", |
349
|
|
|
|
|
|
|
); |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
sub chordroot { |
352
|
0
|
|
|
0
|
0
|
|
my ( $nr ) = @_; |
353
|
|
|
|
|
|
|
# Convert the byte for chord root to a string. |
354
|
0
|
|
|
|
|
|
my @roots = ( '/','C','Db','D','Eb','E','F','Gb','G', |
355
|
|
|
|
|
|
|
'Ab','A','Bb','B','C#','D#','F#','G#','A#'); |
356
|
0
|
|
|
|
|
|
my @bassflat = ('B','C','Db','D','Eb','E','F','Gb','G','Ab','A','Bb'); |
357
|
0
|
|
|
|
|
|
my @basssharp = ('B','C','C#','D','D#','E','F','F#','G','G#','A','A#'); |
358
|
|
|
|
|
|
|
|
359
|
0
|
|
|
|
|
|
my $root = $roots[$nr % 18]; |
360
|
0
|
0
|
|
|
|
|
if ( $nr > 18 ) { |
361
|
0
|
|
|
|
|
|
my $bass = ""; |
362
|
0
|
0
|
|
|
|
|
if ( $root =~ /b/ ) { |
363
|
0
|
|
|
|
|
|
$bass = $bassflat[(int $nr / 18 + $nr % 18) % 12]; #flat slash |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
else { |
366
|
0
|
|
|
|
|
|
$bass = $basssharp[(int $nr / 18 + $nr % 18) % 12]; #sharp slash |
367
|
|
|
|
|
|
|
} |
368
|
0
|
|
|
|
|
|
$root .= "/" . $bass; |
369
|
|
|
|
|
|
|
} |
370
|
0
|
|
|
|
|
|
return $root; |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
sub makechords { |
374
|
0
|
|
|
0
|
0
|
|
my ( $self ) = @_; |
375
|
0
|
|
|
|
|
|
my @cn = @{ $self->{cnames} }; |
|
0
|
|
|
|
|
|
|
376
|
0
|
|
|
|
|
|
my @ct = @{ $self->{ctypes} }; |
|
0
|
|
|
|
|
|
|
377
|
0
|
|
|
|
|
|
my @c; |
378
|
0
|
0
|
|
|
|
|
carp("Expecting same number of chord names " . scalar(@cn) . |
379
|
|
|
|
|
|
|
" and chord types " . scalar(@ct)) |
380
|
|
|
|
|
|
|
unless @cn == @ct; |
381
|
0
|
|
|
|
|
|
for ( my $i = 0; $i < @cn; $i++ ) { |
382
|
0
|
0
|
|
|
|
|
if ( defined $cn[$i] ) { |
383
|
0
|
0
|
|
|
|
|
if ( defined $ct[$i] ) { |
384
|
|
|
|
|
|
|
push( @c, |
385
|
|
|
|
|
|
|
sprintf("%3d %3d %s %s", |
386
|
|
|
|
|
|
|
$cn[$i], $ct[$i], |
387
|
0
|
|
|
|
|
|
chordroot($cn[$i]), $ctypes{"".$ct[$i]})); |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
else { |
390
|
0
|
|
|
|
|
|
warn("Chord ", 1+$i, ": name = $cn[$i], no type\n"); |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
else { |
394
|
0
|
0
|
|
|
|
|
if ( defined $ct[$i] ) { |
395
|
0
|
|
|
|
|
|
warn("Chord ", 1+$i, ": no name, type = $ct[$i]\n"); |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
else { |
398
|
0
|
|
|
|
|
|
push( @c, undef ); |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
} |
402
|
|
|
|
|
|
|
|
403
|
0
|
|
|
|
|
|
$self->{chords} = \@c; |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=head1 AUTHOR |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
Johan Vromans, C<< >> |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=head1 BUGS |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, or through |
413
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll |
414
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
=head1 SUPPORT |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
perldoc Data::BiaB |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
You can also look for information at: |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=over 4 |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
L |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
=item * Search CPAN |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
L |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
=back |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
PG Music inc., for making Band-in-a-Box. I've used Band-in-a-Box for |
439
|
|
|
|
|
|
|
several years with great pleasure. |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
The ancient and abandoned Band-In-A-Box File Converter 'biabconverter' |
442
|
|
|
|
|
|
|
by Alain Brenzikofer inspired me to write this. |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
Copyright 2016 Johan Vromans, all rights reserved. |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
449
|
|
|
|
|
|
|
under the same terms as Perl itself. |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
=cut |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
1; # End of Data::BiaB |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
package main; |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
unless ( caller ) { |
458
|
1
|
|
|
1
|
|
5
|
use Data::Dumper; |
|
1
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
123
|
|
459
|
|
|
|
|
|
|
my $b = Data::BiaB->new( debug => 1 )->load (shift )->parse; |
460
|
|
|
|
|
|
|
$b->makechords; |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
if ( 1 ) { |
463
|
|
|
|
|
|
|
for ( qw( _raw stylemap ctypes cnames ) ) { |
464
|
|
|
|
|
|
|
delete $b->{$_}; |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
$b->{melody} = |
467
|
|
|
|
|
|
|
[ map { $_->[2] = Data::BiaB::pitchname($_->[2]); $_ } |
468
|
|
|
|
|
|
|
@{$b->{melody}} ]; |
469
|
|
|
|
|
|
|
warn(Dumper($b)); |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
} |