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__ |