Daniel@0: /* Part of DML (Digital Music Laboratory) Daniel@0: Copyright 2014-2015 Samer Abdallah, University of London Daniel@0: Daniel@0: This program is free software; you can redistribute it and/or Daniel@0: modify it under the terms of the GNU General Public License Daniel@0: as published by the Free Software Foundation; either version 2 Daniel@0: of the License, or (at your option) any later version. Daniel@0: Daniel@0: This program is distributed in the hope that it will be useful, Daniel@0: but WITHOUT ANY WARRANTY; without even the implied warranty of Daniel@0: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the Daniel@0: GNU General Public License for more details. Daniel@0: Daniel@0: You should have received a copy of the GNU General Public Daniel@0: License along with this library; if not, write to the Free Software Daniel@0: Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Daniel@0: */ Daniel@0: Daniel@0: :- module(api_transcription, [transcription_link/3]). Daniel@0: Daniel@0: /** Score related services and components Daniel@0: */ Daniel@0: :- use_module(library(http/http_dispatch)). Daniel@0: :- use_module(library(http/http_parameters)). Daniel@0: :- use_module(library(fileutils), [with_temp_dir/2, with_stream/3]). Daniel@0: :- use_module(library(dcg_core), [seqmap//2]). Daniel@0: :- use_module(library(httpfiles), [reply_stream/3]). Daniel@0: :- use_module(library(csvutils), [uri_to_csv/2]). Daniel@0: :- use_module(library(computations)). Daniel@0: :- use_module(library(plsmf)). Daniel@0: :- use_module(library(swipe)). Daniel@0: :- use_module(api(score)). % needed for pipelines Daniel@0: Daniel@0: :- set_prolog_flag(double_quotes,string). Daniel@0: Daniel@0: :- http_handler(api(transcription/sonify), transcription_sonify, [chunked]). Daniel@0: Daniel@0: :- dynamic uri_conversion_length/3. Daniel@0: Daniel@0: %% transcription_sonify(+Request) is det. Daniel@0: % Daniel@0: % Handler for obtaining a score as MIDI or audio. Daniel@0: % Conversion to MIDI is affected by the following settings: Daniel@0: % Conversion is affected by the following settings: Daniel@0: % * score:hum2mid_tempo_scaling Daniel@0: % * score:fluidsynth_rc Daniel@0: % The name of fluidsynth initialisation file (in ~/etc/fluid) Daniel@0: % * score:fluidsynth_sample_rate Daniel@0: % * score:ogg_quality Daniel@0: % * score:mp3_lame_bitrate Daniel@0: % Daniel@0: % The conversion relies on a number of executables, which must be available in the Daniel@0: % current PATH. Daniel@0: % * oggenc (vorbis-tools) Daniel@0: % * lame Daniel@0: transcription_sonify(Request) :- Daniel@0: setting(score:fluidsynth_rc,RC0), Daniel@0: http_parameters(Request, Daniel@0: [ uri(URI, [ optional(false), description("URI of transcription")]) Daniel@0: , format(Fmt, [ optional(false), default(ogg) Daniel@0: , oneof([midi,ogg,mp3]) Daniel@0: , description("Output format") ]) Daniel@0: , tempo(Tempo,[ optional(true), default(1), number, description("Tempo adjust factor") ]) Daniel@0: , fluidrc(RC, [ optional(true), default(RC0), atom, description("Fluidsynth intialisation") ]) Daniel@0: ]), Daniel@0: debug(transcription,'Sonify transcription ~w as ~w',[URI,Fmt]), Daniel@0: Daniel@0: % uri_conversion_length(URI,sonify(Fmt,Tempo),Length) Daniel@0: reply_sonfied_transcription(URI,Fmt,Tempo,RC,[]). Daniel@0: Daniel@0: reply_sonfied_transcription(URI,Fmt,Tempo,RC,Opts) :- Daniel@0: insist(uri_to_csv(URI,Rows)), Daniel@0: insist(once(( transcription_class(URI,Class), Daniel@0: seqmap(row_event(Class,Tempo),Rows,Events,[])))), Daniel@0: Daniel@0: with_temp_dir(Dir, Daniel@0: ( directory_file_path(Dir,'tmp.mid',MidiFile), Daniel@0: events_to_midi_file(Events,MidiFile), Daniel@0: with_pipe_output( S, [type(binary)], Daniel@0: in(Dir,sonify_events(Fmt,MidiFile,[fluidrc(RC)])), Daniel@0: reply_stream(S,Fmt,Opts)))). Daniel@0: Daniel@0: % this should be in swipe... Daniel@0: :- meta_predicate with_pipe_output(-,+,+,0). Daniel@0: with_pipe_output(S, Opts, Spec, Goal) :- Daniel@0: command(Spec, 0>> $_, Cmd), Daniel@0: with_stream(S, open(pipe(Cmd), read, S, Opts), Goal). Daniel@0: Daniel@0: Daniel@0: transcription_class(URI,Class) :- Daniel@0: rdf(Comp,dml:'comp/output',URI), Daniel@0: rdf(Comp,dml:'comp/function',Fn), Daniel@0: % rdf(Fn,vamp:plugin,Plugin), Daniel@0: computations:transform(Class,Fn). Daniel@0: Daniel@0: transcription_link(URI,a(Ps)-Fmt,URL) :- http_link_to_id(transcription_sonify,[uri(URI),format(Fmt)|Ps],URL). Daniel@0: transcription_link(URI,a-Fmt,URL) :- transcription_link(URI,a([])-Fmt,URL). Daniel@0: Daniel@0: events_to_midi_file(Events,File) :- Daniel@0: debug(transcription,'Writing events to ~w',[File]), Daniel@0: smf_new(SMF), Daniel@0: smf_add_events(SMF,Events), Daniel@0: smf_write(SMF,File). Daniel@0: Daniel@0: row_event(transcription,Tempo,row(Time,Dur,Freq,Vel,'')) --> !, Daniel@0: { freq_note_number(Freq,NN), T0 is Time/Tempo, T1 is (Time+Dur)/Tempo }, Daniel@0: [ smf(T0,144,NN,Vel), smf(T1,128,NN,0) ]. Daniel@0: Daniel@0: row_event(transcription,Tempo,row(Time,Dur,_,Vel,Pitch)) --> Daniel@0: { remove_cents(Pitch,Pitch1) }, Daniel@0: { pitch_name_number(Pitch1,NN), T0 is Time/Tempo, T1 is (Time+Dur)/Tempo }, Daniel@0: [ smf(T0,144,NN,Vel), smf(T1,128,NN,0) ]. Daniel@0: Daniel@0: row_event(chord_notes,Tempo,row(Time,Dur,NN)) --> Daniel@0: { T0 is Time/Tempo, T1 is (Time+Dur)/Tempo }, Daniel@0: [ smf(T0,144,NN,64), smf(T1,128,NN,0) ]. Daniel@0: Daniel@0: Daniel@0: % ----- conversion pipelines ----------- Daniel@0: Daniel@0: swipe:def(P,Q) :- def(P,Q). Daniel@0: Daniel@0: % these all read from In and output to stdout Daniel@0: Daniel@0: def( sonify_events(midi,In,_), cat(In^midi)). Daniel@0: def( sonify_events(ogg,In,O), sonify_events(raw(B,2,R),In,O) >> oggenc(B,R,Quality)) :- setting(score:ogg_quality,Quality). Daniel@0: def( sonify_events(mp3,In,O), sonify_events(raw(B,2,R),In,O) >> lame(B,R,BR)) :- setting(score:mp3_lame_bitrate,BR). Daniel@0: def( sonify_events(raw(16,2,Rate),In,O), midi2raw(In,RC,Rate,s16)) :- Daniel@0: setting(score:fluidsynth_sample_rate,Rate), Daniel@0: setting(score:fluidsynth_rc,RC0), Daniel@0: option(fluidrc(RC),O,RC0). Daniel@0: Daniel@0: remove_cents(P1,P2) :- sub_atom(P1,Bef,_,_,'-'), !, sub_atom(P1,0,Bef,_,P2). Daniel@0: remove_cents(P1,P2) :- sub_atom(P1,Bef,_,_,'+'), !, sub_atom(P1,0,Bef,_,P2). Daniel@0: remove_cents(P1,P1). Daniel@0: