-module(midifile). -export([read/1, write/2]). -author("Jim Menard, jim@jimmenard.com"). -include("include/midi.hrl"). %% This module reads and writes MIDI files. %-define(DEBUG, true). -ifdef(DEBUG). -define(DPRINT(X, Y), io:format(X, Y)). -else. -define(DPRINT(X, Y), void). -endif. %% Returns %% {seq, {header...}, ConductorTrack, ListOfTracks} %% header is {header, Format, Division} %% ConductorTrack is the first track of a format 1 MIDI file %% each track including the conductor track is %% {track, ListOfEvents} %% each event is %% {event_name, DeltaTime, [values...]} %% where values after DeltaTime are specific to each event type. If the value %% is a string, then the string appears instead of [values...]. read(Path) -> case file:open(Path, [read, binary, raw]) of {ok, F} -> FilePos = look_for_chunk(F, 0, <<$M, $T, $h, $d>>, file:pread(F, 0, 4)), [Header, NumTracks] = parse_header(file:pread(F, FilePos, 10)), Tracks = read_tracks(F, NumTracks, FilePos + 10, []), file:close(F), [ConductorTrack | RemainingTracks] = Tracks, {seq, Header, ConductorTrack, RemainingTracks}; Error -> {Path, Error} end. % Look for Cookie in file and return file position after Cookie. look_for_chunk(_F, FilePos, Cookie, {ok, Cookie}) -> FilePos + size(Cookie); look_for_chunk(F, FilePos, Cookie, {ok, _}) -> % This isn't efficient, because we only advance one character at a time. % We should really look for the first char in Cookie and, if found, % advance that far. look_for_chunk(F, FilePos + 1, Cookie, file:pread(F, FilePos + 1, size(Cookie))). parse_header({ok, <<_BytesToRead:32/integer, Format:16/integer, NumTracks:16/integer, Division:16/integer>>}) -> [{header, Format, Division}, NumTracks]. read_tracks(_F, 0, _FilePos, Tracks) -> lists:reverse(Tracks); % TODO: make this distributed. Would need to scan each track to get start % position of next track. read_tracks(F, NumTracks, FilePos, Tracks) -> ?DPRINT("read_tracks, NumTracks = ~p, FilePos = ~p~n", [NumTracks, FilePos]), [Track, NextTrackFilePos] = read_track(F, FilePos), ?DPRINT("read_tracks, NextTrackFilePos = ~p~n", [NextTrackFilePos]), read_tracks(F, NumTracks - 1, NextTrackFilePos, [Track|Tracks]). read_track(F, FilePos) -> TrackStart = look_for_chunk(F, FilePos, <<$M, $T, $r, $k>>, file:pread(F, FilePos, 4)), BytesToRead = parse_track_header(file:pread(F, TrackStart, 4)), ?DPRINT("reading track, FilePos = ~p, BytesToRead = ~p~n", [TrackStart, BytesToRead]), ?DPRINT("next track pos = ~p~n", [TrackStart + 4 + BytesToRead]), put(status, 0), put(chan, -1), [{track, event_list(F, TrackStart + 4, BytesToRead, [])}, TrackStart + 4 + BytesToRead]. parse_track_header({ok, <>}) -> BytesToRead. event_list(_F, _FilePos, 0, Events) -> lists:reverse(Events); event_list(F, FilePos, BytesToRead, Events) -> [DeltaTime, VarLenBytesUsed] = read_var_len(file:pread(F, FilePos, 4)), {ok, ThreeBytes} = file:pread(F, FilePos+VarLenBytesUsed, 3), ?DPRINT("reading event, FilePos = ~p, BytesToRead = ~p, ThreeBytes = ~p~n", [FilePos, BytesToRead, ThreeBytes]), [Event, EventBytesRead] = read_event(F, FilePos+VarLenBytesUsed, DeltaTime, ThreeBytes), BytesRead = VarLenBytesUsed + EventBytesRead, event_list(F, FilePos + BytesRead, BytesToRead - BytesRead, [Event|Events]). read_event(_F, _FilePos, DeltaTime, <>) -> ?DPRINT("off~n", []), put(status, ?STATUS_NIBBLE_OFF), put(chan, Chan), [{off, DeltaTime, [Chan, Note, Vel]}, 3]; % note on, velocity 0 is a note off read_event(_F, _FilePos, DeltaTime, <>) -> ?DPRINT("off (using on vel 0)~n", []), put(status, ?STATUS_NIBBLE_ON), put(chan, Chan), [{off, DeltaTime, [Chan, Note, 64]}, 3]; read_event(_F, _FilePos, DeltaTime, <>) -> ?DPRINT("on~n", []), put(status, ?STATUS_NIBBLE_ON), put(chan, Chan), [{on, DeltaTime, [Chan, Note, Vel]}, 3]; read_event(_F, _FilePos, DeltaTime, <>) -> ?DPRINT("poly press~n", []), put(status, ?STATUS_NIBBLE_POLY_PRESS), put(chan, Chan), [{poly_press, DeltaTime, [Chan, Note, Amount]}, 3]; read_event(_F, _FilePos, DeltaTime, <>) -> ?DPRINT("controller ch ~p, ctrl ~p, val ~p~n", [Chan, Controller, Value]), put(status, ?STATUS_NIBBLE_CONTROLLER), put(chan, Chan), [{controller, DeltaTime, [Chan, Controller, Value]}, 3]; read_event(_F, _FilePos, DeltaTime, <>) -> ?DPRINT("prog change~n", []), put(status, ?STATUS_NIBBLE_PROGRAM_CHANGE), put(chan, Chan), [{program, DeltaTime, [Chan, Program]}, 2]; read_event(_F, _FilePos, DeltaTime, <>) -> ?DPRINT("chan pressure~n", []), put(status, ?STATUS_NIBBLE_CHANNEL_PRESSURE), put(chan, Chan), [{chan_press, DeltaTime, [Chan, Amount]}, 2]; read_event(_F, _FilePos, DeltaTime, <>) -> ?DPRINT("pitch bend~n", []), put(status, ?STATUS_NIBBLE_PITCH_BEND), put(chan, Chan), [{pitch_bend, DeltaTime, [Chan, <<0:2, MSB:7, LSB:7>>]}, 3]; read_event(_F, _FilePos, DeltaTime, <>) -> ?DPRINT("end of track~n", []), put(status, ?STATUS_META_EVENT), put(chan, 0), [{track_end, DeltaTime, []}, 3]; read_event(F, FilePos, DeltaTime, <>) -> ?DPRINT("meta event~n", []), put(status, ?STATUS_META_EVENT), put(chan, 0), [Length, LengthBytesUsed] = read_var_len(file:pread(F, FilePos + 2, 4)), LengthBeforeData = LengthBytesUsed + 2, {ok, Data} = file:pread(F, FilePos + LengthBeforeData, Length), TotalLength = LengthBeforeData + Length, ?DPRINT(" type = ~p, var len = ~p, len before data = ~p, total len = ~p,~n data = ~p~n", [Type, Length, LengthBeforeData, TotalLength, Data]), case Type of ?META_SEQ_NUM -> [{seq_num, DeltaTime, [Data]}, TotalLength]; ?META_TEXT -> [{text, DeltaTime, binary_to_list(Data)}, TotalLength]; ?META_COPYRIGHT -> [{copyright, DeltaTime, binary_to_list(Data)}, TotalLength]; ?META_SEQ_NAME -> [{seq_name, DeltaTime, binary_to_list(Data)}, TotalLength]; ?META_INSTRUMENT -> [{instrument, DeltaTime, binary_to_list(Data)}, TotalLength]; ?META_LYRIC -> [{lyric, DeltaTime, binary_to_list(Data)}, TotalLength]; ?META_MARKER -> [{marker, DeltaTime, binary_to_list(Data)}, TotalLength]; ?META_CUE -> [{cue, DeltaTime, binary_to_list(Data)}, TotalLength]; ?META_MIDI_CHAN_PREFIX -> [{midi_chan_prefix, DeltaTime, [Data]}, TotalLength]; ?META_SET_TEMPO -> % Data is microseconds per quarter note, in three bytes <> = Data, [{tempo, DeltaTime, [(B0 bsl 16) + (B1 bsl 8) + B2]}, TotalLength]; ?META_SMPTE -> [{smpte, DeltaTime, [Data]}, TotalLength]; ?META_TIME_SIG -> [{time_signature, DeltaTime, [Data]}, TotalLength]; ?META_KEY_SIG -> [{key_signature, DeltaTime, [Data]}, TotalLength]; ?META_SEQUENCER_SPECIFIC -> [{seq_name, DeltaTime, [Data]}, TotalLength]; _ -> ?DPRINT(" unknown meta type ~p~n", [Type]), [{unknown_meta, DeltaTime, [Type, Data]}, TotalLength] end; read_event(F, FilePos, DeltaTime, <>) -> ?DPRINT("sysex~n", []), put(status, ?STATUS_SYSEX), put(chan, 0), [Length, LengthBytesUsed] = read_var_len(file:pread(F, FilePos + 1, 4)), {ok, Data} = file:pread(F, FilePos + LengthBytesUsed, Length), [{sysex, DeltaTime, [Data]}, LengthBytesUsed + Length]; % Handle running status bytes read_event(F, FilePos, DeltaTime, <>) when B0 < 128 -> Status = get(status), Chan = get(chan), ?DPRINT("running status byte, status = ~p, chan = ~p~n", [Status, Chan]), [Event, NumBytes] = read_event(F, FilePos, DeltaTime, <>), [Event, NumBytes - 1]; read_event(_F, _FilePos, DeltaTime, <>) -> ?DPRINT("unknown byte ~p~n", [Unknown]), put(status, 0), put(chan, 0), % exit("Unknown status byte " ++ Unknown). [{unknown_status, DeltaTime, [Unknown]}, 3]. read_var_len({ok, <<0:1, B0:7, _:24>>}) -> [B0, 1]; read_var_len({ok, <<1:1, B0:7, 0:1, B1:7, _:16>>}) -> [(B0 bsl 7) + B1, 2]; read_var_len({ok, <<1:1, B0:7, 1:1, B1:7, 0:1, B2:7, _:8>>}) -> [(B0 bsl 14) + (B1 bsl 7) + B2, 3]; read_var_len({ok, <<1:1, B0:7, 1:1, B1:7, 1:1, B2:7, 0:1, B3:7>>}) -> [(B0 bsl 21) + (B1 bsl 14) + (B2 bsl 7) + B3, 4]; read_var_len({ok, <<1:1, B0:7, 1:1, B1:7, 1:1, B2:7, 1:1, B3:7>>}) -> ?DPRINT("WARNING: bad var len format; all 4 bytes have high bit set~n", []), [(B0 bsl 21) + (B1 bsl 14) + (B2 bsl 7) + B3, 4]. -ifdef(DEBUG). rvl(<<0:1, B0:7>>) -> read_var_len({ok, <<0:1, B0:7, 0:8, 0:8, 0:8>>}); rvl(<<1:1, B0:7, 0:1, B1:7>>) -> read_var_len({ok, <<1:1, B0:7, 0:1, B1:7, 0:8, 0:8>>}); rvl(<<1:1, B0:7, 1:1, B1:7, 0:1, B2:7>>) -> read_var_len({ok, <<1:1, B0:7, 1:1, B1:7, 0:1, B2:7, 0:8>>}); rvl(<<1:1, B0:7, 1:1, B1:7, 1:1, B2:7, 0:1, B3:7>>) -> read_var_len({ok, <<1:1, B0:7, 1:1, B1:7, 1:1, B2:7, 0:1, B3:7>>}). -endif. write({seq, Header, ConductorTrack, Tracks}, Path) -> L = [header_io_list(Header, length(Tracks) + 1) | lists:map(fun(T) -> track_io_list(T) end, [ConductorTrack | Tracks])], ok = file:write_file(Path, L). header_io_list(Header, NumTracks) -> {header, _, Division} = Header, ["MThd", 0, 0, 0, 6, % header chunk size 0, 1, % format, (NumTracks bsr 8) band 255, % num tracks NumTracks band 255, (Division bsr 8) band 255, % division Division band 255]. track_io_list(Track) -> {track, Events} = Track, put(status, 0), put(chan, 0), EventList = lists:map(fun(E) -> event_io_list(E) end, Events), ChunkSize = chunk_size(EventList), ["MTrk", (ChunkSize bsr 24) band 255, (ChunkSize bsr 16) band 255, (ChunkSize bsr 8) band 255, ChunkSize band 255, EventList]. % Return byte size of L, which is an IO list that contains lists, bytes, and % binaries. chunk_size(L) -> lists:foldl(fun(E, Acc) -> Acc + io_list_element_size(E) end, 0, lists:flatten(L)). io_list_element_size(E) when is_binary(E) -> size(E); io_list_element_size(_E) -> 1. event_io_list({off, DeltaTime, [Chan, Note, Vel]}) -> RunningStatus = get(status), RunningChan = get(chan), if RunningChan =:= Chan, (RunningStatus =:= ?STATUS_NIBBLE_OFF orelse (RunningStatus =:= ?STATUS_NIBBLE_ON andalso Vel =:= 64)) -> Status = [], OutVel = 0; true -> Status = (?STATUS_NIBBLE_OFF bsl 4) + Chan, OutVel = Vel, put(status, ?STATUS_NIBBLE_OFF), put(chan, Chan) end, [var_len(DeltaTime), Status, Note, OutVel]; event_io_list({on, DeltaTime, [Chan, Note, Vel]}) -> [var_len(DeltaTime), running_status(?STATUS_NIBBLE_ON, Chan), Note, Vel]; event_io_list({poly_press, DeltaTime, [Chan, Note, Amount]}) -> [var_len(DeltaTime), running_status(?STATUS_NIBBLE_POLY_PRESS, Chan), Note, Amount]; event_io_list({controller, DeltaTime, [Chan, Controller, Value]}) -> [var_len(DeltaTime), running_status(?STATUS_NIBBLE_CONTROLLER, Chan), Controller, Value]; event_io_list({program, DeltaTime, [Chan, Program]}) -> [var_len(DeltaTime), running_status(?STATUS_NIBBLE_PROGRAM_CHANGE, Chan), Program]; event_io_list({chan_press, DeltaTime, [Chan, Amount]}) -> [var_len(DeltaTime), running_status(?STATUS_NIBBLE_CHANNEL_PRESSURE, Chan), Amount]; event_io_list({pitch_bend, DeltaTime, [Chan, <<0:2, MSB:7, LSB:7>>]}) -> [var_len(DeltaTime), running_status(?STATUS_NIBBLE_PITCH_BEND, Chan), <<0:1, LSB:7, 0:1, MSB:7>>]; event_io_list({track_end, DeltaTime}) -> ?DPRINT("track_end~n", []), put(status, ?STATUS_META_EVENT), [var_len(DeltaTime), ?STATUS_META_EVENT, ?META_TRACK_END, 0]; event_io_list({seq_num, DeltaTime, [Data]}) -> meta_io_list(DeltaTime, ?META_SEQ_NUM, Data); event_io_list({text, DeltaTime, Data}) -> meta_io_list(DeltaTime, ?META_TEXT, Data); event_io_list({copyright, DeltaTime, Data}) -> meta_io_list(DeltaTime, ?META_COPYRIGHT, Data); event_io_list({seq_name, DeltaTime, Data}) -> put(status, ?STATUS_META_EVENT), meta_io_list(DeltaTime, ?META_TRACK_END, Data); event_io_list({instrument, DeltaTime, Data}) -> meta_io_list(DeltaTime, ?META_INSTRUMENT, Data); event_io_list({lyric, DeltaTime, Data}) -> meta_io_list(DeltaTime, ?META_LYRIC, Data); event_io_list({marker, DeltaTime, Data}) -> meta_io_list(DeltaTime, ?META_MARKER, Data); event_io_list({cue, DeltaTime, Data}) -> meta_io_list(DeltaTime, ?META_CUE, Data); event_io_list({midi_chan_prefix, DeltaTime, [Data]}) -> meta_io_list(DeltaTime, ?META_MIDI_CHAN_PREFIX, Data); event_io_list({tempo, DeltaTime, [Data]}) -> ?DPRINT("tempo, data = ~p~n", [Data]), put(status, ?STATUS_META_EVENT), [var_len(DeltaTime), ?STATUS_META_EVENT, ?META_SET_TEMPO, var_len(3), (Data bsr 16) band 255, (Data bsr 8) band 255, Data band 255]; event_io_list({smpte, DeltaTime, [Data]}) -> meta_io_list(DeltaTime, ?META_SMPTE, Data); event_io_list({time_signature, DeltaTime, [Data]}) -> meta_io_list(DeltaTime, ?META_TIME_SIG, Data); event_io_list({key_signature, DeltaTime, [Data]}) -> meta_io_list(DeltaTime, ?META_KEY_SIG, Data); event_io_list({sequencer_specific, DeltaTime, [Data]}) -> meta_io_list(DeltaTime, ?META_SEQUENCER_SPECIFIC, Data); event_io_list({unknown_meta, DeltaTime, [Type, Data]}) -> meta_io_list(DeltaTime, Type, Data). meta_io_list(DeltaTime, Type, Data) when is_binary(Data) -> ?DPRINT("meta_io_list (bin) type = ~p, data = ~p~n", [Type, Data]), put(status, ?STATUS_META_EVENT), [var_len(DeltaTime), ?STATUS_META_EVENT, Type, var_len(size(Data)), Data]; meta_io_list(DeltaTime, Type, Data) -> ?DPRINT("meta_io_list type = ~p, data = ~p~n", [Type, Data]), put(status, ?STATUS_META_EVENT), [var_len(DeltaTime), ?STATUS_META_EVENT, Type, var_len(length(Data)), Data]. running_status(HighNibble, Chan) -> RunningStatus = get(status), RunningChan = get(chan), if RunningStatus =:= HighNibble, RunningChan =:= Chan -> ?DPRINT("running status: stat = ~p, rchan = ~p~n", [RunningStatus, RunningChan]), []; true -> put(status, HighNibble), put(chan, Chan), (HighNibble bsl 4) + Chan end. var_len(I) when I < (1 bsl 7) -> <<0:1, I:7>>; var_len(I) when I < (1 bsl 14) -> <<1:1, (I bsr 7):7, 0:1, I:7>>; var_len(I) when I < (1 bsl 21) -> <<1:1, (I bsr 14):7, 1:1, (I bsr 7):7, 0:1, I:7>>; var_len(I) when I < (1 bsl 28) -> <<1:1, (I bsr 21):7, 1:1, (I bsr 14):7, 1:1, (I bsr 7):7, 0:1, I:7>>; var_len(I) -> exit("Value " ++ I ++ " is too big for a variable length number").