:- module(vumix,
	[]).


% semweb
:- use_module(library('semweb/rdf_db')).
:- use_module(library('semweb/rdfs')).
:- use_module(library('semweb/rdf_label')).
:- use_module(library(yui3_beta)).

% http libraries
:- use_module(library('http/http_dispatch')).
:- use_module(library('http/http_parameters')).
:- use_module(library('http/html_write')).
:- use_module(library('http/html_head')).
:- use_module(library('http/http_path')).
:- use_module(library('http/http_json')).
:- use_module(components(label)).
:- use_module(library(settings)).
:- use_module(user(user_db)).
:- use_module(library(instance_search)).
:- use_module(library(graph_version)).

:- use_module(api(annotation)).
:- use_module(library(user_process)).
:- use_module(library(yaz_util)).


/***************************************************
* http handlers
***************************************************/

:- http_handler(cliopatria(vumix/annotate), http_vumix_annotate, []).
:- http_handler(cliopatria(vumix), http_vumix, []).
:- http_handler(cliopatria(vumix/session/finish), http_vumix_finish, []).


/***************************************************
* settings
***************************************************/

:- setting(login, boolean, true, 'Require login').
:- setting(min_query_length, integer, 3,
	   'Minimum number of characters that must be entered before a query event will be fired. A value of 0 allows empty queries; a negative value will effectively disable all query events and turn AutoComplete off. ').


/***************************************************
* http replies
***************************************************/

%%	http_vumix_annotate(+Request)
%
%	Generate page to annotate a vumix.

http_vumix_annotate(Request) :-
	http_parameters(Request,
		[ target(Target,
		     [uri,
		      description('URI of the object to be annotated')
		     ]),
		  field(Fields0,
			[zero_or_more,
			 description('URI of annotation field')
			])
		]),
	(   Fields0 = []
	->  Fields = ['http://semanticweb.cs.vu.nl/prestoprime/personAnnotation',
		      'http://semanticweb.cs.vu.nl/prestoprime/placeAnnotation',
		      'http://semanticweb.cs.vu.nl/prestoprime/nameAnnotation',
		      'http://semanticweb.cs.vu.nl/prestoprime/subjectAnnotation']
	;   Fields = Fields0
	),
	(   setting(login, true)
        ->  authorized(write(_,_)),
	    logged_on(User)
	;   logged_on(User, anonymous)
        ),
	user_process(User, Target, _),
	html_page(Target, Fields).

user_process(User, Target, Process) :-
	(   current_user_process(Process),
	    rdf(Process, rdf:type, pprime:'Annotation'),
	    rdf(Process, opmv:used, Target)
	->  true
	;   create_user_process(User, [rdf:type=pprime:'Annotation',
				       opmv:used=Target
				      ], Process)
	),
	start_user_process(Process).


http_vumix_finish(Request) :-
	(   current_user_process(Process)
	->  end_user_process(Process)
	;   true
	),
	http_redirect(see_other, location_by_id(http_vumix), Request).


http_vumix(_Request) :-
	ensure_logged_on(User),
	MinCoverage = 0.5, % 1 tag per 2 seconds
	findall(URI, test_fragment(URI, MinCoverage), Fragments),
	reply_html_page(
	    [ title(['Fragments'])
	    ],
	    [table([cellpadding(10),cellspacing(0),border(1)],
		   tbody(\html_fragments(Fragments, User)))]).

test_fragment(URI, Min) :-
	rdf(URI, rdf:type, pprime:'TestFragment'),
	rdf(URI, pprime:duration, literal(D)),
	atom_number(D, Duration),
	findall(T, rdf(URI, pprime:hasAnnotation, T), Ts),
	length(Ts, TagCount),
	Coverage is TagCount/(Duration/1000),
	Coverage > Min.

html_fragments([], _) --> !.
html_fragments([F|Fs], User) -->
	{ fragment_label(F, Label),
	  findall(Time, annotated_fragment(F, User, _Process, Time), Times),
	  http_link_to_id(http_yaz_player, [video(F)], Player),
	  http_link_to_id(http_vumix_annotate, [target(F)], Annotate),
	  http_link_to_id(http_vumix_p0, [target(F)], Suggest)
	},
	html(tr([td([valign(top)],Label),
		 td(\html_times(Times)),
		 td([valign(top)],a(href(Player), 'player')),
		 td([valign(top)],a(href(Annotate), 'annotate')),
		 td([valign(top)],a(href(Suggest), 'annotate with suggestions'))
		])),
	html_fragments(Fs, User).

html_times([]) --> !.
html_times([T|Ts]) -->
	html(div(T)),
	html_times(Ts).

fragment_label(Fragment, Label) :-
	(   rdf(Fragment, dcterms:title, literal(Title))
	->  Label = Title
	;   rdf(Fragment, dcterms:id, literal(Id))
	->  Label = Id
	;   rdf_global_id(_:Label, Fragment)
	).

annotated_fragment(Fragment, User, Process, EndTime) :-
	rdf(Process, opmv:used, Fragment),
	rdf(Process, opmv:wasControlledBy, User),
	rdf(Process, opmv:wasEndedAt, literal(type(xsd:date, EndTime))).

/***************************************************
* annotation page
***************************************************/

%%	html_page(+Target, +Fields)
%
%	HTML page

html_page(Target, Fields) :-
	rdf_global_id(_:Id, Target),
	reply_html_page(
	    [ title(['Annotate -- ', Id])
	    ],
	    [ \html_requires(yui3('cssgrids/grids-min.css')),
	      \html_requires(css('annotation.css')),
	      \html_requires(css('vumix.css')),
	      div(class('yui3-skin-sam yui-skin-sam'),
		  [ div(id(hd), []),
		    div(id(bd),
			div([id(layout), class('yui3-g')],
			    [ div([id(fields), class('yui3-u')],
				  [ div(class(bd),
					\html_annotation_fields(Fields)),
				    div(class(ft),
					a(href(location_by_id(http_vumix_finish)), done))
				  ]),
			      div([id(media), class('yui3-u')],
				  [ div(id(title), []),
				    div(id(video), []),
				    div(id(videoFrames), [])
				  ])
			    ])
		       ),
		    div(id(ft), [])
		  ]),
	      script(type('text/javascript'),
		     \yui_script(Target, Fields))
	    ]).

% hack for mbh demo
mbh_video_source(R, Video) :-
	rdf_has(R, dc:id, literal(FragmentId)),
	!,
	concat_atom(['http://eculture2.cs.vu.nl/pprime/videos/',FragmentId,'.mp4'], Video).
mbh_video_source(_R, @null).

%%	html_annotation_fields(+FieldURIs)
%
%	Write html for annotation fields.

html_annotation_fields([]) --> !.
html_annotation_fields([URI|T]) -->
	html(div(class('annotate-field suggest-field'),
		 \html_annotation_field(URI))),
	html_annotation_fields(T).

html_annotation_field(URI) -->
	{ rdf_global_id(_:Id, URI),
	  rdf_label(URI, L),
	  literal_text(L, Label)
	},
	html([ div(class('annotate-header'),
		   [ h3(Label),
		     \html_annotation_field_desc(URI)
		   ]),
	       input([id(Id), type(text)])
	     ]).

html_annotation_field_desc(URI) -->
	{ rdf(URI, dc:comment, D),
	  literal_text(D, Desc)
	},
	!,
	html(div([class('annotate-description')], Desc)).
html_annotation_field_desc(_URI) --> !.



		 /*******************************
		 *	     JavaScript		*
		 *******************************/

%%	yui_script(+Graph)
%
%	Emit YUI object.

yui_script(Target, Fields) -->
	{ findall(M-C, js_module(M,C), Modules),
	  pairs_keys(Modules, Includes)
	},
	yui3([json([modules(json(Modules))])],
	     ['recordset-base'|Includes],
	     [\js_video(Target),
	      \js_video_frames(Target),
	      \js_title_edit(Target),
	      \js_annotation_fields(Fields, Target),
	      'videoFrames.on("frameSelect", function(e) {videoPlayer.setTime(e.time, true)});']).

js_module('videoplayer', json([fullpath(Path),
			       requires([node,event,widget])
			      ])) :-
	http_absolute_location(js('vuplayer/videoplayer.js'), Path, []).
js_module('videoframes', json([fullpath(Path),
			       requires([node,event,widget])
			      ])) :-
	http_absolute_location(js('videoframes.js'), Path, []).
js_module('textedit', json([fullpath(Path),
			    requires([node,event,io,plugin,'querystring-stringify-simple'])
			      ])) :-
	http_absolute_location(js('textedit.js'), Path, []).
js_module('annotation', json([fullpath(Path),
			      requires(['recordset-base',
					autocomplete,
					'autocomplete-highlighters',
					overlay,
					'io','json',
					'querystring-stringify-simple'
				       ])
			     ])) :-
	http_absolute_location(js('annotation.js'), Path, []).

js_video_frames(Target) -->
	{ http_location_by_id(serve_video_frame, FrameServer),
	  mbh_video_source(Target, Src)
	},
	yui3_new(videoFrames,
		 'Y.VideoFrames',
		 {frameServer:FrameServer,
		  video:Src,
		  duration:343000,
		  interval:5000,
		  width:730
		 }),
	yui3_render(videoFrames, one(id(videoFrames))).

js_title_edit(Target) -->
	{ http_location_by_id(http_update_annotation, Update),
	  rdf_equal(dcterms:title, Field),
	  (   % fixme: should use http api instead
	      annotation_api:annotation_in_field(Target, Field, Annotation, _Body, Text, _Comment, _User)
	  ->  true
	  ;   Annotation = @null,
	      Text = @null
	  )
	},
	yui3_plug(one(id(title)),
		  'Y.Plugin.TextEdit',
		  {target:Target,
		   field:Field,
		   annotation:Annotation,
		   text:Text,
		   store:{update:Update}
		  }).

js_video(Target) -->
	{ http_absolute_location(js('vuplayer/'), FilePath, []),
	  video_source(Target, Src)
	},
	yui3_new(videoPlayer,
		 'Y.VideoPlayer',
		 {filepath:FilePath,
		  src:Src,
		  playerType:npo,
		  width:730,
		  height:460,
		  autoplay:symbol(false),
		  controls:symbol(true)
		 }),
	yui3_render(videoPlayer, one(id(video))).

%%	js_annotation_fields(+FieldURIs, +AnnotationTarget)
%
%	Write JavaScript to init annotation fields

js_annotation_fields([], _) --> !.
js_annotation_fields([URI|T], Target) -->
	js_annotation_field(URI, Target),
	js_annotation_fields(T, Target).

js_annotation_field(FieldURI, Target) -->
	{ http_location_by_id(http_add_annotation, Add),
	  http_location_by_id(http_remove_annotation, Remove),
	  rdf_global_id(_:Id, FieldURI),
	  setting(min_query_length, MinQueryLength),
	  rdf(FieldURI, an:source, literal(Source)),
	  % fixme: use http api instead
	  annotation_api:json_annotation_list(Target, FieldURI, Tags)
	},
	yui3_plug(one(id(Id)),
		  'Y.Plugin.Annotation',
		  {target:Target,
		   field:FieldURI,
		   source:Source,
		   store:{add:Add,
			  remove:Remove
			 },
		   tags:Tags,
		   minQueryLength:MinQueryLength,
		   resultListLocator: results,
		   resultTextLocator: label,
		   resultHighlighter: phraseMatch}).