:- module(yaz_video,
	  []).

:- use_module(library(http/http_dispatch)).
:- use_module(library(http/http_parameters)).
:- use_module(library(http/html_write)).
:- use_module(library(http/http_host)).
:- use_module(library(http/http_path)).
:- use_module(library(http/html_head)).
:- use_module(library(semweb/rdf_db)).
:- use_module(library(semweb/rdf_label)).
:- use_module(user(user_db)).

:- use_module(library(yaz_util)).
:- use_module(library(user_process)).
:- use_module(library(video_annotation)).

:- use_module(components(yaz_page)).
:- use_module(components(yaz_video_item)).
:- use_module(components(paginator)).

:- http_handler(yaz(video), http_yaz_video, []).

%%	http_yaz_video(+Request)
%
%       Emit a all videos a user has annotated.

http_yaz_video(Request) :-
	http_parameters(Request,
			[ video(Video,
				[description('URL of a video')]),
			  offset(Offset,
				[default(0), integer, description('Offset of the result list')]),
			  limit(Limit,
				[default(20), integer, description('Limit on the number of results')])
  			]),
	findall(process(Process, Time),
		annotation_process(_, Video, Process, Time),
		Processes),
	length(Processes, NumberOfResults),
  	list_offset(Processes, Offset, OffsetResults),
	list_limit(OffsetResults, Limit, LimitResults, _),
 	html_page(Video, LimitResults, NumberOfResults, Offset, Limit).

%%	html_page(+Video, +Processes, +NumberOfResults, +Offset, +Limit,
%%	+User, +Annotation)
%
%	Emit HTML page with a list of Videos.

html_page(Video, Processes, NumberOfResults, Offset, Limit) :-
	http_link_to_id(http_yaz_player, [video(Video)], Player),
	reply_html_page(yaz,
			[ title(['YAZ - ', Video])
			],
			[ \yaz_video_header(Video),
			  ol(class('result-list'),
			     \html_process_list(Processes, Player)),
			   div(class(paginator),
			       \html_paginator(NumberOfResults, Offset, Limit))

			]).



%%	html_process_list(+Processes, +VideoURL, +VideoPlayer)
%
%	Emit list of processes.

html_process_list([], _) --> !.
html_process_list([process(Process, Time0)|T], VideoPlayer) -->
	{ rdf(Process, rdf:type, Type0),
	  rdf_display_label(Type0, Type),
	  display_time(Time0, Time),
	  Players = []
	},
	html(li([ div(class('process'),
		      [Type, ' at ', Time,
		       ' (', a(href(VideoPlayer+'&process='+Process), play), ')'
		      ]),
		  div(class('players'),
		      \html_players(Players, VideoPlayer))
		])),
	html_process_list(T, VideoPlayer).


html_players(_, _) --> !.