1/*
    2 * Prolog part of standard MIDI file reading library
    3 * Samer Abdallah (2009)
    4*/
    5	  
    6:- module(plsmf,
    7	[	smf_read/2		
    8	,	smf_description/2
    9	,	smf_duration/2
   10	,	smf_events/2
   11	,	smf_events_between/4
   12	,	is_smf/1	
   13	]).

Standard MIDI file reading

author
- Samer Abdallah */
   20:-	use_foreign_library(foreign(plsmf)).
 smf_read(+File:filename, -Ref:smf_blob) is semidet
Attempts to read standard MIDI file named File and sets Ref to an SMF blob atom which can be used to make further queries about the file.
 smf_duration(+Ref:smf_blob, -Dur:nonneg) is det
Returns the duration of the MIDI file in seconds.
 smf_description(+Ref:smf_blob, -Desc:atom) is det
Sets Desc to an atom containing descriptive text about the MIDI file, inluding the number of tracks and timing information.
 smf_events(+Ref:smf_blob, -Events:list(smf_event)) is det
Unifies Events with a list containing events in the MIDI file. Not all types of events are handled, but most are. Events are returned in a low-level numeric format containing the bytes in the original MIDI data. The first argument of the smf functor is always the time in seconds.

smf_event ---> smf( nonneg, byte) ; smf( nonneg, byte, byte) ; smf( nonneg, byte, byte, byte).

See also
- smf_events_between/4.
 smf_events_between(+Ref:smf_blob, +T1:nonneg, +T2:nonneg, -Events:list(smf_event)) is det
Unifies Events with a list containing events in the MIDI file between the given times T1 and T2. See smf_events/2 for more information about the format of the events list.
 is_smf(+Ref) is semidet
Determines whether or not Ref is a MIDI file BLOB as returned by smf_read/2.
   64/*
   65	MIDI derived event types:
   66
   67	midi(O,T,msg(A,B,C)) :- midi_send(O,A,B,C,T).
   68	midi(O,T,noteon(Ch,NN,V)) :- midi_send(O,144+Ch,NN,V,T).
   69	midi(O,T,noteoff(Ch,NN)) :- midi_send(O,128+Ch,NN,0,T).
   70	midi(O,T,prog(Ch,Prog)) :- midi_send(O,192+Ch,Prog,Prog,T).
   71	midi(O,T,prog(Ch,Prog,Bank)) :-
   72		MSB is Bank // 128,
   73		LSB is Bank mod 128,
   74		midi_send(O,176+Ch,0,MSB,T),
   75		midi_send(O,176+Ch,32,LSB,T),
   76		midi(O,T,prog(Ch,Prog)).
   77*/