diff cpack/dml/api/score.pl @ 0:718306e29690 tip

commiting public release

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cpack/dml/api/score.pl	Tue Feb 09 21:05:06 2016 +0100
@@ -0,0 +1,270 @@
+/* Part of DML (Digital Music Laboratory)
+	Copyright 2014-2015 Samer Abdallah, University of London
+	 
+	This program is free software; you can redistribute it and/or
+	modify it under the terms of the GNU General Public License
+	as published by the Free Software Foundation; either version 2
+	of the License, or (at your option) any later version.
+
+	This program is distributed in the hope that it will be useful,
+	but WITHOUT ANY WARRANTY; without even the implied warranty of
+	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+	GNU General Public License for more details.
+
+	You should have received a copy of the GNU General Public
+	License along with this library; if not, write to the Free Software
+	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+*/
+
+:- module(api_score, [get_link/3]).
+
+/** <module> Score related services and components
+*/
+:- use_module(library(thread_pool)).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_parameters)).
+:- use_module(library(fileutils)).
+:- use_module(library(swipe)).
+:- use_module(library(httpfiles)).
+:- use_module(library(humdrum_p2r)).
+
+:- set_prolog_flag(double_quotes,string).
+
+:- initialization 
+      current_thread_pool(sonify), !;
+      thread_pool_create(sonify, 20, [local(100), global(100), trail(100), backlog(100)]).
+
+user:term_expansion((:- file_setting(Name,Dir,Def,Desc)), (:- setting(Name,oneof(Files),Def1,Desc))) :-
+   absolute_file_name(Dir,Path,[file_type(directory),expand(true)]),
+   directory_files(Path,All),
+   exclude(dotfile,All,FilesUnsorted),
+   sort(FilesUnsorted,Files),
+   debug(score,'Found fluidsynth rc files: ~q',[All]),
+   (  member(Def,Files) -> Def1=Def
+   ;  member(default,Files) -> Def1=default
+   ;  member(Def1,Files)
+   ).
+
+dotfile(X) :- atom_concat('.',_,X).
+
+:- http_handler(api(score/render), score_render, []).
+:- http_handler(api(score/get), score_get, []).
+:- http_handler(api(score/sonify), score_sonify, [spawn(sonify),chunked]).
+
+:- setting(score:autobeam,boolean,true,"Use Lilypond autobeam when converting from XML").
+:- setting(score:default_width,number,170,"Default width of rendered score in mm").
+:- setting(score:reverse_spines,boolean,false,"Reverse order of spines when converting").
+:- setting(score:fluidsynth_sample_rate,number,44100,"Default Fluidsynth sample rate").
+:- setting(score:ogg_quality,between(-1,10),4,"Default oggenc quality").
+:- setting(score:mp3_lame_bitrate,oneof([96, 112, 128, 160, 192, 224, 256, 320]),128,"MP3 encoding bitrate").
+:- setting(score:hum2mid_tempo_scaling,number,1,"Tempo factor Humdrum to MIDI conversion").
+:- setting(score:soundfont_dir,string,"/usr/share/sounds/sf2","Soundfont directory").
+:- file_setting(score:fluidsynth_rc,dml(fluid),fluid_gm,"Fluidsynth initialisation file").
+
+
+%% score_get(+Request) is det.
+%
+%  Handler for obtaining a score in one of several languages.
+%
+%  The conversion relies on a number of executables, which must be available in the
+%  current PATH.
+%     *  mvspine (humdrum)
+%     *  hum2abc, hum2xml (humextra)
+%     *  musicxml2ly (lilypond)
+score_get(Request) :-
+   http_parameters(Request,
+      [ uri(URI,    [ optional(false), description("URI of score to render")])
+      , format(Fmt, [ optional(true), default(kern)
+                    , oneof([kern,mxml,abc,lily])
+                    , description("Output format") ])
+      % , transpose(Tr, [ optional(true), default('P1'), atom, description("Transposition interval") ])
+      ]),
+   reply_converted_stream(get(Fmt),URI,[]).
+
+
+%% score_sonify(+Request) is det.
+%
+%  Handler for obtaining a score as MIDI or audio.
+%  Conversion to MIDI is affected by the following settings:
+%  Conversion is affected by the following settings: 
+%     *  score:hum2mid_tempo_scaling
+%     *  score:fluidsynth_rc
+%        The name of fluidsynth initialisation file (in ~/etc/fluid)
+%     *  score:fluidsynth_sample_rate  
+%     *  score:ogg_quality
+%     *  score:mp3_lame_bitrate
+%
+%  The conversion relies on a number of executables, which must be available in the
+%  current PATH.
+%     *  mvspine (humdrum)
+%     *  hum2mid, hum2abc, hum2xml (humextra)
+%     *  oggenc (vorbis-tools)
+%     *  lame
+%     *  lilypond, musicxml2ly (lilypond)
+%     *  pdf2svg
+score_sonify(Request) :-
+   setting(score:hum2mid_tempo_scaling,Temp0),
+   setting(score:fluidsynth_rc,RC0),
+   (  member(range(Range),Request) 
+   -> debug(score,'Got sonify request for range: ~q',[Range])
+   ;  true
+   ),
+   http_parameters(Request,
+      [ uri(URI,    [ optional(false), description("URI of score")])
+      , format(Fmt, [ optional(false), default(ogg)
+                    , oneof([midi,ogg,mp3])
+                    , description("Output format") ])
+      , tempo(Tempo,[ optional(true), default(Temp0), number, description("Tempo adjust factor") ])
+      , fluidrc(RC, [ optional(true), default(RC0), atom, description("Fluidsynth intialisation") ])
+      , transpose(Tr, [ optional(true), default('P1'), atom, description("Transposition interval") ])
+      ]),
+   reply_converted_stream(sonify(Fmt,[tempo(Tempo),fluidrc(RC),transpose(Tr)]),URI,[]).
+   % (  uri_conversion_length(URI,sonify(Fmt,Tempo),Length)
+   % -> reply_converted_stream(sonify(Fmt,[tempo(Tempo),fluidrc(RC)]),URI,[length(Length),no_cache])
+   % ;  reply_converted_stream(sonify(Fmt,[tempo(Tempo),fluidrc(RC)]),URI,[length(Length),no_cache]),
+   %    assert(uri_conversion_length(URI,sonify(Fmt,Tempo),Length))
+   % ).
+
+
+%% score_render(+Request) is det.
+%
+%  Handler for score rendering web API. Takes a URI for a Humdrum score and a target
+%  graphical format, and uses Lilypond to layout and render musical notation.
+%  The layout parameter takes the following values:
+%     *  page
+%        Results in a multi-page document suitable for printing.
+%     *  snip
+%        Results in single, possibly very tall, image encapsulating the entire score.
+%
+%  The rendering is affected by a number of settings (all in the score namespace):
+%     *  autobeam
+%        Conversion to Lilypond goes via MusicXML and can use beaming information in the
+%        original score (autobeam=false), or Lilypond's own automatic beaming
+%        feature (autobeam=true).
+%     *  default_width
+%        Default value for width parameter. This affects the number of bars per line and
+%        hence the overall scaling of the rendered score.
+%     *  reverse_spines
+%        Humdrum scores maybe arranged with parts (spines) arranged by register from
+%        highest to lowest, or lowest to highest. If the latter, then it may help to 
+%        reverse the spines to obtain a score with the highest parts at the top.
+%
+%  Rendering requires serveral executable in addition to those required for conversion
+%  to a lilypond score:
+%     *  lilypond
+%     *  pdf2svg
+score_render(Request) :-
+   setting(score:default_width,DefWidth),
+   http_parameters(Request,
+      [ uri(URI,  [ optional(false), description("URI of score to render")])
+      , format(F, [ optional(true), default(svg), oneof([svg,pdf,png])
+                  , description("Output format") ]) 
+      , width(W,  [ optional(true), default(DefWidth), nonneg
+                  , description("Page width in mm") ])
+      , layout(L, [ optional(true), default(snip), oneof([snip,page])
+                  , description("Lilypond backend") ]) 
+      , transpose(Tr, [ optional(true), default('P1'), atom 
+                      , description("Transposition interval") ])
+      ]),
+   reply_score(render(F,W,L,[transpose(Tr)]),URI).
+
+reply_score(Conversion,URI) :-
+   hum_uri_path(URI,In),
+   debug(score,"reply_score: ~q",Conversion),
+   with_temp_dir(Dir,
+      (  run(in(Dir,convert(Conversion,In,Out,Type))),
+         absolute_file_name(Dir/Out,File),
+         reply_file(File,Type))).
+
+reply_converted_stream(Conversion,URI,Opts) :-
+   hum_uri_path(URI,In),
+   debug(score,"~q",reply_converted_stream(Conversion,URI,Opts)),
+   with_temp_dir(Dir,
+      with_pipe_output( S, [type(binary)],
+         in(Dir,convert(Conversion,In,Type)), 
+         reply_stream(S,Type,Opts))).
+
+% this should be in swipe...
+:- meta_predicate with_pipe_output(-,+,+,0).
+with_pipe_output(S, Opts, Spec, Goal) :-
+   command(Spec, 0>> $_, Cmd),
+   with_stream(S, open(pipe(Cmd), read, S, Opts), Goal).
+
+
+get_link(URI,s-Fmt,URL) :- http_link_to_id(score_get,[uri(URI),format(Fmt)],URL).
+get_link(URI,a-Fmt,URL) :- http_link_to_id(score_sonify,[uri(URI),format(Fmt)],URL).
+get_link(URI,a(Ps)-Fmt,URL) :- http_link_to_id(score_sonify,[uri(URI),format(Fmt)|Ps],URL).
+
+
+
+% ----- conversion pipelines -----------
+
+swipe:def(P,Q) :- def(P,Q).
+
+% get/1 conversion runs a pipeline into a file out in the
+% current directory.
+def( convert(get(F), In, out,F), In^kern :> humto(F,[]) >: out^F). 
+
+% conversions with piped output (but might create files in current directory)
+def( convert(get(F), In, F), In^kern :> humto(F,[])).
+def( convert(sonify(F,Opts), In, F), In^kern :> humto(F,Opts)).
+
+% render/3 conversion produces a file out.<F> in the current
+% directory where F is the requested format.
+def( convert(render(F,W,L,Opts),In,Out,F), In^kern :> humto(lily,Opts) >> adjust(W,L) >> render(F,L)):-
+   atom_concat('out.',F,Out).
+
+
+% these all read from In and output to stdout
+
+def( tomidi(Out,O),    hum2mid(TF,Out)) :- option(tempo(TF),O,1).
+
+def( humto(Fmt,O),  transpose(Interval) >> humto(Fmt,O1)) :- select_option(transpose(Interval),O,O1), Interval\='P1', !.
+def( humto(Fmt,O),  trans(Semis) >> humto(Fmt,O1)) :- select_option(trans(Semis),O,O1), Semis\=0, !.
+def( humto(kern,_), cat).
+def( humto(abc,_),  sh( $kern >> $abc, "~s",[dml(scripts/hum2abcp)+execute])).
+def( humto(lily,O), humto(mxml,O) >> xml2ly(B)) :- setting(score:autobeam,B).
+def( humto(mxml,_), Pipe) :-
+   (  setting(score:reverse_spines,true) 
+   -> Pipe = sh( $kern -> $kern, "mvspine -r") >> hum2xml
+   ;  Pipe = hum2xml
+   ).
+def( humto(midi,O), tomidi(Out,O) * sh($midi >> $midi, 'cat ~s',[@Out])).
+def( humto(ogg,O),  humto(raw(B,2,R),O) >> oggenc(B,R,Quality)) :- setting(score:ogg_quality,Quality).
+def( humto(mp3,O),  humto(raw(B,2,R),O) >> lame(B,R,BR)) :- setting(score:mp3_lame_bitrate,BR).
+def( humto(raw(16,2,Rate),O), tomidi(Out,O) * midi2raw(Out,RC,Rate,s16)) :- 
+   setting(score:fluidsynth_sample_rate,Rate),
+   setting(score:fluidsynth_rc,RC0),
+   option(fluidrc(RC),O,RC0).
+
+def( hum2mid(TF,Out),   sh( $kern >> 0, "hum2mid --mv 1 --hv 1 -t ~f -o ~s", [\TF,@Out])) :- Out="out.mid".
+def( midi2raw(In,RC,Rate,Fmt), 
+     sh( 0>> $audio(raw), 
+         "~s ~w ~s ~f ~w ~s", 
+         [ dml(scripts/midi2snd)+execute, @In, dml(fluid/RC)+read, \Rate, \Fmt, @AbsSFDir])) :-
+   setting(score:soundfont_dir,SFDir),
+   absolute_file_name(SFDir,AbsSFDir,[file_type(directory),expand(true)]). 
+
+def( oggenc(Q), sh( $audio(F) >> $audio(ogg), "oggenc -Q -q ~d -", [\Q])) :- member(F,[wav,aiff,flac]).
+def( oggenc(B,R,Q),sh( $audio(raw) >> $audio(mp3), "oggenc -Q -r -B~d -C2 -R~d -q~d -", [\B,\R,\Q])).
+def( lame(B,R,BR), sh( $audio(raw) >> $audio(mp3), Fmt, [\B,\K,\BR])) :-
+   Fmt="lame -h -r --bitwidth ~d -s ~f -b ~d - -",
+   K is R/1000. 
+
+% these all process stdin to stdout
+def( adjust(W,L),   sh( 0 >> $lily, "~s ~d\\\\mm",[dml(scripts/L)+execute,\W])*cat).
+def( xml2ly(true),  sh( $mxml >> $lily, "musicxml2ly --no-beaming -")).
+def( xml2ly(false), sh( $mxml >> $lily, "musicxml2ly -")).
+def( hum2xml,       sh( $kern >> $mxml, "hum2xml")).
+def( transpose(I),  sh( $kern >> $kern, "transpose -t ~s",[\I])).
+def( trans(N),      sh( $kern >> $kern, "trans -d 0 -c ~d",[\N])).
+
+% these all read stdin and produce a file called out.<Fmt>
+def( render(svg,snip), lilypond(eps,pdf) * sh(0>>0,"pdf2svg out.pdf out.svg")) :- !.
+def( render(svg,page), lilypond(svg,svg)) :- !.
+def( render(Fmt,Layout), lilypond(BE,Fmt)) :-
+   member(Layout/BE,[page/ps,snip/eps]).
+
+% lilypond produces out.<F> where F is in {pdf,svg,png}
+def( lilypond(B,F), sh($lily>>0, "lilypond -dsafe -dbackend=~w -f~w -o out -",[\B,\F])).
+