comparison cpack/dml/components/audio.pl @ 0:718306e29690 tip

commiting public release
author Daniel Wolff
date Tue, 09 Feb 2016 21:05:06 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:718306e29690
1 /* Part of DML (Digital Music Laboratory)
2 Copyright 2014-2015 Samer Abdallah, University of London
3
4 This program is free software; you can redistribute it and/or
5 modify it under the terms of the GNU General Public License
6 as published by the Free Software Foundation; either version 2
7 of the License, or (at your option) any later version.
8
9 This program is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 GNU General Public License for more details.
13
14 You should have received a copy of the GNU General Public
15 License along with this library; if not, write to the Free Software
16 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
17 */
18
19 :- module(cp_audio,
20 [ audio_player//1
21 , audio_player//2
22 , audio_decoration//3
23 , spectrogram//2
24 , audio_link/3
25 , audio_file/3
26 , audio_playlist//2
27 , finder_player/2
28 , finder_player/3
29 ]).
30
31 :- use_module(library(http/http_dispatch)).
32 :- use_module(library(http/http_path)).
33 :- use_module(library(http/html_write)).
34 :- use_module(library(http/html_head)).
35 :- use_module(library(http/js_write)).
36 :- use_module(library(semweb/rdf_db)).
37 :- use_module(library(semweb/rdf_label),[rdf_label/2]).
38 :- use_module(library(dcg_core)).
39 :- use_module(library(httpfiles)).
40 :- use_module(library(optutils)).
41 :- use_module(components(icons)).
42
43 :- multifile audio_link/3, audio_file/3.
44 :- rdf_meta audio_link(r,-,-).
45
46 :- html_resource(js('add_dummy_iframe.js'), [requires(jquery)]).
47
48
49 %% audio_decoration(+Type:oneof([none,link,player]), +Links:list(pair(url,maybe(filetype))), +Content:phrase) is det.
50 %
51 % Emits the HTML content specified by Content, but optionally decorated with controls
52 % that allow any associated audio to be played. Links is a list of pairs of links to audio
53 % content with an optional filetype, where a filetype is a standard audiofile extension like
54 % mp3, ogg, wav etc.
55 audio_decoration(none,_,Link) --> phrase(Link).
56
57 audio_decoration(link,[URL|_],Link) -->
58 html_requires(font_awesome),
59 html_requires(js('add_dummy_iframe.js')),
60 html(span( [ a([href(URL),target(dummy)],\icon(play))
61 , &(nbsp), a([href('about:blank'),target(dummy)],\icon(stop))
62 , &(ensp), \Link
63 ])).
64
65 audio_decoration(player,URLS,Link) -->
66 html(span(style="display:inline-block;width=auto",
67 [ div(\audio_player(URLS)), div(\Link) ])).
68
69 audio_player(Links) --> audio_player(Links,[]).
70 audio_player(Links,Attribs) -->
71 html(audio([ controls, preload=none | Attribs ],
72 [ \seqmap(audio_source,Links),
73 "Your browser does not support HTML5 audio." ])).
74
75 audio_playlist(ID,Links) -->
76 % html_requires(js('playlist.js')),
77 {http_absolute_location(js('playlist.js'),PlaylistJS,[])},
78 {Links=[item(Src1,_,_)|_]},
79 html( div(class(playlist),
80 [ style([ 'div.playlist ul {list-style-type:none; margin:0px;padding:0px;height:10em;overflow:auto }'
81 , 'div.playlist li div {display:block}'
82 , 'div.playlist li div a {color:#ccc;text-decoration:none;overflow-x:hidden}'
83 , 'div.playlist li div a:hover {color:white}'
84 , 'div.playlist li.active {color:black;background-color:#eee}'
85 , 'div.playlist li.active div a {color:black}'
86 , 'div.playlist {padding:1ex;background-color:#222;width:400px;border-radius:1ex}'
87 ])
88 , audio([ id('~w-audio'-[ID]), controls, preload=none ],
89 [ source([src=Src1],[]), "Your browser does not support HTML5 audio." ])
90 , ul(id('~w-list'-[ID]), \alinks(1,Links))
91 , \js_script({|javascript(PlaylistJS,ID)||
92 $.getScript(PlaylistJS, function(x,y,z){init_playlist(ID)})|})
93 % , script(type('text/javascript'),'init_playlist(~w)'-ID)
94 ])).
95
96 alinks(NSelected,Links) --> alinks(NSelected,1,Links).
97 alinks(_,_,[]) --> !.
98 alinks(N,N,[Item|Links]) --> !, {succ(N,M)}, html(li(class(active),\alink(Item))), alinks(N,M,Links).
99 alinks(S,N,[Item|Links]) --> !, {succ(N,M)}, html(li(\alink(Item))), alinks(S,M,Links).
100 alink(item(URL,Label,Page)) -->
101 html(div([ a([href(Page),target('_blank')],\icon('external-link')),' '
102 , a([class(audio),href(URL)],Label)])).
103
104
105 audio_source(URL-Fmt) -->
106 ( {Fmt=just(Type), mime_type(Type,MimeType)}
107 -> html(source([src=URL,type=MimeType],[]))
108 ; html(source([src=URL],[]))
109 ).
110
111
112 %% spectrogram(+URI, +Options) is det.
113 %
114 % Emits HTML for a spectrogram viewer for a given recording URI. The viewer
115 % includes controls for controlling the time window extracted from the full signal.
116 spectrogram(URI,Opts) -->
117 { seqmap( option_default_select,
118 [offset(Off), length(Len), width(W), height(H)],
119 [0, 60, 15, 7],
120 Opts,Opts1),
121 http_link_to_id(spectrogram_window,
122 [ uri(URI), offset(Off), length(Len), width(W), height(H) | Opts1 ],
123 SpectroURL )
124 },
125 html_requires(font_awesome),
126 html(iframe([ frameborder=0, seamless=seamless, src=SpectroURL,
127 scrolling=no, style="width:100%;height:~dcm"-[H] ],[])).
128
129 :- meta_predicate finder_player(1,-).
130 %% finder_player(+Finder:pred(-uri), -Player:html_term) is det.
131 finder_player(Finder,html(\audio_playlist(ID,Items))) :-
132 gensym(pl,ID),
133 findall(item(H,L,P),( call(Finder,X),
134 http_link_to_id(list_resource,[r(X)],P),
135 audio_link(X,H,_),
136 rdf_label(X,L)
137 ), Items).
138
139 %% finder_player(@URI:uri, +Finder:goal, -Player:html_term) is det.
140 :- meta_predicate finder_player(-,0,-).
141 finder_player(R,Goal,Player) :- finder_player(call1(R,Goal),Player).
142 call1(R,Goal,R) :- call(Goal).
143