:- module(yaz_tag, [ http_yaz_tag/1 ]). :- 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(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_beta)). :- use_module(library(video_annotation)). :- use_module(components(yaz_page)). :- use_module(api(reconcile)). :- setting(language, atom, dutch, 'language used for stemming'). :- setting(max_reconcile, integer, 3, 'maximum number of concepts used to find related tags'). :- http_handler(yaz(tag), http_yaz_tag, []). %% http_yaz_tag(+Request) % % Emit an HTML page with gardening options for a tag. http_yaz_tag(Request) :- http_parameters(Request, [ concept(Concept, []), tag(TagList0, [zero_or_more]) ]), confirmed_annotations(Concept, Annotations), sort(TagList0, TagList), related_tags([Concept], RelatedTags), tag_entries(TagList, TagEntries), html_tag_page(Concept, TagList, RelatedTags, Annotations, TagEntries). %% confirmed_annotations(+Concept, -Annotations) % % Annotations is a list of shots for which it is confirmed that % Concept appears in it. % % @TBD group by video confirmed_annotations(Concept, Annotations) :- concept_value(Concept, Value, TagTerm), findall(annotation(TagTerm, Video, StartTime, EndTime), confirmed_annotation(Value, Video, StartTime, EndTime), Annotations). concept_value(Concept, Concept, uri(Concept, Label)) :- rdf_subject(Concept), !, rdf_display_label(Concept, Label). concept_value(Concept, literal(Concept), literal(Concept)). confirmed_annotation(Concept, Video, StartTime, EndTime) :- rdf(FragmentProxy, dc:subject, Concept), rdf(FragmentProxy, ebucore:start , Start), rdf(FragmentProxy, ma:duration, Duration0), rdf(VideoProxy, ma:hasFragment, FragmentProxy), rdf(VideoProxy, ore:proxyIn, VideoAggregation), rdf(VideoAggregation, ens:hasView, Video), literal_to_number(Start, StartTime), literal_to_number(Duration0, Duration), EndTime is StartTime + Duration. %% tag_annotations(+TagList, -TagEntries) % % TagEntries is a list of Shots annotated with tag. tag_entries(TagList, Annotations) :- findall(Time-entry(Entry,Video,Value,Process,User,Time), tag_entry(TagList, Entry, Value, Video, Process, User, Time), Entries), keysort(Entries, TimeSorted0), pairs_values(TimeSorted0, TimeSorted), group_entries(TimeSorted, Annotations). group_entries([], []). group_entries([E|Es], [A|As]) :- E = entry(Entry,Video,Value,_Process,_User,Time), A = video_annotation(Value, Video, Time, Time, [entry(Entry,Value,Time)]), group_entries(Es, As). tag_entry(Tags, Entry, TagTerm, Video, Process, User, Time) :- member(Tag, Tags), tag_value(Tag, Value, TagTerm), value_annotation(Value, Process, User, Video, Entry, Time). tag_value(Tag, Value, uri(Value, Tag)) :- rdf(Value, rdfs:label, literal(Tag)), rdf(Value, rdf:type, pprime:'Tag'), !. tag_value(Tag, literal(Tag), literal(Tag)). %% related_tags(+TagList, -Related) % % Related is a list of tags that are related to Tag. % % stemming % subword % @TBD semantic relations related_tags(TagList, RelatedTags) :- findall(Rel-Value, ( member(Tag, TagList), related_tag(Tag, Value, Rel), \+ member(Value, TagList) ), RelatedTags0), sort(RelatedTags0, RelatedTags). related_tag(Tag, RelatedTag, Type) :- setting(language, Lang), snowball(Lang, Tag, Stem), rdf(S,P,literal(prefix(Stem), RelatedTag)), is_tag_label(S,P,literal(RelatedTag)), ( snowball(Lang, RelatedTag, Stem) -> Type = stem ; Type = subword ). /* semantic_related_tag( concept_synonym(Concept tag_concept_match(R, R, synonym) :- !. tag_concept_match(R1, R2, specific) :- parent_of(R1, R2), !. tag_concept_match(R1, R2, generic) :- parent_of(R2, R1), !. %% parent_of(+R, +Ancestor) % % True if Parent is related to R by skos:broader. parent_of(R, A) :- rdf_has(R, skos:broader, A). parent_of(R, A) :- rdf_has(A, skos:broader, R). */ is_tag_label(_S,P,_Lit) :- rdf_equal(pprime:hasAnnotation, P). is_tag_label(S,_P,_Lit) :- rdf(S,rdf:type,pprime:'TagEntry'), !. /******************************* * HTML * *******************************/ html_tag_page(Concept, TagList, RelatedTags, Annotations, TagEntries) :- maplist(tag_term, TagList, TagTerms), http_link_to_id(http_yaz_tag, [concept(Concept)|TagTerms], Link), reply_html_page([title(['YAZ -- ',Concept])], [\html_requires(css('yaz.css')), \html_requires(css('tag_garden.css')), \html_requires(yui3('cssgrids/grids-min.css')), \html_page_header, div(id(body), div([id(layout), class('yui3-g')], [ div([class('yui3-u'), id(tags)], [ h3(class(hd), 'User tags'), div(id(active), ul(class(taglist), \html_tags(TagList, Concept, TagTerms)) ), div(id(related), [ ul(class(taglist), \html_related_tags(RelatedTags, Link)) ]) ]), div([class('yui3-u'), id(shots)], [ \html_annotations(Annotations, Concept), \html_unconfirmed(TagEntries, Concept) ]) ])), script(type('text/javascript'), \yui_script(TagList, RelatedTags, TagEntries)) ]). html_annotations(Annotations, Tag) --> { length(Annotations, Count) }, html([ h2([Tag, ' ', Count, ' shots']), div(id(annotations), []) ]). html_unconfirmed(Annotations, Tag) --> { length(Annotations, Count) }, html([ h2([Tag, ' may appear in ', Count, ' shots']), div(class(desc), 'click title to confirm and image to play the shot'), div(id(unconfirmed), []) ]). tag_term(Tag, tag(Tag)). html_page_header --> html(div(id(header), div(class('header-content'), [ h1(a(href(location_by_id(http_yaz_home)), 'YAZ')), %div(id(pagesearch), \html_concept_search), div(id(pagecontrols), \html_page_controls) ]))). html_concept_search --> html([input([type(text), class(inp), id(q)]), input([type(submit), class(btn), value(search)]) ]). html_tags([], _,_) --> !. html_tags([Tag|T], Concept, TagTerms) --> { select(tag(Tag), TagTerms, Rest), http_link_to_id(http_yaz_tag, [concept(Concept)|Rest], Link) }, html(li(class(current), [a([class(tag)], Tag), a([class(remove), href(Link)], 'x') ])), html_tags(T, Concept, TagTerms). html_related_tags([], _) --> !. html_related_tags([Type-Tag|T], Link) --> { http_link_to_id(http_yaz_tag, [tag(Tag)], TagLink) }, html(li(class(Type), [a([class(tag), href(TagLink)], Tag), a([class(add), href(Link+'&tag='+Tag)], 'add') ])), html_related_tags(T, Link). yui_script(_Tag, _RelatedTags, Annotations) --> { http_location_by_id(serve_video_frame, FrameServer), http_absolute_location(js('videoframes/videoframes.js'), Videoframes, []), annotation_to_json(Annotations, JSONAnnotations) }, yui3([{modules:{'video-frames':{fullpath:Videoframes}} } ], [node,event,widget,anim, 'json','jsonp','querystring-stringify-simple',io, 'video-frames' ], [\js_new(videoFrames, 'Y.mazzle.VideoFrames'({frameServer:FrameServer, frames:JSONAnnotations, confirm:symbol(true), interval:0, showRelated:symbol(false), showTime:symbol(true), disabled:symbol(false), maxFrames:500 })), \yui3_render(videoFrames, #(unconfirmed)) ]).