| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
# Time-stamp: "2010-12-23 10:00:01 conklin" |
|
3
|
|
|
|
|
|
|
require 5; |
|
4
|
|
|
|
|
|
|
package MIDI::Opus; |
|
5
|
11
|
|
|
11
|
|
421
|
use strict; |
|
|
11
|
|
|
|
|
27
|
|
|
|
11
|
|
|
|
|
1254
|
|
|
6
|
11
|
|
|
11
|
|
58
|
use vars qw($Debug $VERSION); |
|
|
11
|
|
|
|
|
182
|
|
|
|
11
|
|
|
|
|
1103
|
|
|
7
|
11
|
|
|
11
|
|
66
|
use Carp; |
|
|
11
|
|
|
|
|
20
|
|
|
|
11
|
|
|
|
|
44463
|
|
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
$Debug = 0; |
|
10
|
|
|
|
|
|
|
$VERSION = 0.83; |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 NAME |
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
MIDI::Opus -- functions and methods for MIDI opuses |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
use MIDI; # uses MIDI::Opus et al |
|
19
|
|
|
|
|
|
|
foreach $one (@ARGV) { |
|
20
|
|
|
|
|
|
|
my $opus = MIDI::Opus->new({ 'from_file' => $one, 'no_parse' => 1 }); |
|
21
|
|
|
|
|
|
|
print "$one has ", scalar( $opus->tracks ) " tracks\n"; |
|
22
|
|
|
|
|
|
|
} |
|
23
|
|
|
|
|
|
|
exit; |
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
MIDI::Opus provides a constructor and methods for objects |
|
28
|
|
|
|
|
|
|
representing a MIDI opus (AKA "song"). It is part of the MIDI suite. |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
An opus object has three attributes: a format (0 for MIDI Format 0), a |
|
31
|
|
|
|
|
|
|
tick parameter (parameter "division" in L), and a list |
|
32
|
|
|
|
|
|
|
of tracks objects that are the real content of that opus. |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
Be aware that options specified for the encoding or decoding of an |
|
35
|
|
|
|
|
|
|
opus may not be documented in I module's documentation, as they |
|
36
|
|
|
|
|
|
|
may be (and, in fact, generally are) options just passed down to the |
|
37
|
|
|
|
|
|
|
decoder/encoder in MIDI::Event -- so see L for an |
|
38
|
|
|
|
|
|
|
explanation of most of them, actually. |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head1 CONSTRUCTOR AND METHODS |
|
41
|
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
MIDI::Opus provides... |
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=over |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=cut |
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
########################################################################### |
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=item the constructor MIDI::Opus->new({ ...options... }) |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
This returns a new opus object. The options, which are optional, is |
|
53
|
|
|
|
|
|
|
an anonymous hash. By default, you get a new format-0 opus with no |
|
54
|
|
|
|
|
|
|
tracks and a tick parameter of 96. There are six recognized options: |
|
55
|
|
|
|
|
|
|
C, to set the MIDI format number (generally either 0 or 1) of |
|
56
|
|
|
|
|
|
|
the new object; C, to set its ticks parameter; C, which |
|
57
|
|
|
|
|
|
|
sets the tracks of the new opus to the contents of the list-reference |
|
58
|
|
|
|
|
|
|
provided; C, which is an exact synonym of C; |
|
59
|
|
|
|
|
|
|
C, which reads the opus from the given filespec; and |
|
60
|
|
|
|
|
|
|
C, which reads the opus from the the given filehandle |
|
61
|
|
|
|
|
|
|
reference (e.g., C<*STDIN{IO}>), after having called binmode() on that |
|
62
|
|
|
|
|
|
|
handle, if that's a problem. |
|
63
|
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
If you specify either C or C, you probably |
|
65
|
|
|
|
|
|
|
don't want to specify any of the other options -- altho you may well |
|
66
|
|
|
|
|
|
|
want to specify options that'll get passed down to the decoder in |
|
67
|
|
|
|
|
|
|
MIDI::Events, such as 'include' => ['sysex_f0', 'sysex_f7'], just for |
|
68
|
|
|
|
|
|
|
example. |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
Finally, the option C can be used in conjuction with either |
|
71
|
|
|
|
|
|
|
C or C, and, if true, will block MTrk tracks' |
|
72
|
|
|
|
|
|
|
data from being parsed into MIDI events, and will leave them as track |
|
73
|
|
|
|
|
|
|
data (i.e., what you get from $track->data). This is useful if you |
|
74
|
|
|
|
|
|
|
are just moving tracks around across files (or just counting them in |
|
75
|
|
|
|
|
|
|
files, as in the code in the Synopsis, above), without having to deal |
|
76
|
|
|
|
|
|
|
with any of the events in them. (Actually, this option is implemented |
|
77
|
|
|
|
|
|
|
in code in MIDI::Track, but in a routine there that I've left |
|
78
|
|
|
|
|
|
|
undocumented, as you should access it only thru here.) |
|
79
|
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=cut |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub new { |
|
83
|
|
|
|
|
|
|
# Make a new MIDI opus object. |
|
84
|
11
|
|
|
11
|
1
|
2009088
|
my $class = shift; |
|
85
|
11
|
50
|
33
|
|
|
150
|
my $options_r = (defined($_[0]) and ref($_[0]) eq 'HASH') ? $_[0] : {}; |
|
86
|
|
|
|
|
|
|
|
|
87
|
11
|
|
|
|
|
41
|
my $this = bless( {}, $class ); |
|
88
|
|
|
|
|
|
|
|
|
89
|
11
|
50
|
|
|
|
56
|
print "New object in class $class\n" if $Debug; |
|
90
|
|
|
|
|
|
|
|
|
91
|
11
|
50
|
|
|
|
64
|
return $this if $options_r->{'no_opus_init'}; # bypasses all init. |
|
92
|
11
|
|
|
|
|
68
|
$this->_init( $options_r ); |
|
93
|
|
|
|
|
|
|
|
|
94
|
11
|
100
|
66
|
|
|
145
|
if( |
|
|
|
50
|
66
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
95
|
|
|
|
|
|
|
exists( $options_r->{'from_file'} ) && |
|
96
|
|
|
|
|
|
|
defined( $options_r->{'from_file'} ) && |
|
97
|
|
|
|
|
|
|
length( $options_r->{'from_file'} ) |
|
98
|
|
|
|
|
|
|
){ |
|
99
|
9
|
|
|
|
|
50
|
$this->read_from_file( $options_r->{'from_file'}, $options_r ); |
|
100
|
|
|
|
|
|
|
} elsif( |
|
101
|
|
|
|
|
|
|
exists( $options_r->{'from_handle'} ) && |
|
102
|
|
|
|
|
|
|
defined( $options_r->{'from_handle'} ) && |
|
103
|
|
|
|
|
|
|
length( $options_r->{'from_handle'} ) |
|
104
|
|
|
|
|
|
|
){ |
|
105
|
0
|
|
|
|
|
0
|
$this->read_from_handle( $options_r->{'from_handle'}, $options_r ); |
|
106
|
|
|
|
|
|
|
} |
|
107
|
11
|
|
|
|
|
53
|
return $this; |
|
108
|
|
|
|
|
|
|
} |
|
109
|
|
|
|
|
|
|
########################################################################### |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=item the method $new_opus = $opus->copy |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
This duplicates the contents of the given opus, and returns |
|
114
|
|
|
|
|
|
|
the duplicate. If you are unclear on why you may need this function, |
|
115
|
|
|
|
|
|
|
read the documentation for the C method in L. |
|
116
|
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=cut |
|
118
|
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub copy { |
|
120
|
|
|
|
|
|
|
# Duplicate a given opus. Even dupes the tracks. |
|
121
|
|
|
|
|
|
|
# Call as $new_one = $opus->copy |
|
122
|
0
|
|
|
0
|
1
|
0
|
my $opus = shift; |
|
123
|
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
0
|
my $new = bless( { %{$opus} }, ref $opus ); |
|
|
0
|
|
|
|
|
0
|
|
|
125
|
|
|
|
|
|
|
# a first crude dupe. |
|
126
|
|
|
|
|
|
|
# yes, bless it into whatever class the original came from |
|
127
|
|
|
|
|
|
|
|
|
128
|
0
|
|
|
|
|
0
|
$new->{'tracks'} = # Now dupe the tracks. |
|
129
|
|
|
|
|
|
|
[ map( $_->copy, |
|
130
|
0
|
0
|
|
|
|
0
|
@{ $new->{'tracks'} } |
|
131
|
|
|
|
|
|
|
) |
|
132
|
|
|
|
|
|
|
] if $new->{'tracks'}; # (which should always be true anyhoo) |
|
133
|
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
0
|
return $new; |
|
135
|
|
|
|
|
|
|
} |
|
136
|
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub _init { |
|
138
|
|
|
|
|
|
|
# Init a MIDI object -- (re)set it with given parameters, or defaults |
|
139
|
11
|
|
|
11
|
|
25
|
my $this = shift; |
|
140
|
11
|
50
|
|
|
|
48
|
my $options_r = ref($_[0]) eq 'HASH' ? $_[0] : {}; |
|
141
|
|
|
|
|
|
|
|
|
142
|
11
|
50
|
|
|
|
43
|
print "_init called against $this\n" if $Debug; |
|
143
|
11
|
50
|
|
|
|
35
|
if($Debug) { |
|
144
|
0
|
0
|
|
|
|
0
|
if(%$options_r) { |
|
145
|
0
|
|
|
|
|
0
|
print "Parameters: ", map("<$_>", %$options_r), "\n"; |
|
146
|
|
|
|
|
|
|
} else { |
|
147
|
0
|
|
|
|
|
0
|
print "Null parameters for opus init\n"; |
|
148
|
|
|
|
|
|
|
} |
|
149
|
|
|
|
|
|
|
} |
|
150
|
11
|
100
|
|
|
|
91
|
$this->{'format'} = |
|
151
|
|
|
|
|
|
|
defined($options_r->{'format'}) ? $options_r->{'format'} : 1; |
|
152
|
11
|
100
|
|
|
|
74
|
$this->{'ticks'} = |
|
153
|
|
|
|
|
|
|
defined($options_r->{'ticks'}) ? $options_r->{'ticks'} : 96; |
|
154
|
|
|
|
|
|
|
|
|
155
|
11
|
50
|
33
|
|
|
69
|
$options_r->{'tracks'} = $options_r->{'tracks_r'} |
|
156
|
|
|
|
|
|
|
if( exists( $options_r->{'tracks_r'} ) and not |
|
157
|
|
|
|
|
|
|
exists( $options_r->{'tracks'} ) |
|
158
|
|
|
|
|
|
|
); |
|
159
|
|
|
|
|
|
|
# so tracks_r => [ @tracks ] is a synonym for |
|
160
|
|
|
|
|
|
|
# tracks => [ @tracks ] |
|
161
|
|
|
|
|
|
|
# as on option for new() |
|
162
|
|
|
|
|
|
|
|
|
163
|
11
|
100
|
66
|
|
|
141
|
$this->{'tracks'} = |
|
164
|
|
|
|
|
|
|
( defined($options_r->{'tracks'}) |
|
165
|
|
|
|
|
|
|
and ref($options_r->{'tracks'}) eq 'ARRAY' ) |
|
166
|
|
|
|
|
|
|
? $options_r->{'tracks'} : [] |
|
167
|
|
|
|
|
|
|
; |
|
168
|
11
|
|
|
|
|
28
|
return; |
|
169
|
|
|
|
|
|
|
} |
|
170
|
|
|
|
|
|
|
######################################################################### |
|
171
|
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=item the method $opus->tracks( @tracks ) |
|
173
|
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Returns the list of tracks in the opus, possibly after having set it |
|
175
|
|
|
|
|
|
|
to @tracks, if specified and not empty. (If you happen to want to set |
|
176
|
|
|
|
|
|
|
the list of tracks to an empty list, for whatever reason, you have to |
|
177
|
|
|
|
|
|
|
use "$opus->tracks_r([])".) |
|
178
|
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
In other words: $opus->tracks(@tracks) is how to set the list of |
|
180
|
|
|
|
|
|
|
tracks (assuming @tracks is not empty), and @tracks = $opus->tracks is |
|
181
|
|
|
|
|
|
|
how to read the list of tracks. |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=cut |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub tracks { |
|
186
|
12
|
|
|
12
|
1
|
36
|
my $this = shift; |
|
187
|
12
|
50
|
|
|
|
51
|
$this->{'tracks'} = [ @_ ] if @_; |
|
188
|
12
|
|
|
|
|
21
|
return @{ $this->{'tracks'} }; |
|
|
12
|
|
|
|
|
48
|
|
|
189
|
|
|
|
|
|
|
} |
|
190
|
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=item the method $opus->tracks_r( $tracks_r ) |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
Returns a reference to the list of tracks in the opus, possibly after |
|
194
|
|
|
|
|
|
|
having set it to $tracks_r, if specified. "$tracks_r" can actually be |
|
195
|
|
|
|
|
|
|
any listref, whether it comes from a scalar as in C<$some_tracks_r>, |
|
196
|
|
|
|
|
|
|
or from something like C<[@tracks]>, or just plain old C<\@tracks> |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
Originally $opus->tracks was the only way to deal with tracks, but I |
|
199
|
|
|
|
|
|
|
added $opus->tracks_r to make possible 1) setting the list of tracks |
|
200
|
|
|
|
|
|
|
to (), for whatever that's worth, 2) parallel structure between |
|
201
|
|
|
|
|
|
|
MIDI::Opus::tracks[_r] and MIDI::Tracks::events[_r] and 3) so you can |
|
202
|
|
|
|
|
|
|
directly manipulate the opus's tracks, without having to I the |
|
203
|
|
|
|
|
|
|
list of tracks back and forth. This way, you can say: |
|
204
|
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
$tracks_r = $opus->tracks_r(); |
|
206
|
|
|
|
|
|
|
@some_stuff = splice(@$tracks_r, 4, 6); |
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
But if you don't know how to deal with listrefs like that, that's OK, |
|
209
|
|
|
|
|
|
|
just use $opus->tracks. |
|
210
|
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=cut |
|
212
|
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub tracks_r { |
|
214
|
25
|
|
|
25
|
1
|
43
|
my $this = shift; |
|
215
|
25
|
100
|
|
|
|
185
|
$this->{'tracks'} = $_[0] if ref($_[0]); |
|
216
|
25
|
|
|
|
|
119
|
return $this->{'tracks'}; |
|
217
|
|
|
|
|
|
|
} |
|
218
|
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=item the method $opus->ticks( $tick_parameter ) |
|
220
|
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
Returns the tick parameter from $opus, after having set it to |
|
222
|
|
|
|
|
|
|
$tick_parameter, if provided. |
|
223
|
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=cut |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub ticks { |
|
227
|
10
|
|
|
10
|
1
|
4559
|
my $this = shift; |
|
228
|
10
|
100
|
|
|
|
45
|
$this->{'ticks'} = $_[0] if defined($_[0]); |
|
229
|
10
|
|
|
|
|
74
|
return $this->{'ticks'}; |
|
230
|
|
|
|
|
|
|
} |
|
231
|
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=item the method $opus->format( $format ) |
|
233
|
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
Returns the MIDI format for $opus, after having set it to |
|
235
|
|
|
|
|
|
|
$format, if provided. |
|
236
|
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=cut |
|
238
|
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
sub format { |
|
240
|
10
|
|
|
10
|
1
|
21
|
my $this = shift; |
|
241
|
10
|
100
|
|
|
|
40
|
$this->{'format'} = $_[0] if defined($_[0]); |
|
242
|
10
|
|
|
|
|
45
|
return $this->{'format'}; |
|
243
|
|
|
|
|
|
|
} |
|
244
|
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
sub info { # read-only |
|
246
|
|
|
|
|
|
|
# Hm, do I really want this routine? For ANYTHING at all? |
|
247
|
0
|
|
|
0
|
0
|
0
|
my $this = shift; |
|
248
|
|
|
|
|
|
|
return ( |
|
249
|
0
|
|
|
|
|
0
|
'format' => $this->{'format'},# I want a scalar |
|
250
|
|
|
|
|
|
|
'ticks' => $this->{'ticks'}, # I want a scalar |
|
251
|
|
|
|
|
|
|
'tracks' => $this->{'tracks'} # I want a ref to a list |
|
252
|
|
|
|
|
|
|
); |
|
253
|
|
|
|
|
|
|
} |
|
254
|
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=item the method $new_opus = $opus->quantize |
|
256
|
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
This grid quantizes an opus. It simply calls MIDI::Score::quantize on |
|
258
|
|
|
|
|
|
|
every track. See docs for MIDI::Score::quantize. Original opus is |
|
259
|
|
|
|
|
|
|
destroyed, use MIDI::Opus::copy if you want to take a copy first. |
|
260
|
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=cut |
|
262
|
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub quantize { |
|
264
|
1
|
|
|
1
|
1
|
10
|
my $this = $_[0]; |
|
265
|
1
|
50
|
|
|
|
12
|
my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {}; |
|
266
|
1
|
|
|
|
|
2
|
my $grid = $options_r->{grid}; |
|
267
|
1
|
50
|
|
|
|
5
|
if ($grid < 1) {carp "bad grid $grid in MIDI::Opus::quantize!"; return;} |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
268
|
1
|
50
|
|
|
|
4
|
return if ($grid eq 1); # no quantizing to do |
|
269
|
1
|
|
|
|
|
7
|
my $qd = $options_r->{durations}; # quantize durations? |
|
270
|
1
|
|
|
|
|
2
|
my $new_tracks_r = []; |
|
271
|
1
|
|
|
|
|
3
|
foreach my $track ($this->tracks) { |
|
272
|
1
|
|
|
|
|
5
|
my $score_r = MIDI::Score::events_r_to_score_r($track->events_r); |
|
273
|
1
|
|
|
|
|
7
|
my $new_score_r = MIDI::Score::quantize($score_r,{grid=>$grid,durations=>$qd}); |
|
274
|
1
|
|
|
|
|
13
|
my $events_r = MIDI::Score::score_r_to_events_r($new_score_r); |
|
275
|
1
|
|
|
|
|
6
|
my $new_track = MIDI::Track->new({events_r=>$events_r}); |
|
276
|
1
|
|
|
|
|
2
|
push @{$new_tracks_r}, $new_track; |
|
|
1
|
|
|
|
|
13
|
|
|
277
|
|
|
|
|
|
|
} |
|
278
|
1
|
|
|
|
|
5
|
$this->tracks_r($new_tracks_r); |
|
279
|
|
|
|
|
|
|
} |
|
280
|
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
########################################################################### |
|
282
|
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=item the method $opus->dump( { ...options...} ) |
|
284
|
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
Dumps the opus object as a bunch of text, for your perusal. Options |
|
286
|
|
|
|
|
|
|
include: C, if true, will have each event in the opus as a |
|
287
|
|
|
|
|
|
|
tab-delimited line -- or as delimited with whatever you specify with |
|
288
|
|
|
|
|
|
|
option C; I, dump the data as Perl code that, if |
|
289
|
|
|
|
|
|
|
run, would/should reproduce the opus. For concision's sake, the track data |
|
290
|
|
|
|
|
|
|
isn't dumped, unless you specify the option C as true. |
|
291
|
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=cut |
|
293
|
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
sub dump { # method; read-only |
|
295
|
0
|
|
|
0
|
1
|
0
|
my $this = $_[0]; |
|
296
|
0
|
|
|
|
|
0
|
my %info = $this->info(); |
|
297
|
0
|
0
|
|
|
|
0
|
my $options_r = ref($_[1]) eq 'HASH' ? $_[1] : {}; |
|
298
|
|
|
|
|
|
|
|
|
299
|
0
|
0
|
|
|
|
0
|
if($options_r->{'flat'}) { # Super-barebones dump mode |
|
300
|
0
|
|
0
|
|
|
0
|
my $d = $options_r->{'delimiter'} || "\t"; |
|
301
|
0
|
|
|
|
|
0
|
foreach my $track ($this->tracks) { |
|
302
|
0
|
|
|
|
|
0
|
foreach my $event (@{ $track->events_r }) { |
|
|
0
|
|
|
|
|
0
|
|
|
303
|
0
|
|
|
|
|
0
|
print( join($d, @$event), "\n" ); |
|
304
|
|
|
|
|
|
|
} |
|
305
|
|
|
|
|
|
|
} |
|
306
|
0
|
|
|
|
|
0
|
return; |
|
307
|
|
|
|
|
|
|
} |
|
308
|
|
|
|
|
|
|
|
|
309
|
0
|
|
|
|
|
0
|
print "MIDI::Opus->new({\n", |
|
310
|
|
|
|
|
|
|
" 'format' => ", &MIDI::_dump_quote($this->{'format'}), ",\n", |
|
311
|
|
|
|
|
|
|
" 'ticks' => ", &MIDI::_dump_quote($this->{'ticks'}), ",\n"; |
|
312
|
|
|
|
|
|
|
|
|
313
|
0
|
|
|
|
|
0
|
my @tracks = $this->tracks; |
|
314
|
0
|
0
|
|
|
|
0
|
if( $options_r->{'dump_tracks'} ) { |
|
315
|
0
|
|
|
|
|
0
|
print " 'tracks' => [ # ", scalar(@tracks), " tracks...\n\n"; |
|
316
|
0
|
|
|
|
|
0
|
foreach my $x (0 .. $#tracks) { |
|
317
|
0
|
|
|
|
|
0
|
my $track = $tracks[$x]; |
|
318
|
0
|
|
|
|
|
0
|
print " # Track \#$x ...\n"; |
|
319
|
0
|
0
|
|
|
|
0
|
if(ref($track)) { |
|
320
|
0
|
|
|
|
|
0
|
$track->dump($options_r); |
|
321
|
|
|
|
|
|
|
} else { |
|
322
|
0
|
|
|
|
|
0
|
print " # \[$track\] is not a reference!!\n"; |
|
323
|
|
|
|
|
|
|
} |
|
324
|
|
|
|
|
|
|
} |
|
325
|
0
|
|
|
|
|
0
|
print " ]\n"; |
|
326
|
|
|
|
|
|
|
} else { |
|
327
|
0
|
|
|
|
|
0
|
print " 'tracks' => [ ], # ", scalar(@tracks), " tracks (not dumped)\n"; |
|
328
|
|
|
|
|
|
|
} |
|
329
|
0
|
|
|
|
|
0
|
print "});\n"; |
|
330
|
0
|
|
|
|
|
0
|
return 1; |
|
331
|
|
|
|
|
|
|
} |
|
332
|
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
########################################################################### |
|
334
|
|
|
|
|
|
|
# And now the real fun... |
|
335
|
|
|
|
|
|
|
########################################################################### |
|
336
|
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=item the method $opus->write_to_file('filespec', { ...options...} ) |
|
338
|
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
Writes $opus as a MIDI file named by the given filespec. |
|
340
|
|
|
|
|
|
|
The options hash is optional, and whatever you specify as options |
|
341
|
|
|
|
|
|
|
percolates down to the calls to MIDI::Event::encode -- which see. |
|
342
|
|
|
|
|
|
|
Currently this just opens the file, calls $opus->write_to_handle |
|
343
|
|
|
|
|
|
|
on the resulting filehandle, and closes the file. |
|
344
|
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
=cut |
|
346
|
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
sub write_to_file { # method |
|
348
|
|
|
|
|
|
|
# call as $opus->write_to_file("../../midis/stuff1.mid", { ..options..} ); |
|
349
|
2
|
|
|
2
|
1
|
211
|
my $opus = $_[0]; |
|
350
|
2
|
|
|
|
|
4
|
my $destination = $_[1]; |
|
351
|
2
|
50
|
|
|
|
10
|
my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {}; |
|
352
|
|
|
|
|
|
|
|
|
353
|
2
|
50
|
|
|
|
8
|
croak "No output file specified" unless length($destination); |
|
354
|
2
|
50
|
|
|
|
347
|
unless(open(OUT_MIDI, ">$destination")) { |
|
355
|
0
|
|
|
|
|
0
|
croak "Can't open $destination for writing\: \"$!\"\n"; |
|
356
|
|
|
|
|
|
|
} |
|
357
|
2
|
|
|
|
|
15
|
$opus->write_to_handle( *OUT_MIDI{IO}, $options_r); |
|
358
|
2
|
50
|
|
|
|
223
|
close(OUT_MIDI) |
|
359
|
|
|
|
|
|
|
|| croak "Can't close filehandle for $destination\: \"$!\"\n"; |
|
360
|
2
|
|
|
|
|
18
|
return; # nothing useful to return |
|
361
|
|
|
|
|
|
|
} |
|
362
|
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
sub read_from_file { # method, surprisingly enough |
|
364
|
|
|
|
|
|
|
# $opus->read_from_file("ziz1.mid", {'stuff' => 1}). |
|
365
|
|
|
|
|
|
|
# Overwrites the contents of $opus with the contents of the file ziz1.mid |
|
366
|
|
|
|
|
|
|
# $opus is presumably newly initted. |
|
367
|
|
|
|
|
|
|
# The options hash is optional. |
|
368
|
|
|
|
|
|
|
# This is currently meant to be called by only the |
|
369
|
|
|
|
|
|
|
# MIDI::Opus->new() constructor. |
|
370
|
|
|
|
|
|
|
|
|
371
|
9
|
|
|
9
|
0
|
22
|
my $opus = $_[0]; |
|
372
|
9
|
|
|
|
|
20
|
my $source = $_[1]; |
|
373
|
9
|
50
|
|
|
|
60
|
my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {}; |
|
374
|
|
|
|
|
|
|
|
|
375
|
9
|
50
|
|
|
|
42
|
croak "No source file specified" unless length($source); |
|
376
|
9
|
50
|
|
|
|
493
|
unless(open(IN_MIDI, "<$source")) { |
|
377
|
0
|
|
|
|
|
0
|
croak "Can't open $source for reading\: \"$!\"\n"; |
|
378
|
|
|
|
|
|
|
} |
|
379
|
9
|
|
|
|
|
109
|
my $size = -s $source; |
|
380
|
9
|
50
|
|
|
|
35
|
$size = undef unless $size; |
|
381
|
|
|
|
|
|
|
|
|
382
|
9
|
|
|
|
|
71
|
$opus->read_from_handle(*IN_MIDI{IO}, $options_r, $size); |
|
383
|
|
|
|
|
|
|
# Thanks to the EFNet #perl cabal for helping me puzzle out "*IN_MIDI{IO}" |
|
384
|
9
|
50
|
|
|
|
218
|
close(IN_MIDI) || |
|
385
|
|
|
|
|
|
|
croak "error while closing filehandle for $source\: \"$!\"\n"; |
|
386
|
|
|
|
|
|
|
|
|
387
|
9
|
|
|
|
|
42
|
return $opus; |
|
388
|
|
|
|
|
|
|
} |
|
389
|
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=item the method $opus->write_to_handle(IOREF, { ...options...} ) |
|
391
|
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
Writes $opus as a MIDI file to the IO handle you pass a reference to |
|
393
|
|
|
|
|
|
|
(example: C<*STDOUT{IO}>). |
|
394
|
|
|
|
|
|
|
The options hash is optional, and whatever you specify as options |
|
395
|
|
|
|
|
|
|
percolates down to the calls to MIDI::Event::encode -- which see. |
|
396
|
|
|
|
|
|
|
Note that this is probably not what you'd want for sending music |
|
397
|
|
|
|
|
|
|
to C, since MIDI files are not MIDI-on-the-wire. |
|
398
|
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
=cut |
|
400
|
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
########################################################################### |
|
402
|
|
|
|
|
|
|
sub write_to_handle { # method |
|
403
|
|
|
|
|
|
|
# Call as $opus->write_to_handle( *FH{IO}, { ...options... }); |
|
404
|
2
|
|
|
2
|
1
|
6
|
my $opus = $_[0]; |
|
405
|
2
|
|
|
|
|
4
|
my $fh = $_[1]; |
|
406
|
2
|
50
|
|
|
|
18
|
my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {}; |
|
407
|
|
|
|
|
|
|
|
|
408
|
2
|
|
|
|
|
15
|
binmode($fh); |
|
409
|
|
|
|
|
|
|
|
|
410
|
2
|
|
|
|
|
13
|
my $tracks = scalar( $opus->tracks ); |
|
411
|
2
|
50
|
|
|
|
9
|
carp "Writing out an opus with no tracks!\n" if $tracks == 0; |
|
412
|
|
|
|
|
|
|
|
|
413
|
2
|
|
|
|
|
2
|
my $format; |
|
414
|
2
|
50
|
|
|
|
9
|
if( defined($opus->{'format'}) ) { |
|
415
|
2
|
|
|
|
|
15
|
$format = $opus->{'format'}; |
|
416
|
|
|
|
|
|
|
} else { # Defaults |
|
417
|
0
|
0
|
|
|
|
0
|
if($tracks == 0) { |
|
|
|
0
|
|
|
|
|
|
|
418
|
0
|
|
|
|
|
0
|
$format = 2; # hey, why not? |
|
419
|
|
|
|
|
|
|
} elsif ($tracks == 1) { |
|
420
|
0
|
|
|
|
|
0
|
$format = 0; |
|
421
|
|
|
|
|
|
|
} else { |
|
422
|
0
|
|
|
|
|
0
|
$format = 1; |
|
423
|
|
|
|
|
|
|
} |
|
424
|
|
|
|
|
|
|
} |
|
425
|
2
|
50
|
|
|
|
8
|
my $ticks = |
|
426
|
|
|
|
|
|
|
defined($opus->{'ticks'}) ? $opus->{'ticks'} : 96 ; |
|
427
|
|
|
|
|
|
|
# Ninety-six ticks per quarter-note seems a pleasant enough default. |
|
428
|
|
|
|
|
|
|
|
|
429
|
2
|
|
|
|
|
48
|
print $fh ( |
|
430
|
|
|
|
|
|
|
"MThd\x00\x00\x00\x06", # header; 6 bytes follow |
|
431
|
|
|
|
|
|
|
pack('nnn', $format, $tracks, $ticks) |
|
432
|
|
|
|
|
|
|
); |
|
433
|
2
|
|
|
|
|
7
|
foreach my $track (@{ $opus->{'tracks'} }) { |
|
|
2
|
|
|
|
|
7
|
|
|
434
|
2
|
|
|
|
|
6
|
my $data = ''; |
|
435
|
2
|
|
|
|
|
10
|
my $type = substr($track->{'type'} . "\x00\x00\x00\x00", 0, 4); |
|
436
|
|
|
|
|
|
|
# Force it to be 4 chars long. |
|
437
|
2
|
|
|
|
|
4
|
$data = ${ $track->encode( $options_r ) }; |
|
|
2
|
|
|
|
|
13
|
|
|
438
|
|
|
|
|
|
|
# $track->encode will handle the issue of whether |
|
439
|
|
|
|
|
|
|
# to use the track's data or its events |
|
440
|
2
|
|
|
|
|
42
|
print $fh ($type, pack('N', length($data)), $data); |
|
441
|
|
|
|
|
|
|
} |
|
442
|
2
|
|
|
|
|
9
|
return; |
|
443
|
|
|
|
|
|
|
} |
|
444
|
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
############################################################################ |
|
446
|
|
|
|
|
|
|
sub read_from_handle { # a method, surprisingly enough |
|
447
|
|
|
|
|
|
|
# $opus->read_from_handle(*STDIN{IO}, {'stuff' => 1}). |
|
448
|
|
|
|
|
|
|
# Overwrites the contents of $opus with the contents of the MIDI file |
|
449
|
|
|
|
|
|
|
# from the filehandle you're passing a reference to. |
|
450
|
|
|
|
|
|
|
# $opus is presumably newly initted. |
|
451
|
|
|
|
|
|
|
# The options hash is optional. |
|
452
|
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
# This is currently meant to be called by only the |
|
454
|
|
|
|
|
|
|
# MIDI::Opus->new() constructor. |
|
455
|
|
|
|
|
|
|
|
|
456
|
9
|
|
|
9
|
0
|
21
|
my $opus = $_[0]; |
|
457
|
9
|
|
|
|
|
21
|
my $fh = $_[1]; |
|
458
|
9
|
50
|
|
|
|
45
|
my $options_r = ref($_[2]) eq 'HASH' ? $_[2] : {}; |
|
459
|
9
|
|
|
|
|
16
|
my $file_size_left; |
|
460
|
9
|
50
|
|
|
|
77
|
$file_size_left = $_[3] if defined $_[3]; |
|
461
|
|
|
|
|
|
|
|
|
462
|
9
|
|
|
|
|
51
|
binmode($fh); |
|
463
|
|
|
|
|
|
|
|
|
464
|
9
|
|
|
|
|
25
|
my $in = ''; |
|
465
|
|
|
|
|
|
|
|
|
466
|
9
|
|
|
|
|
24
|
my $track_size_limit; |
|
467
|
9
|
50
|
|
|
|
41
|
$track_size_limit = $options_r->{'track_size'} |
|
468
|
|
|
|
|
|
|
if exists $options_r->{'track_size'}; |
|
469
|
|
|
|
|
|
|
|
|
470
|
9
|
50
|
|
|
|
298
|
croak "Can't even read the first 14 bytes from filehandle $fh" |
|
471
|
|
|
|
|
|
|
unless read($fh, $in, 14); |
|
472
|
|
|
|
|
|
|
# 14 = The expected header length. |
|
473
|
|
|
|
|
|
|
|
|
474
|
9
|
50
|
|
|
|
38
|
if(defined $file_size_left) { |
|
475
|
9
|
|
|
|
|
23
|
$file_size_left -= 14; |
|
476
|
|
|
|
|
|
|
} |
|
477
|
|
|
|
|
|
|
|
|
478
|
9
|
|
|
|
|
80
|
my($id, $length, $format, $tracks_expected, $ticks) = unpack('A4Nnnn', $in); |
|
479
|
|
|
|
|
|
|
|
|
480
|
9
|
50
|
|
|
|
37
|
croak "data from handle $fh doesn't start with a MIDI file header" |
|
481
|
|
|
|
|
|
|
unless $id eq 'MThd'; |
|
482
|
9
|
50
|
|
|
|
60
|
croak "Unexpected MTHd chunk length in data from handle $fh" |
|
483
|
|
|
|
|
|
|
unless $length == 6; |
|
484
|
9
|
|
|
|
|
23
|
$opus->{'format'} = $format; |
|
485
|
9
|
|
|
|
|
23
|
$opus->{'ticks'} = $ticks; # ...which may be a munged 'negative' number |
|
486
|
9
|
|
|
|
|
23
|
$opus->{'tracks'} = []; |
|
487
|
|
|
|
|
|
|
|
|
488
|
9
|
50
|
|
|
|
50
|
print "file header from handle $fh read and parsed fine.\n" if $Debug; |
|
489
|
9
|
|
|
|
|
17
|
my $track_count = 0; |
|
490
|
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
Track_Chunk: |
|
492
|
9
|
|
|
|
|
194
|
until( eof($fh) ) { |
|
493
|
15
|
|
|
|
|
41
|
++$track_count; |
|
494
|
15
|
50
|
|
|
|
50
|
print "Reading Track \# $track_count into a new track\n" if $Debug; |
|
495
|
|
|
|
|
|
|
|
|
496
|
15
|
50
|
|
|
|
45
|
if(defined $file_size_left) { |
|
497
|
15
|
|
|
|
|
24
|
$file_size_left -= 2; |
|
498
|
15
|
50
|
|
|
|
48
|
croak "reading further would exceed file_size_limit" |
|
499
|
|
|
|
|
|
|
if $file_size_left < 0; |
|
500
|
|
|
|
|
|
|
} |
|
501
|
|
|
|
|
|
|
|
|
502
|
15
|
|
|
|
|
27
|
my($header, $data); |
|
503
|
15
|
50
|
|
|
|
81
|
croak "Can't read header for track chunk \#$track_count" |
|
504
|
|
|
|
|
|
|
unless read($fh, $header, 8); |
|
505
|
15
|
|
|
|
|
59
|
my($type, $length) = unpack('A4N', $header); |
|
506
|
|
|
|
|
|
|
|
|
507
|
15
|
50
|
33
|
|
|
57
|
if(defined $track_size_limit and $track_size_limit > $length) { |
|
508
|
0
|
|
|
|
|
0
|
croak "Track \#$track_count\'s length ($length) would" |
|
509
|
|
|
|
|
|
|
. " exceed track_size_limit $track_size_limit"; |
|
510
|
|
|
|
|
|
|
} |
|
511
|
|
|
|
|
|
|
|
|
512
|
15
|
50
|
|
|
|
55
|
if(defined $file_size_left) { |
|
513
|
15
|
|
|
|
|
22
|
$file_size_left -= $length; |
|
514
|
15
|
50
|
|
|
|
43
|
croak "reading track \#$track_count (of length $length) " |
|
515
|
|
|
|
|
|
|
. "would exceed file_size_limit" |
|
516
|
|
|
|
|
|
|
if $file_size_left < 0; |
|
517
|
|
|
|
|
|
|
} |
|
518
|
|
|
|
|
|
|
|
|
519
|
15
|
|
|
|
|
70
|
read($fh, $data, $length); # whooboy, actually read it now |
|
520
|
|
|
|
|
|
|
|
|
521
|
15
|
50
|
|
|
|
53
|
if($length == length($data)) { |
|
522
|
15
|
|
|
|
|
101
|
push( |
|
523
|
15
|
|
|
|
|
23
|
@{ $opus->{'tracks'} }, |
|
524
|
|
|
|
|
|
|
&MIDI::Track::decode( $type, \$data, $options_r ) |
|
525
|
|
|
|
|
|
|
); |
|
526
|
|
|
|
|
|
|
} else { |
|
527
|
0
|
|
|
|
|
0
|
croak |
|
528
|
|
|
|
|
|
|
"Length of track \#$track_count is off in data from $fh; " |
|
529
|
|
|
|
|
|
|
. "I wanted $length\, but got " |
|
530
|
|
|
|
|
|
|
. length($data); |
|
531
|
|
|
|
|
|
|
} |
|
532
|
|
|
|
|
|
|
} |
|
533
|
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
carp |
|
535
|
9
|
50
|
|
|
|
58
|
"Header in data from $fh says to expect $tracks_expected tracks, " |
|
536
|
|
|
|
|
|
|
. "but $track_count were found\n" |
|
537
|
|
|
|
|
|
|
unless $tracks_expected == $track_count; |
|
538
|
9
|
50
|
|
|
|
832
|
carp "No tracks read in data from $fh\n" if $track_count == 0; |
|
539
|
|
|
|
|
|
|
|
|
540
|
9
|
|
|
|
|
33
|
return $opus; |
|
541
|
|
|
|
|
|
|
} |
|
542
|
|
|
|
|
|
|
########################################################################### |
|
543
|
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
=item the method $opus->draw({ ...options...}) |
|
545
|
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
This currently experimental method returns a new GD image object that's |
|
547
|
|
|
|
|
|
|
a graphic representation of the notes in the given opus. Options include: |
|
548
|
|
|
|
|
|
|
C -- the width of the image in pixels (defaults to 600); |
|
549
|
|
|
|
|
|
|
C -- a six-digit hex RGB representation of the background color |
|
550
|
|
|
|
|
|
|
for the image (defaults to $MIDI::Opus::BG_color, currently '000000'); |
|
551
|
|
|
|
|
|
|
C -- a reference to a list of colors (in six-digit hex RGB) |
|
552
|
|
|
|
|
|
|
to use for representing notes on given channels. |
|
553
|
|
|
|
|
|
|
Defaults to @MIDI::Opus::Channel_colors. |
|
554
|
|
|
|
|
|
|
This list is a list of pairs of colors, such that: |
|
555
|
|
|
|
|
|
|
the first of a pair (color N*2) is the color for the first pixel in a |
|
556
|
|
|
|
|
|
|
note on channel N; and the second (color N*2 + 1) is the color for the |
|
557
|
|
|
|
|
|
|
remaining pixels of that note. If you specify only enough colors for |
|
558
|
|
|
|
|
|
|
channels 0 to M, notes on a channels above M will use 'recycled' |
|
559
|
|
|
|
|
|
|
colors -- they will be plotted with the color for channel |
|
560
|
|
|
|
|
|
|
"channel_number % M" (where C<%> = the MOD operator). |
|
561
|
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
This means that if you specify |
|
563
|
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
channel_colors => ['00ffff','0000ff'] |
|
565
|
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
then all the channels' notes will be plotted with an aqua pixel followed |
|
567
|
|
|
|
|
|
|
by blue ones; and if you specify |
|
568
|
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
channel_colors => ['00ffff','0000ff', 'ff00ff','ff0000'] |
|
570
|
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
then all the I channels' notes will be plotted with an aqua |
|
572
|
|
|
|
|
|
|
pixel followed by blue ones, and all the I channels' notes will |
|
573
|
|
|
|
|
|
|
be plotted with a purple pixel followed by red ones. |
|
574
|
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
As to what to do with the object you get back, you probably want |
|
576
|
|
|
|
|
|
|
something like: |
|
577
|
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
$im = $chachacha->draw; |
|
579
|
|
|
|
|
|
|
open(OUT, ">$gif_out"); binmode(OUT); |
|
580
|
|
|
|
|
|
|
print OUT $im->gif; |
|
581
|
|
|
|
|
|
|
close(OUT); |
|
582
|
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
Using this method will cause a C if it can't successfully C |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
I emphasise that C is expermental, and, in any case, is only meant |
|
586
|
|
|
|
|
|
|
to be a crude hack. Notably, it does not address well some basic problems: |
|
587
|
|
|
|
|
|
|
neither volume nor patch-selection (nor any notable aspects of the |
|
588
|
|
|
|
|
|
|
patch selected) |
|
589
|
|
|
|
|
|
|
are represented; pitch-wheel changes are not represented; |
|
590
|
|
|
|
|
|
|
percussion (whether on percussive patches or on channel 10) is not |
|
591
|
|
|
|
|
|
|
specially represented, as it probably should be; |
|
592
|
|
|
|
|
|
|
notes overlapping are not represented at all well. |
|
593
|
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
=cut |
|
595
|
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
sub draw { # method |
|
597
|
0
|
|
|
0
|
1
|
|
my $opus = $_[0]; |
|
598
|
0
|
0
|
|
|
|
|
my $options_r = ref($_[1]) ? $_[1] : {}; |
|
599
|
|
|
|
|
|
|
|
|
600
|
0
|
|
|
|
|
|
&use_GD(); # will die at runtime if we call this function but it can't use GD |
|
601
|
|
|
|
|
|
|
|
|
602
|
0
|
|
|
|
|
|
my $opus_time = 0; |
|
603
|
0
|
|
|
|
|
|
my @scores = (); |
|
604
|
0
|
|
|
|
|
|
foreach my $track ($opus->tracks) { |
|
605
|
0
|
|
|
|
|
|
my($score_r, $track_time) = MIDI::Score::events_r_to_score_r( |
|
606
|
|
|
|
|
|
|
$track->events_r ); |
|
607
|
0
|
0
|
|
|
|
|
push(@scores, $score_r) if @$score_r; |
|
608
|
0
|
0
|
|
|
|
|
$opus_time = $track_time if $track_time > $opus_time; |
|
609
|
|
|
|
|
|
|
} |
|
610
|
|
|
|
|
|
|
|
|
611
|
0
|
|
0
|
|
|
|
my $width = $options_r->{'width'} || 600; |
|
612
|
|
|
|
|
|
|
|
|
613
|
0
|
0
|
|
|
|
|
croak "opus can't be drawn because it takes no time" unless $opus_time; |
|
614
|
0
|
|
|
|
|
|
my $pixtix = $opus_time / $width; # Number of ticks a pixel represents |
|
615
|
|
|
|
|
|
|
|
|
616
|
0
|
|
|
|
|
|
my $im = GD::Image->new($width,127); |
|
617
|
|
|
|
|
|
|
# This doesn't handle pitch wheel, nor does it tread things on channel 10 |
|
618
|
|
|
|
|
|
|
# (percussion) as specially as it probably should. |
|
619
|
|
|
|
|
|
|
# The problem faced here is how to map onto pixel color all the |
|
620
|
|
|
|
|
|
|
# characteristics of a note (say, Channel, Note, Volume, and Patch). |
|
621
|
|
|
|
|
|
|
# I'll just do it for channels. Rewrite this on your own if you want |
|
622
|
|
|
|
|
|
|
# something different. |
|
623
|
|
|
|
|
|
|
|
|
624
|
0
|
0
|
|
|
|
|
my $bg_color = |
|
625
|
|
|
|
|
|
|
$im->colorAllocate(unpack('C3', pack('H2H2H2',unpack('a2a2a2', |
|
626
|
|
|
|
|
|
|
( length($options_r->{'bg_color'}) ? $options_r->{'bg_color'} |
|
627
|
|
|
|
|
|
|
: $MIDI::Opus::BG_color) |
|
628
|
|
|
|
|
|
|
))) ); |
|
629
|
0
|
0
|
|
|
|
|
@MIDI::Opus::Channel_colors = ( '00ffff' , '0000ff' ) |
|
630
|
|
|
|
|
|
|
unless @MIDI::Opus::Channel_colors; |
|
631
|
0
|
|
|
|
|
|
my @colors = |
|
632
|
|
|
|
|
|
|
map( $im->colorAllocate( |
|
633
|
|
|
|
|
|
|
unpack('C3', pack('H2H2H2',unpack('a2a2a2',$_))) |
|
634
|
|
|
|
|
|
|
), # convert 6-digit hex to a scalar tuple |
|
635
|
|
|
|
|
|
|
ref($options_r->{'channel_colors'}) ? |
|
636
|
0
|
0
|
|
|
|
|
@{$options_r->{'channel_colors'}} : @MIDI::Opus::Channel_colors |
|
637
|
|
|
|
|
|
|
); |
|
638
|
0
|
|
|
|
|
|
my $channels_in_palette = int(@colors / 2); |
|
639
|
0
|
|
|
|
|
|
$im->fill(0,0,$bg_color); |
|
640
|
0
|
|
|
|
|
|
foreach my $score_r (@scores) { |
|
641
|
0
|
|
|
|
|
|
foreach my $event_r (@$score_r) { |
|
642
|
0
|
0
|
|
|
|
|
next unless $event_r->[0] eq 'note'; |
|
643
|
0
|
|
|
|
|
|
my($time, $duration, $channel, $note, $volume) = @{$event_r}[1,2,3,4,5]; |
|
|
0
|
|
|
|
|
|
|
|
644
|
0
|
|
|
|
|
|
my $y = 127 - $note; |
|
645
|
0
|
|
|
|
|
|
my $start_x = $time / $pixtix; |
|
646
|
0
|
|
|
|
|
|
$im->line($start_x, $y, ($time + $duration) / $pixtix, $y, |
|
647
|
|
|
|
|
|
|
$colors[1 + ($channel % $channels_in_palette)] ); |
|
648
|
0
|
|
|
|
|
|
$im->setPixel($start_x , $y, $colors[$channel % $channels_in_palette] ); |
|
649
|
|
|
|
|
|
|
} |
|
650
|
|
|
|
|
|
|
} |
|
651
|
0
|
|
|
|
|
|
return $im; # Returns the GD object, which the user then dumps however |
|
652
|
|
|
|
|
|
|
} |
|
653
|
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
#-------------------------------------------------------------------------- |
|
655
|
|
|
|
|
|
|
{ # Closure so we can use this wonderful variable: |
|
656
|
|
|
|
|
|
|
my $GD_used = 0; |
|
657
|
|
|
|
|
|
|
sub use_GD { |
|
658
|
0
|
0
|
|
0
|
0
|
|
return if $GD_used; |
|
659
|
0
|
0
|
|
|
|
|
eval("use GD;"); croak "You don't seem to have GD installed." if $@; |
|
|
0
|
|
|
|
|
|
|
|
660
|
0
|
|
|
|
|
|
$GD_used = 1; return; |
|
|
0
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
} |
|
662
|
|
|
|
|
|
|
# Why use GD at runtime like this, instead of at compile-time like normal? |
|
663
|
|
|
|
|
|
|
# So we can still use everything in this module except &draw even if we |
|
664
|
|
|
|
|
|
|
# don't have GD on this system. |
|
665
|
|
|
|
|
|
|
} |
|
666
|
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
###################################################################### |
|
668
|
|
|
|
|
|
|
# This maps channel number onto colors for draw(). It is quite unimaginative, |
|
669
|
|
|
|
|
|
|
# and reuses colors two or three times. It's a package global. You can |
|
670
|
|
|
|
|
|
|
# change it by assigning to @MIDI::Simple::Channel_colors. |
|
671
|
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
@MIDI::Opus::Channel_colors = |
|
673
|
|
|
|
|
|
|
( |
|
674
|
|
|
|
|
|
|
'c0c0ff', '6060ff', # start / sustain color, channel 0 |
|
675
|
|
|
|
|
|
|
'c0ffc0', '60ff60', # start / sustain color, channel 1, etc... |
|
676
|
|
|
|
|
|
|
'ffc0c0', 'ff6060', 'ffc0ff', 'ff60ff', 'ffffc0', 'ffff60', |
|
677
|
|
|
|
|
|
|
'c0ffff', '60ffff', |
|
678
|
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
'c0c0ff', '6060ff', 'c0ffc0', '60ff60', 'ffc0c0', 'ff6060', |
|
680
|
|
|
|
|
|
|
'c0c0c0', '707070', # channel 10 |
|
681
|
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
'ffc0ff', 'ff60ff', 'ffffc0', 'ffff60', 'c0ffff', '60ffff', |
|
683
|
|
|
|
|
|
|
'c0c0ff', '6060ff', 'c0ffc0', '60ff60', 'ffc0c0', 'ff6060', |
|
684
|
|
|
|
|
|
|
); |
|
685
|
|
|
|
|
|
|
$MIDI::Opus::BG_color = '000000'; # Black goes with everything, you know. |
|
686
|
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
########################################################################### |
|
688
|
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
=back |
|
690
|
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
=head1 WHERE'S THE DESTRUCTOR? |
|
692
|
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
Because MIDI objects (whether opuses or tracks) do not contain any |
|
694
|
|
|
|
|
|
|
circular data structures, you don't need to explicitly destroy them in |
|
695
|
|
|
|
|
|
|
order to deallocate their memory. Consider this code snippet: |
|
696
|
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
use MIDI; |
|
698
|
|
|
|
|
|
|
foreach $one (@ARGV) { |
|
699
|
|
|
|
|
|
|
my $opus = MIDI::Opus->new({ 'from_file' => $one, 'no_parse' => 1 }); |
|
700
|
|
|
|
|
|
|
print "$one has ", scalar( $opus->tracks ) " tracks\n"; |
|
701
|
|
|
|
|
|
|
} |
|
702
|
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
At the end of each iteration of the foreach loop, the variable $opus |
|
704
|
|
|
|
|
|
|
goes away, along with its contents, a reference to the opus object. |
|
705
|
|
|
|
|
|
|
Since no other references to it exist (i.e., you didn't do anything like |
|
706
|
|
|
|
|
|
|
push(@All_opuses,$opus) where @All_opuses is a global), the object is |
|
707
|
|
|
|
|
|
|
automagically destroyed and its memory marked for recovery. |
|
708
|
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
If you wanted to explicitly free up the memory used by a given opus |
|
710
|
|
|
|
|
|
|
object (and its tracks, if those tracks aren't used anywhere else) without |
|
711
|
|
|
|
|
|
|
having to wait for it to pass out of scope, just replace it with a new |
|
712
|
|
|
|
|
|
|
empty object: |
|
713
|
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
$opus = MIDI::Opus->new; |
|
715
|
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
or replace it with anything at all -- or even just undef it: |
|
717
|
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
undef $opus; |
|
719
|
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
Of course, in the latter case, you can't then use $opus as an opus |
|
721
|
|
|
|
|
|
|
object anymore, since it isn't one. |
|
722
|
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
=head1 NOTE ON TICKS |
|
724
|
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
If you want to use "negative" values for ticks (so says the spec: "If |
|
726
|
|
|
|
|
|
|
division is negative, it represents the division of a second |
|
727
|
|
|
|
|
|
|
represented by the delta-times in the file,[...]"), then it's up to |
|
728
|
|
|
|
|
|
|
you to figure out how to represent that whole ball of wax so that when |
|
729
|
|
|
|
|
|
|
it gets C'd as an "n", it comes out right. I think it'll involve |
|
730
|
|
|
|
|
|
|
something like: |
|
731
|
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
$opus->ticks( (unpack('C', pack('c', -25)) << 8) & 80 ); |
|
733
|
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
for bit resolution (80) at 25 f/s. |
|
735
|
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
But I've never tested this. Let me know if you get it working right, |
|
737
|
|
|
|
|
|
|
OK? If anyone I get it working right, and tells me how, I'll |
|
738
|
|
|
|
|
|
|
try to support it natively. |
|
739
|
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
=head1 NOTE ON WARN-ING AND DIE-ING |
|
741
|
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
In the case of trying to parse a malformed MIDI file (which is not a |
|
743
|
|
|
|
|
|
|
common thing, in my experience), this module (or MIDI::Track or |
|
744
|
|
|
|
|
|
|
MIDI::Event) may warn() or die() (Actually, carp() or croak(), but |
|
745
|
|
|
|
|
|
|
it's all the same in the end). For this reason, you shouldn't use |
|
746
|
|
|
|
|
|
|
this suite in a case where the script, well, can't warn or die -- such |
|
747
|
|
|
|
|
|
|
as, for example, in a CGI that scans for text events in a uploaded |
|
748
|
|
|
|
|
|
|
MIDI file that may or may not be well-formed. If this I the kind |
|
749
|
|
|
|
|
|
|
of task you or someone you know may want to do, let me know and I'll |
|
750
|
|
|
|
|
|
|
consider some kind of 'no_die' parameter in future releases. |
|
751
|
|
|
|
|
|
|
(Or just trap the die in an eval { } around your call to anything you |
|
752
|
|
|
|
|
|
|
think you could die.) |
|
753
|
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=head1 COPYRIGHT |
|
755
|
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
Copyright (c) 1998-2002 Sean M. Burke. All rights reserved. |
|
757
|
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or |
|
759
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
|
760
|
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
=head1 AUTHORS |
|
762
|
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
Sean M. Burke C (until 2010) |
|
764
|
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
Darrell Conklin C (from 2010) |
|
766
|
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=cut |
|
768
|
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
1; |
|
770
|
|
|
|
|
|
|
__END__ |