:- module(yaz_shot_annotation, [assert_shot_data/0, load_shot_data/0, video_shot_annotations/3 ]). :- use_module(library(http/http_dispatch)). :- use_module(library(http/http_parameters)). :- use_module(library(http/http_path)). :- use_module(library(http/html_write)). :- use_module(library(http/html_head)). :- use_module(library(http/http_json)). :- use_module(library(http/js_write)). :- use_module(library(http/json)). :- use_module(library(http/json_convert)). :- use_module(library(http/http_session)). :- use_module(user(user_db)). :- use_module(library(semweb/rdf_db)). :- use_module(library(semweb/rdfs)). :- use_module(library(semweb/rdf_label)). :- use_module(library(yaz_util)). :- use_module(library(yui3)). :- use_module(library(video_annotation)). :- use_module(applications(yaz_tag_edit)). :- use_module(components(label)). :- use_module(components(yaz_page)). :- use_module(components(yaz_video_item)). :- use_module(library(rdf_history)). :- use_module(library(user_process)). :- use_module(api(edm_export)). /* reconcile_source(person, 'Person', Server, Params) :- http_location_by_id(http_reconcile, Server), www_form_encode('[{"http://www.w3.org/2004/02/skos/core#inScheme":"http://data.beeldengeluid.nl/gtaa/GTAA"}]',Ps), atom_concat('&properties=',Ps,Params). */ reconcile_source(person, 'Person', 'http://standard-reconcile.freebaseapps.com/reconcile', '/people/person', ''). reconcile_source(location, 'Location', 'http://standard-reconcile.freebaseapps.com/reconcile', '/location/location', ''). reconcile_source(subject, 'Subject', Server, 'http://www.w3.org/2006/03/wn/wn20/schema/Synset', '') :- http_location_by_id(http_reconcile, Server). /******************************* * Page handler * *******************************/ :- http_handler(yaz(shot), http_yaz_shot, []). %% http_yaz_shot(+Request) % % Emit an HTML page to link tags to concepts. http_yaz_shot(Request) :- ensure_logged_on(User0), user_property(User0, url(User)), http_parameters(Request, [ video(Video, [description('Current video')]) ]), ( current_user_process(Process), rdf(Process, rdf:type, pprime:'TagGarden'), rdf(Process, opmv:used, Video) -> true ; create_user_process(User, [rdf:type=pprime:'TagGarden', opmv:used=Video ], Process) ), start_user_process(Process), findall(Id=json([label=Label,url=URL,type=Type,parameters=Parameters]), reconcile_source(Id,Label,URL,Type,Parameters), Sources), findall({uri:Shot, startTime:Start, duration:Duration}, video_shot(Video, Shot, Start, Duration), Shots), html_page(Video, Process, Shots, json(Sources)). %% html_page(+Video, +Process, +Shots, +Annotations) % % Emit an HTML page for concept gardening html_page(Video, Process, Shots, Sources) :- http_link_to_id(http_yaz_sip_update, [video(Video), process(Process)], Update), reply_html_page(yaz, [ title(['YAZ - ', Video]) ], [ \html_requires(yui3('cssgrids/grids-min.css')), \html_requires(css('shotgarden.css')), \yaz_video_header(Video), div(class('yui3-g'), [ div([class('yui3-u'), id(nav)], [ div(class(hd), '1. Select shot to annotate'), div(id(videoframes), []), div(a(href(Update), 'Finish moderation')) ]), div([class('yui3-u'), id(main)], [ div(class(hd), '2a. Selected shot: video'), div(id(timeline), []), div(id(videoplayer), []), div(id(annotations), [ div(class(hd), '2b. Selected shot: annotations'), div(id(annotationform), []) ]) ]), div([class('yui3-u'), id('select-tag')], [ div(class(hd), '3. Select tags to annotate shot'), div(id(taglist), []) ]), div([class('yui3-u hidden'), id('select-concept')], [ div(class(hd), '4. Specify the intended meaning'), div(id(taglinker), []) ]) ]), script(type('text/javascript'), \html_video_page_yui(Video, Shots, Sources)) ]). html_video_page_yui(Video, Shots, Sources) --> { video_source(Video, Src, Duration), http_location_by_id(serve_video_frame, FrameServer), http_absolute_location(js('videoplayer/'), FilePath, []), http_absolute_location(js('videoplayer/videoplayer.js'), Videoplayer, []), http_absolute_location(js('timeline/timeline.js'), Timeline, []), http_absolute_location(js('videoframes/videoframes.js'), Videoframes, []), http_absolute_location(js('tagplayer/taglist.js'), Taglist, []), http_absolute_location(js('tagplayer/tagLinker.js'), TagLinker, []), http_absolute_location(js('annotation/annotation_form.js'), AnnotationForm, []) }, html_requires(js('videoplayer/swfobject.js')), js_yui3([{modules:{'video-player':{fullpath:Videoplayer}, 'timeline':{fullpath:Timeline}, 'video-frames':{fullpath:Videoframes}, 'tag-list':{fullpath:Taglist}, 'tag-linker':{fullpath:TagLinker}, 'annotation-form':{fullpath:AnnotationForm} }} ], [node,event,widget,anim, 'json','jsonp','querystring-stringify-simple',io, 'video-player','video-frames',%timeline, 'tag-list','tag-linker','annotation-form' ], [ \js_new(videoPlayer, 'Y.mazzle.VideoPlayer'({filepath:FilePath, src:Src, width:540, height:400, autoplay:symbol(false), controls:symbol(true), duration:Duration })), /*\js_new(timeline, 'Y.mazzle.Timeline'({height:20, width:540, duration:Duration, items:[] })), */ \js_new(videoFrames, 'Y.mazzle.VideoFrames'({frameServer:FrameServer, video:Src, width:200, height:562, frames:Shots, interval:0, duration:Duration, playerPath:FilePath, confirm:symbol(false), showRelated:symbol(false), showTime:symbol(true) })), \js_new(tagList, 'Y.mazzle.TagList'({tags:[], height:562, sizeAdjust:symbol(true) })), \js_new(tagLinker, 'Y.mazzle.TagLinker'({sources:Sources, height:562, limit:10 })), \js_new(annotationForm, 'Y.mazzle.AnnotationForm'({ width:540 })), \js_yui3_render(videoPlayer, #(videoplayer)), %\js_yui3_render(timeline, #(timeline)), \js_yui3_render(videoFrames, #(videoframes)), \js_yui3_render(tagList, #(taglist)), \js_yui3_render(tagLinker, #(taglinker)), \js_yui3_render(annotationForm, #(annotationform)), \js_yui3_on(videoFrames, frameSelect, \js_frame_select(Video)), \js_yui3_on(tagList, itemSelect, \js_tag_select), \js_yui3_on(tagLinker, submit, \js_concept_submit), \js_yui3_on(tagLinker, cancel, \js_concept_cancel), \js_yui3_on(annotationForm, delete, \js_annotation_remove), \js_yui3_on(videoPlayer, timeChange, \js_video_time_change) ]). js_frame_select(Video) --> { http_location_by_id(http_data_shot_get_annotations, AnnServer), http_location_by_id(http_data_shot_suggest_tags, TagServer) }, js_function([e], \[ ' var frame = e.frame; var time = (frame.startTime/1000); Y.shotStart = time; Y.shotEnd = (frame.duration/1000)+time; videoPlayer.setTime(time, true);\n', ' Y.one("#select-concept").addClass("hidden"); Y.one("#select-tag").removeClass("hidden");\n', ' Y.io("',AnnServer,'?shot="+encodeURIComponent(frame.uri), {on:{success:function(e,o){annotationForm.set("annotations", Y.JSON.parse(o.response))}}});\n', ' Y.io("',TagServer,'?video=',Video,'&shot="+encodeURIComponent(frame.uri), {on:{success:function(e,o){tagList.set("tags", Y.JSON.parse(o.response))}}});\n' ]). js_tag_select --> js_function([e], \[ ' Y.one("#select-tag").addClass("hidden"); Y.one("#select-concept").removeClass("hidden"); tagLinker.set("tag", e.tag.tag.value);\n' ]). js_concept_cancel --> js_function([e], \[ ' Y.one("#select-concept").addClass("hidden"); Y.one("#select-tag").removeClass("hidden");\n' ]). js_concept_submit --> { http_location_by_id(http_data_shot_set_annotation, Server) }, js_function([e], \[ ' var concepts = e.concepts, tag = e.tag, shot = videoFrames.get("selected").uri; Y.one("#select-concept").addClass("hidden"); Y.one("#select-tag").removeClass("hidden");\n', ' if(shot) { Y.io("',Server,'?shot="+encodeURIComponent(shot)+"&tag="+Y.JSON.stringify(tag)+"&concepts="+Y.JSON.stringify(concepts), {on:{success:function(e,o){annotationForm.addAnnotations(concepts) }}}); }\n' ]). js_annotation_remove --> { http_location_by_id(http_data_shot_delete_annotation, Server) }, js_function([e], \[ ' var shot = videoFrames.get("selected").uri\n', ' Y.io("',Server,'?shot="+encodeURIComponent(shot)+"&source="+e.source+"&value="+encodeURIComponent(e.value), {on:{success:function(e,o){}}});' ]). js_video_time_change --> js_function([e], \[ ' var time = Math.round(e.time); if(time>Y.shotEnd) {videoPlayer.setTime(Y.shotStart, true)};' ]). /******************************* * DATA APIs * *******************************/ :- http_handler(yaz(data/shot/suggest/tags), http_data_shot_suggest_tags, []). :- http_handler(yaz(data/shot/get/annotations), http_data_shot_get_annotations, []). :- http_handler(yaz(data/shot/set/annotation), http_data_shot_set_annotation, []). :- http_handler(yaz(data/shot/delete/annotation), http_data_shot_delete_annotation, []). %% http_data_shot_suggest_tags(+Request) % % Returns all tags that are related to Shot. http_data_shot_suggest_tags(Request) :- http_parameters(Request, [ video(Video, [description('URI of the video')]), shot(Shot, [description('URI of the shot')]) ]), ( video_shot(Video, Shot, Start, Duration) -> video_annotations(Video, As0, [interval(10)]), sort_by_arg(As0, 2, As), End is Start+Duration, annotations_in_shot(As, Start, End, ShotAnnotations0), sort_by_arg_count(ShotAnnotations0, 4, ShotAnnotations, desc), annotation_to_json(ShotAnnotations, JSON) ; JSON = [] ), reply_json(JSON). annotations_in_shot([], _, _, []). annotations_in_shot([A|T], Start, End, As) :- A = annotation(_, Time, _End, _, _), ( Time >= Start-1, Time =< End+1 -> As = [A|Rest], annotations_in_shot(T, Start, End, Rest) ; Time < Start -> annotations_in_shot(T, Start, End, As) ; As = [] ). %% http_data_shot_get_annotations(+Request) % % Returns all moderated annotations for Shot. http_data_shot_get_annotations(Request) :- http_parameters(Request, [ shot(Shot, [description('URI of the shot')]) ]), current_user_process(Process), findall(Type-json([entry=E, value=Value, label=Label]), shot_annotation(Shot, Value, Label, Type, Process, E), As0), keysort(As0, As), group_pairs_by_key(As, Annotations), reply_json(json(Annotations)). http_data_shot_set_annotation(Request) :- ensure_logged_on(_), http_parameters(Request, [ shot(Shot, [description('URI of the shot')]), concepts(Concepts, [json_shot_annotation, description('Array with concept annotations')]), tag(Tag, [optional(true), description('tag used to make annotations')]) ]), rdfh_transaction(assert_shot_annotations(Concepts, Shot, Tag)), reply_json(json([shot=Shot,tag=Tag])). http_data_shot_delete_annotation(Request) :- ensure_logged_on(_), http_parameters(Request, [ shot(Shot, [description('URI of the shot')]), value(Value, [description('URI of annotation value')]), source(Source, [description('Source identifier')]) ]), current_user_process(Process), rdfh_transaction(retract_shot_annotation(Shot, Source, Value, Process)), reply_json(json([shot=Shot,value=Value,soure=Source])). http:convert_parameter(json_shot_annotation, Atom, Term) :- atom_json_term(Atom, JSON, []), json_to_prolog(JSON, Term). :- json_object concept(value:atom, label:atom, source:atom). assert_shot_annotations([], _, _). assert_shot_annotations([C|Cs], Shot, Tag) :- C = concept(Value, Label, Type), assert_shot_annotation(Shot, Value, Label, Type, Tag, _), assert_shot_annotations(Cs, Shot, Tag). assert_shot_annotation(Shot, Value, Label, Type, Tag, R) :- rdf_bnode(R), rdfh_assert(R, rdf:type, pprime:'ShotAnnotation'), rdfh_assert(R, pprime:tag, literal(Tag)), rdfh_assert(R, pprime:shot, Shot), rdfh_assert(R, pprime:value, Value), rdfh_assert(R, pprime:type, Type), rdfh_assert(R, pprime:label, literal(Label)). retract_shot_annotation(Shot, Type, Value, Process) :- ( rdf(R, pprime:shot, Shot, Process), rdf(R, pprime:value, Value, Process), rdf(R, pprime:type, Type, Process) -> rdfh_retractall(R, _, _) ; true ). shot_annotation(Shot, Value, Label, Type, Process, R) :- rdf(R, pprime:shot, Shot, Process), rdf(R, pprime:value, Value, Process), rdf(R, pprime:type, Type, Process), rdf(R, pprime:label, literal(Label), Process). :- dynamic video/2. :- rdf_meta rdfc_assert(r,r,o,+). %% load_shot_data % % Load shot detection results. assert_shot_data :- rdf_transaction(forall(video(Video, Shots), assert_shots(Shots, Video))). load_shot_data :- ['videos/shots.pl'], unload_shots, assert_shot_data. unload_shots :- rdf_transaction(rdf_retractall(_,_,_,shots)). assert_shots([], _). assert_shots([Start-End|T], Video) :- Duration is End-Start, shot_url(Video, Start, Duration, Shot), rdfc_assert(Video, ma:hasFragment, Shot, shots), rdfc_assert(Shot, rdf:type, ma:'MediaFragment', shots), rdfc_assert(Shot, ebucore:start, literal(Start), shots), rdfc_assert(Shot, ma:duration, literal(Duration), shots), assert_shots(T, Video). rdfc_assert(S,P,O,_) :- rdf(S,P,O),!. rdfc_assert(S,P,O,F) :- rdf_assert(S,P,O,F). shot_url(Video, Start, Duration, Shot) :- End is Start+Duration, concat_atom([Video, '#t=', Start, ',', End], Shot). video_shot(Video, Shot, Start, Duration) :- rdf(Video, ma:hasFragment, Shot), rdf(Shot, rdf:type, ma:'MediaFragment'), rdf(Shot, ebucore:start, literal(Start0)), rdf(Shot, ma:duration, literal(Duration0)), to_number(Start0, Start1), to_number(Duration0, Duration1), Start is Start1*1000, Duration is Duration1*1000. to_number(A,N) :- atom(A), !, atom_number(A,N),!. to_number(N,N). %% video_shot_annotations(+VideoURL, ?Process, -Annotations) % % Annotations are shot annotations for VideoURL. % video_shot_annotations(Video, Process, Annotations) :- A = shot_annotation(Shot, StartTime, Duration, Values), findall(A, ( video_shot(Video, Shot, StartTime, Duration), findall(concept(URI,Label,Type), shot_annotation(Shot, URI, Label, Type, Process, _), Values) ), Annotations).