yaz/commit

Your Annotation Zone

authorMichiel Hildebrand
Sun Jan 23 16:13:42 2011 +0100
committerMichiel Hildebrand
Sun Jan 23 16:13:42 2011 +0100
commitc5d734a2381423264ddaf08a58e7cb902fa2f831
treeddab364320feb39f22197a0f42c3e609e4b53749
parent62bbfa0208128de054370bdb340f8f80a11ef5b7
Diff style: patch stat
diff --git a/api/reconcile.pl b/api/reconcile.pl
new file mode 100644
index 0000000..3a39087
--- /dev/null
+++ b/api/reconcile.pl
@@ -0,0 +1,318 @@
+:- module(reconcile,
+	  [reconcile/5    % +Query, +Max, +Type, +Properties, -Concepts
+	  ]).
+
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_parameters)).
+:- use_module(library(http/http_path)).
+:- use_module(library(http/http_json)).
+:- 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(semweb/rdf_litindex)).
+:- use_module(library(snowball)).
+
+:- use_module(library(yaz_util)).
+:- use_module(library(fuzzy)).
+
+/** <module> Reconciliation: Linking tags to concepts from vocabularies
+
+@author	Michiel Hildebrand
+*/
+
+:- http_handler(yaz(reconcile), http_reconcile, []).
+:- http_handler(yaz(savereconcile), http_save_reconcile, []).
+
+%%	http_reconcile(+Request)
+%
+%	Handler to find reconciliations.
+%	Based on
+%	http://code.google.com/p/google-refine/wiki/ReconciliationService
+%	API
+%
+%	Returns a json object.
+
+http_reconcile(Request) :-
+ 	http_parameters(Request,
+			[ query(Query,
+				[atom,
+				 optional(true),
+				 description('a string to search for')
+				]),
+			  queries(Queries,
+				[json,
+				 optional(true),
+				 description('a json object of the form {q1:{query:STRING}, ...}')]),
+  			  limit(Limit,
+			      [number, default(3),
+			       description('Number of results to return per query')]),
+			  type(Type,
+			       [(atom;json), default([]),
+				description('A string or a array of strings specificing the types of result')]),
+			  /*type_strict(TypeStrict, optional(true), one_of([any,all,should]),
+				      [description('')]),*/
+			  properties(Properties,
+				     [json, default([]),
+				      descirption('array of json object literals')]),
+			  callback(Callback,
+				   [optional(true),
+				    description('callback function for JSONP results')
+				   ])
+			]),
+	(   nonvar(Queries), Queries = json(QueryList)
+	->  reconcile_list(QueryList, Limit, Type, Properties, Results),
+	    reply(Callback, json(Results))
+ 	;   nonvar(Query)
+	->  reconcile(Query, Limit, Type, Properties, Hits),
+	    hits_to_json_results(Hits, Results),
+	    reply(Callback, json([result=Results]))
+	;   reply(Callback, json([]))
+	).
+
+reply(Callback, JSON) :-
+	(   var(Callback)
+	->  reply_json(JSON)
+	;   format('Content-type: application/jsonp~n~n'),
+	    format('~w (', Callback),
+	    json_write(current_output, JSON),
+	    format(')')
+	).
+
+%%	reconcile_list(+QueryPairs:key-query, +Limit, +Type,
+%%	+Properties, -Results:JSON)
+%
+%	Results is a list of pairs with for every key in QueryPairs a
+%	list of hits matching query.
+
+reconcile_list([], _, _, _, []).
+reconcile_list([Key=json([query=Query])|Ts], Max, Type, Properties, [Key=json([result=Results])|Rs]) :-
+	reconcile(Query, Max, Type, Properties, Hits),
+	hits_to_json_results(Hits, Results),
+ 	reconcile_list(Ts, Max,  Type, Properties, Rs).
+
+%%	reconcile(+Query, +MaxResults, +Type, +Properties,
+%%      -Concept:hit(score,uri,property,label))
+%
+%	Reconcile a QueryString to a set of candidate concepts
+
+reconcile(Query, Max, Type, Properties, Hits) :-
+ 	label_list(LabelList),
+	find_resource_by_name(Query, LabelList, Hits0, [match(stem),distance(true)]),
+	filter_hits(Hits0, Max, Type, Properties, Hits).
+
+label_list(LabelList) :-
+	rdf_equal(rdfs:label, Label),
+	rdf_equal(skos:prefLabel, PrefLabel),
+	rdf_equal(cornetto:synonym, Syn),
+	LabelList = [Syn-0,
+		     PrefLabel-0,
+		     Label-1
+		    ].
+
+%%	filter_hits(+Hits, +Limit, +Types, +Properties, -Filtered)
+%
+%	Limit Hits to Limit number that succeed for the Types and
+%	Properties filters.
+
+filter_hits(_, 0, _, _, []) :- !.
+filter_hits([], _, _, _, []) :- !.
+filter_hits([H|T], N, Type, Properties, Results) :-
+	(   type_filter(Type, H),
+	    property_filter(Properties, H)
+	->  Results = [H|Rest],
+	    N1 is N - 1
+	;   Results = Rest,
+	    N1 = N
+	),
+	filter_hits(T, N1, Type, Properties, Rest).
+
+type_filter([], _) :- !.
+type_filter(Types, R) :-
+	type_filter_(Types, R).
+
+type_filter_([Type|Ts], R) :-
+	(   rdf(R, rdf:type, Type)
+	->  true
+	;   type_filter_(Ts, R)
+	).
+property_filter([], _).
+property_filter([P-V|Ps], R) :-
+	rdf(R, P, V),
+	property_filter(Ps, R).
+
+%%	hits_to_json_results(+Hits:hit(score,uri,property,label),
+%%	-JSON).
+%
+%	Create a JSON object of a hit term and add a list of types for
+%	URI.
+
+hits_to_json_results([], []).
+hits_to_json_results([Hit|Hs], [Result|Rs]) :-
+	Hit = hit(Distance,URI,_Property,Label),
+	type_list(URI, Types),
+	Result = json([id=URI,
+		       name=Label,
+		       type=Types,
+		       score=Distance,
+		       match=false % we're not certain
+		      ]),
+	hits_to_json_results(Hs, Rs).
+
+type_list(URI, Types) :-
+	findall(T, rdf(URI, rdf:type, T), Ts0),
+	sort(Ts0, Ts),
+	resource_json_object(Ts, Types).
+
+resource_json_object([], []).
+resource_json_object([R|Rs], [JSONObj|Os]) :-
+	JSONObj = json([id(R), label(Label)]),
+	display_label(R, Label),
+	resource_json_object(Rs, Os).
+
+%%	find_resource_by_name(+Name:atom, +Attributes:list(P-D),
+%%             -Hit:hit(Distance:nonneg,Hit:atom,Prop:atom,Label:atom),
+%%             +Options)  is nondet.
+%
+%	Find a resource based on a Name.  The distance is based on
+%	two figures:
+%
+%		* Mismatch of the label
+%		* Handicap of the attribute
+%
+%	If multiple attributes match, we take   the best. The Attributes
+%	list is of  the  form   Resource-Distance.  Smaller  distance is
+%	better, so rdfs:label typically is 0.
+
+find_resource_by_name(Name, Attributes, Hits, Options) :-
+	tokens(Name, Tokens),
+	option(match(Match), Options, exact),
+	(   option(distance(true), Options)
+	->  catch(findall(D-Label, find_literal(Tokens, Match, Label, D), Pairs),
+	      no_stem(_),
+	      fail)
+	;   catch(findall(0-Label, find_literal(Tokens, Match, Label), Pairs),
+	      no_stem(_),
+	      fail)
+	),
+	findall(Hit, uri_with_label_in(Pairs, Attributes, Hit), Hits1),
+	sort(Hits1, Hits2),			% sort by URI
+	remove_dup_uris(Hits2, Hits3),	% take lowest on URI
+	sort(Hits3, Hits).			% sort by distance
+
+remove_dup_uris([], []).
+remove_dup_uris([hit(URI,D,P,L)|T0], [hit(D,URI,P,L)|T]) :-
+	remove_same_uri(URI, T0, T1),
+	remove_dup_uris(T1, T).
+
+remove_same_uri(URI, [hit(URI,_,_,_)|T0], T) :- !,
+	remove_same_uri(URI, T0, T).
+remove_same_uri(_, L, L).
+
+uri_with_label_in(LabelPairs, Attributes, hit(URI, Distance, P, Label)) :-
+	member(D-Label, LabelPairs),
+	rdf(URI, P, literal(Label)),
+	(   member(P-F, Attributes)
+	->  true
+	;   member(AS-F, Attributes),
+	    rdfs_subproperty_of(P, AS)
+	),
+	% hack to exclude Tag Terms itself
+	\+ rdf(URI,rdf:type,'http://semanticweb.cs.vu.nl/prestoprime/Term'),
+	Distance is D+F.
+
+find_literal(Tokens, MatchType, Label, Distance) :-
+	find_literal(Tokens, MatchType, Label),
+	literal_distance(Tokens, Label, Distance).
+
+tokens(Spec, Tokens) :-
+	atom(Spec), !,
+	rdf_tokenize_literal(Spec, Tokens).
+tokens(Tokens, Tokens) :-
+	is_list(Tokens).
+
+
+%%	http_save_reconcile(+Request)
+%
+%	Handler for reconsiliation of tags by URIs.
+%	Returns a json reply when all parameters are valid.
+
+http_save_reconcile(Request) :-
+	http_in_session(SessionID),
+	logged_on(User, SessionID),
+	http_parameters(Request,
+			[ entry(TagEntry,
+				[description('URI of tagentry event')]),
+  			  uri(URI,
+			      [description('URI of resource tag is reconciled with')])
+			]),
+	valid_reconcile(TagEntry, URI, User, Tag, Error),
+	(   nonvar(Error)
+	->  json_reply_error(Error)
+	;   reconcile_event_uri(TagEntry, ReconcileEvent),
+	    assert_recon(ReconcileEvent, TagEntry, URI, User),
+	    json_reply_recon(ReconcileEvent, Tag, URI, User)
+	).
+
+valid_reconcile(TagEntry, _URI, _User, Tag, Error) :-
+	(   \+ rdf(TagEntry, rdf:type, pprime:'TagEntry')
+	->  concat_atom(['entry ', TagEntry, ' does not exist'], Error)
+	;   rdf(TagEntry, sem:involves, TagTerm),
+	    display_label(TagTerm, Tag)
+	).
+
+assert_recon(ReconcileEvent, TagEntry, URI, User) :-
+  	rdf_assert(ReconcileEvent, rdf:type, pprime:'ReconcileEvent', recon),
+	rdf_assert(ReconcileEvent, pprime:reconciles, TagEntry, recon),
+	rdf_assert(ReconcileEvent, pprime:reconcilesWith, URI, recon),
+ 	rdf_assert(ReconcileEvent, sem:hasActor, User, recon).
+
+reconcile_event_uri(TagEntry, ReconcileEventURI) :-
+	% base URI on number of existing reconciliation for TagEntry
+	findall(E, rdf(E, pprime:reconciles, TagEntry), Es),
+	length(Es, Count),
+	concat_atom([TagEntry, 'Reconcile', Count], ReconcileEventURI).
+
+json_reply_recon(Entry, Tag, URI, User) :-
+	reply_json(json([success='reconciliation saved',
+			 entry=Entry,
+			 user=User,
+			 tag=Tag,
+			 uri=URI
+			])).
+
+json_reply_error(Error) :-
+	reply_json(json([error=Error])).
+
+
+
+
+
+
+:- use_module(library(http/http_client)).
+
+freebase_reconcile(Tags, ReconciledTags) :-
+	freebase_url(URL),
+       	freebase_query(Tags, Query),
+	freebase_option_string(Options),
+	www_form_encode(Query, EncQuery),
+	concat_atom([URL, '?queries=', EncQuery, Options], Request),
+	http_get(Request, Reply, []),
+	json_to_prolog(Reply, Results),
+	ReconciledTags = Results.
+
+freebase_url('http://api.freebase.com/api/service/search').
+freebase_option_string('&limit=3').
+freebase_query(Tags, Query) :-
+	freebase_json_query(Tags, JSON),
+	with_output_to(string(Query),
+		       json_write(current_output, json(JSON), [])).
+
+freebase_json_query([], []).
+freebase_json_query([Tag|T], [Tag=json([query=Tag])|Rest]) :-
+	freebase_json_query(T, Rest).
+
+
diff --git a/api/video_frames.pl b/api/video_frames.pl
new file mode 100644
index 0000000..00ab59d
--- /dev/null
+++ b/api/video_frames.pl
@@ -0,0 +1,225 @@
+:- module(video_frames,
+	  [ cache_tag_frames/3,
+	    video_frame_reset/0,
+	    video_url_frame/3,
+	    video_frame/3
+	  ]).
+
+:- use_module(library(settings)).
+:- use_module(library(http/url_cache)).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_parameters)).
+:- use_module(library(http/http_header)).
+:- use_module(library(semweb/rdf_db)).
+:- use_module(library(yaz_util)).
+
+% Windows: 'cmd.exe /C ffmpeg.exe'
+:- setting(frame_program, atom, ffmpeg,
+	   'FFMPEG convert used to extract video frames').
+:- setting(frame_size, any, size(120,96),
+	   'Term size(W,H) into which video frames are scaled').
+:- setting(cache_directory, atom, 'cache/frames',
+	   'Directory for caching video frames').
+:- setting(video_directory, atom, 'videos',
+	    'Directory where local videos are stored').
+
+:- dynamic
+	video_frame_cache/3.		% Video, Time, File
+
+:- http_handler(root(videoframe), serve_video_frame, []).
+
+%%	video_frame_reset is det.
+%
+%	Reset our dynamic data to symplify debugging after an error.
+
+video_frame_reset :-
+	retractall(video_frame_cache(_,_,_)).
+
+%%	cache_tag_frames(+VideoURL, +Game, +User)
+%
+%	Precompute the frames for each tag assinged to Video.
+
+cache_tag_frames(VideoURL, Game, User) :-
+	local_file_from_url(VideoURL, Video),
+	findall(Time, tag_entry_time(Game, VideoURL, User, Time), Times0),
+	sort(Times0, Times),
+	length(Times, Count),
+	debug(frame, 'caching ~w frames for ~w', [Count, VideoURL]),
+	forall(member(T, Times),
+	       video_frame(Video, T, _)).
+
+%%	tag_entry(?Game, ?Video, ?User, ?TagEntry, ?TagTerm, ?Tag,
+%%	?Time)
+%
+%	Enumerates the tag entries and their Terms entered by User
+%	for Video in Game.
+
+tag_entry_time(Game, Video, User, Time) :-
+ 	rdf(Game, sem:involves, Video),
+	rdf(TagEntry, sem:subEventOf, Game),
+	rdf(TagEntry, sem:hasActor, User),
+	rdf(TagEntry, pprime:playheadTime, Time0),
+	literal_to_number(Time0, Time).
+
+%%	serve_video_frame(+Request)
+%
+%	Reply PNG of the frame in Video at a given time point.
+
+serve_video_frame(Request) :-
+	http_parameters(Request,
+			[ url(URL,
+				[ description('URL of the video')]),
+			  time(Time,
+			       [ description('Time in the video')])
+			]),
+	debug(frame, 'Frame for ~w', [URL]),
+	video_url_frame(URL, Time, FrameFile),
+	http_reply_file(FrameFile, [mimetype('image/png'), unsafe(true)], Request).
+
+%%	video_url_frame(+URL, +Time, -File)
+%
+%	File is frame from URL at time point Time.
+%
+%	@TBD we use a very naive method that assumes a local copy of the
+%	VideoURL is available in the
+%	setting(video:frames:video_directory).
+
+video_url_frame(URL, Time, File) :-
+	local_file_from_url(URL, Video),
+	video_frame(Video, Time, File).
+
+local_file_from_url(URL, Video) :-
+	setting(video_directory, Dir0),
+	absolute_file_name(Dir0, Dir),
+	concat_atom(List, /, URL),
+	last(List, File),
+	concat_atom([Dir, '/', File], Video).
+
+%%	video_frame(+Video, +Time, -File)
+%
+%	Return thumbnail file for video frame at Time.
+
+video_frame(Video, Time, File) :-
+	video_frame_cache(Video, Time, File),
+	exists_file(File), !.
+video_frame(Video, Time, File) :-
+	video_frame_dir(Dir0),
+	atom_concat(Video, Time, Frame),
+	url_cache_file(Frame, Dir0, '', File0),
+	concat_atom([File0, '%d', '.jpg'], ExtractFile),
+	atom_concat(File0,  '1.jpg', File),
+ 	(   exists_file(File)
+	->  debug(frame, 'CACHE: ~w', [File])
+	;   debug(frame, 'Extracting frame from ~w at time ~w', [Video, Time]),
+	    extract_video_frame(Video, Time, ExtractFile)
+	),
+	assert(video_frame_cache(Video, Time, File)).
+
+%%	video_frame_dir(-AbsDir)
+%
+%	Directory for caching video frames.  Create if it doesn't exist.
+
+video_frame_dir(AbsDir) :-
+	setting(cache_directory, Dir), Dir \== '',
+	absolute_file_name(Dir, AbsDir),
+	ensure_directory(AbsDir).
+
+%%	extract_video_frame(+Video, +Time, +Frame)
+%
+%	 Use ffmpeg to extract a frame from Video at time point Time.
+%	 The operation is controlled by the following settings:
+%
+%	    * video_frames:frame_size
+%	    A term size(W,H) that specifies the size of Frame.
+%
+%	    * video_frames:frame_program
+%	    Name of the ffmpeg executable.
+
+extract_video_frame(Video, Time, File) :-
+	setting(frame_size, size(W, H)),
+	setting(frame_program, Prog),
+	convert_prog_term(Prog, Exe),
+	win_relative_path(Video, OSVideo),
+	win_relative_path(File, OSFile),
+
+	format(string(SizeOpt), '~wx~w', [W, H]),
+	debug(frame, 'Running ffmpeg ...', []),
+	process_create(Exe,
+		       [ '-vframes', '1', '-ss', Time,
+			 '-s', SizeOpt,
+			 '-i', file(OSVideo),
+			 file(OSFile)
+		       ],
+		       [ stderr(pipe(Error)),
+			 process(PID)
+		       ]),
+	read_stream_to_codes(Error, Messages),
+	close(Error),
+	process_wait(PID, Status),
+	(   Status == exit(0)
+	->  debug(frame, 'ffmpeg: ok', [])
+	;   debug(frame, 'ffmpeg: status ~w: ~s', [Status, Messages]),
+	    atom_codes(Text, Messages),
+	    catch(delete_file(File), _, true),
+	    throw(error(frame_extract_failed(Status, Text), _))
+	).
+
+convert_prog_term(Prog, Prog) :-
+	is_absolute_file_name(Prog), !.
+convert_prog_term(Prog, path(Prog)).
+
+
+
+
+
+%%	win_relative_path(+Path, -RelativePath) is det.
+%
+%	If Path is an absolute filename, translate it into a relative
+%	one to avoid too long commandlines on Windows.
+
+win_relative_path(Path, Local) :-
+	current_prolog_flag(windows, true),
+	is_absolute_file_name(Path), !,
+	relative_path(Path, Local).
+win_relative_path(Path, Path).
+
+%%	relative_path(+Path, -Relative)
+%
+%	Transform an absolute path  into  a   relative  one  to overcome
+%	limitations of the Windows commandline handling.
+
+relative_path(Path, RelPath) :-
+	working_directory(PWD, PWD),
+	relative_path(Path, PWD, RelPath), !.
+relative_path(Path, Path).
+
+relative_path(Path, RelTo, RelPath) :-
+	concat_atom(PL, /, Path),
+	concat_atom(RL, /, RelTo),
+	delete_common_prefix(PL, RL, PL1, PL2),
+	to_dot_dot(PL2, DotDot, PL1),
+	concat_atom(DotDot, /, RelPath).
+
+delete_common_prefix([H|T01], [H|T02], T1, T2) :- !,
+	delete_common_prefix(T01, T02, T1, T2).
+delete_common_prefix(T1, T2, T1, T2).
+
+to_dot_dot([], Tail, Tail).
+to_dot_dot([_], Tail, Tail) :- !.
+to_dot_dot([_|T0], ['..'|T], Tail) :-
+	to_dot_dot(T0, T, Tail).
+
+
+
+%%	ensure_directory(+Dir:atom)is det.
+%
+%	Create directory and -if  needed-   parents.  May  generate file
+%	system errors.
+
+ensure_directory(Dir) :-
+	exists_directory(Dir), !.
+ensure_directory(Dir) :-
+	file_directory_name(Dir, Parent),
+	Parent \== Dir,
+	ensure_directory(Parent),
+	make_directory(Dir).
diff --git a/applications/yaz_admin.pl b/applications/yaz_admin.pl
new file mode 100644
index 0000000..402e762
--- /dev/null
+++ b/applications/yaz_admin.pl
@@ -0,0 +1,29 @@
+:- module(yaz_admin,
+	  [ http_yaz_logout/1
+	  ]).
+
+:- 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(user(user_db)).
+
+:- use_module(library(yaz_util)).
+:- use_module(components(yaz_page)).
+:- use_module(applications(yaz_user)).
+:- use_module(applications(yaz_videos)).
+:- use_module(applications(yaz_tags)).
+
+:- http_handler(yaz(logout), http_yaz_logout, []).
+
+%%	http_yaz_logout(+Request)
+%
+%	Do logout and start at YAZ home page
+
+http_yaz_logout(Request) :-
+	(   logged_on(User, _),
+	    nonvar(User)
+	->  logout(User)
+	),
+	http_location_by_id(http_yaz_home, Home),
+	http_redirect(moved, Home, Request).
diff --git a/applications/yaz_annotate.pl b/applications/yaz_annotate.pl
new file mode 100644
index 0000000..6054954
--- /dev/null
+++ b/applications/yaz_annotate.pl
@@ -0,0 +1,173 @@
+:- module(annotate,
+	[ http_yaz_annotate/1
+	]).
+
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_parameters)).
+:- use_module(library(http/html_write)).
+:- use_module(library(http/http_path)).
+:- use_module(library(http/html_head)).
+:- use_module(library(http/http_json)).
+:- use_module(library(http/json)).
+:- use_module(library(http/http_session)).
+:- use_module(library(semweb/rdf_db)).
+:- 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)).
+
+:- http_handler(yaz(annotate), http_yaz_annotate, []).
+
+
+%%	http_yaz_annotate(+Request)
+%
+%       Emit the tags for a video.
+%
+%       @TBD show the tags that are already added.
+%       By same user, by all?
+
+http_yaz_annotate(Request) :-
+	ensure_logged_on(User),
+	http_parameters(Request,
+			[ video(Video,
+				[optional(true),
+				 description('URL of a video on webpage')]),
+			  title(Title,
+				[optional(true),
+				 description('Title of the webpage')])
+			]),
+	(   (var(Video);var(Title))
+	->  html_annotate_form(Video, Title)
+	;   create_user_process([rdf:type=pprime:'Annotation',
+				 opmv:used=Video
+				], _Process),
+	    add_resource_properties(Video, [dc:title=Title]),
+	    html_annotate_page(Video, Title, User)
+	).
+
+
+%%	html_annotate_form(?Video, ?Title)
+%
+%	Emit an html page with a form to submit a page for annotation.
+
+html_annotate_form(Video0, Title0) :-
+	var_to_atom(Video0, Video),
+	var_to_atom(Title0, Title),
+	reply_html_page(yaz,
+			[ title(['YAZ - annotate'])
+			],
+			[ \html_requires(css('annotate.css')),
+			  h2('Provide the URL of a page containing a Video'),
+			  form([div(class(inputline),
+				    [div(class(label), title),
+				     input([type(text), size(60), name(title), value(Title)])]),
+				div(class(inputline),
+				    [div(class(label), 'video URL'),
+				     input([type(text), size(60), name(video), value(Video)])]),
+				div(class(inputline),
+				    input([type(submit), value(annotate)]))
+			       ])
+			]).
+
+var_to_atom(X, X) :-
+	nonvar(X).
+var_to_atom(_, '').
+
+%%	html_annotate_form(+Video, +Title, +User)
+%
+%	Emit an html page with video annotation funtionality.
+%
+html_annotate_page(Video, Title, _User) :-
+	reply_html_page(yaz,
+			[ title(['YAZ - annotate ', Title])
+			],
+			[ \html_requires(css('annotate.css')),
+			  h2(class('video-title'), Title),
+			  div(class('videobox'),
+			      [ div(id(video), []),
+				div([id(annotate), style('margin-left:500px')],
+				    [ h4('Which people, organisations, locations and events occur in the video?'),
+					    input([id(search), size(40)])
+				    ])
+			      ]),
+			  ul(id(tags), []),
+			  script(type('text/javascript'),
+				 \jquery_annotate_script(Video))
+			]).
+
+jquery_annotate_script(Video) -->
+	{ http_absolute_location(js('videoplayer/'), FilePath, []),
+	  http_location_by_id(http_create_video_annotation, CreateAnnotation)
+	},
+	html_requires('http://freebaselibs.com/static/suggest/1.2.1/suggest.min.css'),
+	html_requires(js('jquery/css/flick/jquery-ui-1.8.4.custom.css')),
+	html_requires(js('jquery/jquery-1.4.2.min.js')),
+	html_requires(js('jquery/jquery-ui-1.8.4.custom.js')),
+	html_requires(js('videoplayer/jquery-videoplayer.js')),
+	html_requires(js('videoplayer/tagbar.js')),
+ 	html_requires('http://freebaselibs.com/static/suggest/1.2.1/suggest.min.js'),
+	html_requires(js('videoplayer/swfobject.js')),
+	html_requires(js('json2.js')),
+	html(\[
+'$("#video").videoplayer({
+    width: 480,
+    height: 320,
+    filepath:"',FilePath,'",
+    src:"',Video,'"
+});\n',
+
+'$("#search").suggest({
+    "suggest_new": "Suggest a new term"
+})\n',
+'.bind("fb-select", function(e, data) {
+      tagentry(data);
+})\n',
+'.bind("fb-select-new", function(e, label) {
+       tagentry({name:label});
+});\n',
+
+'$("#search").keypress(function(e) {
+     $("#video").videoplayer("pause");
+});\n',
+
+'function tagentry(data) {
+      var video = "', Video, '",
+          startTime  = $("#video").videoplayer("getTime"),
+          tagtype = data["n:type"] ? data["n:type"].id : null,
+	  typelabel = data["n:type"] ? data["n:type"].name : null;\n',
+'    $.ajax({ url: "',CreateAnnotation,'",
+	      dataType: "json",
+	      data: {\n',
+'		value: JSON.stringify({value:data.id, type:"uri"}),
+		//label: data.name,
+		//type: tagtype,
+		//type_label: typelabel,
+		video: video,
+		time: startTime*1000
+	     },\n',
+'	     success: addTagBar
+    });
+};\n',
+
+'$("#tags").sortable();\n',
+
+'function addTagBar(data) {\n',
+'    var startTime = Math.round(data.time/1000);\n',
+'    $("#search").val("");\n',
+'    $("#tags")
+     .prepend($("<li></li>")\n',
+'        .tagbar({ label: data.label,
+		   start: startTime,
+		   end: startTime+10,
+		   max: $("#video").videoplayer("getDuration")
+		 }));\n',
+'};\n'
+	      ]).
+
+
+
+
+
+
diff --git a/applications/yaz_game.pl b/applications/yaz_game.pl
new file mode 100644
index 0000000..28b44c2
--- /dev/null
+++ b/applications/yaz_game.pl
@@ -0,0 +1,744 @@
+:- module(yaz_game,
+	  [ http_yaz_game/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(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(user_process)).
+:- use_module(library(video_annotation)).
+
+:- use_module(components(label)).
+:- use_module(components(yaz_page)).
+
+:- setting(match_interval, integer, 10000,
+	   'Interval in which tags can be matched (in miliseconds)').
+:- setting(max_player_count, integer, 8,
+	   'Maximum number of players before auto starting a game').
+:- setting(ac, boolean, false,
+	   'Use autocompletion').
+:- setting(request_interval, integer, 2000,
+	   'Interval between requests to the server (in miliseconds)').
+:- setting(video_buffer_time, integer, 1,
+	   'Expect delay in load of page and start of Video (in seconds)').
+
+:- dynamic
+	player_score/3.
+
+:- rdf_meta
+        cond_object_assert(r,r,o,r).
+
+channel('http://g.bbcredux.com/programme/bbcone/2010-11-21/22-00-00',
+	'http://g.bbcredux.com/programme/5542126155790075626/download/12340-1295719806-48faefbd0b0f9057050098ef47daf3a5/flash.flv',
+	'BBC News 21 Nov 2010 22:00',
+	1101).
+
+
+:- http_handler(yaz(game), http_yaz_game, []).
+:- http_handler(root(game), http_yaz_game, []). % shortcut
+
+%%	http_yaz_game(+Request)
+%
+%       Emit a web page with a video tagging game.
+
+http_yaz_game(Request) :-
+ 	ensure_logged_on(User0),
+	user_property(User0, url(User)),
+	http_parameters(Request,
+			[  url(URL,
+				[optional(true),
+				 descritpion('URL of a video to start a game with')]),
+			   video(Video,
+				 [optional(true),
+				  description('Video source of the URL')]),
+			   title(Title,
+				 [optional(true),
+				  description('Title of URL')]),
+			   game(Game,
+				[optional(true), description('URL of current Game')])
+			]),
+	(   var(Game),
+	    var(URL)
+	->  findall(channel(U, V, T),
+		    channel(U, V, T, _), Channels),
+	    html_home_page(Channels)
+	;   var(Game),
+	    nonvar(URL)
+	->  create_game(URL, User, Game, [video(Video),title(Title)]),
+	    html_waiting_page(Game, URL, User)
+	;   setting(match_interval, Interval),
+	    join_game(Game, User),
+	    game_video_start(Game, URL, PlayHead),
+	    PlayerObj = {player:P, name:Name, score:Score},
+	    findall(PlayerObj, active_player(Game, P, Name, Score), Players),
+	    TagObj = json([tag=Tag, label=Label, match=Match, type=Type, order=Order]),
+	    findall(Time-TagObj, user_annotation(Game, User, Interval, Tag, Label, Time, Type, Match, Order), Tags0),
+	    keysort(Tags0, Tags1),
+	    reverse(Tags1, Tags2),
+	    pairs_values(Tags2, Tags),
+	    html_game_page(Game, URL, User, PlayHead, Players, Tags)
+	).
+
+%%	html_home_page(+Channels)
+%
+%	Emit html page with a list of video channels.
+
+html_home_page(Channels) :-
+	reply_html_page(yaz,
+			[ title(['YAZ tagging game'])
+			],
+			[ \html_requires(css('game.css')),
+			  div([class(topic), id(channels)],
+			      [ div(class(header),
+				    h2('Select a video')),
+				div(class(body),
+				    \html_channels(Channels))
+			      ]),
+			  div([class(topic), id(new)],
+			      [ div(class(header),
+				    h2('Start game with a new video')),
+				div(class(body),
+				    \html_new_game)
+			      ]),
+			  script(type('text/javascript'), [])
+ 			]).
+
+html_channels([]) --> !.
+html_channels([channel(URL, Video, Title)|Vs]) -->
+	{ http_link_to_id(serve_video_frame, [url(Video),time(5)], Frame),
+	  (   waiting_game(URL, _Game, Players)
+	  ->  length(Players, Count)
+	  ;   Count = 0,
+	      Players = []
+	  ),
+	  http_link_to_id(http_yaz_game, [url(URL)], Link)
+  	},
+	html(div(class(channel),
+		 [ h4(Title),
+		   div(class('thumb-container video'),
+		       [ a(href(Link),
+			   img([title(Title), src(Frame), alt(Title)])),
+			 div(class(players),
+			     \html_waiting_count(Count))
+		       ])
+		 ])),
+	html_channels(Vs).
+
+html_waiting_count(0) --> !.
+html_waiting_count(1) --> !,
+	html([ 1, ' player waiting']).
+html_waiting_count(N) --> !,
+	html([ N, ' players waiting']).
+
+waiting_game(URL, Game, Players) :-
+	rdf(Game, opmv:used, URL),
+	\+ rdf(Game, opmv:wasStartedAt, _),
+	!,
+	findall(P, active_player(Game, P, _, _), Players).
+
+html_new_game -->
+	html(form([div(class(inputline),
+		       [div(class(label), title),
+			input([type(text), size(30), name(title)])]),
+		   div(class(inputline),
+		       [div(class(label), 'page URL'),
+			input([type(text), size(30), name(url)])]),
+		   div(class(inputline),
+		       [div(class(label), 'video source'),
+			input([type(text), size(30), name(video)])]),
+		   div(class(inputline),
+		       input([type(submit), value(play)]))
+		  ])).
+
+
+%%	html_waiting_page(+Game, +URL, +User)
+%
+%	Emit html page with a list of video channels.
+
+html_waiting_page(Game, URL, User) :-
+	display_label(URL, Title),
+	video_source(URL, Video),
+	http_link_to_id(serve_video_frame, [url(Video),time(5)], Frame),
+	findall({player:P,name:N}, active_player(Game, P, N, _), Players),
+	reply_html_page(yaz,
+			[ title(['YAZ tagging game - ', Title])
+			],
+			[ \html_requires(css('game.css')),
+			  h2(Title),
+			  div(id(waiting),
+			      [ div([class('thumb-container'), id('video')],
+				    img([title(Title), alt(Title), src(Frame)])),
+				      div(id(players),
+					  [ h4(class(message), ['Current players'])
+					  ])
+			      ]),
+			  div(id(options),
+			      [ \html_creator_options(Game, User)
+			      ]),
+ 			 script(type('text/javascript'),
+			       \html_waiting_yui(Game, Players, User))
+			]).
+
+html_creator_options(Game, User) -->
+	{ user_process_creator(Game, User),
+	  http_link_to_id(http_yaz_game, [game(Game)], Link)
+	},
+	html(a(href(Link), 'start the game')).
+html_creator_options(_, _) --> !.
+
+html_waiting_yui(Game, Players, User) -->
+	{  http_location_by_id(http_waiting_data, DataServer),
+	   http_link_to_id(http_yaz_game, [game(Game)], GameLink),
+	   http_absolute_location(js('game/players.js'), GamePlayers, []),
+	   setting(max_player_count, Max)
+	},
+  	js_yui3([{modules:{'game-players':{fullpath:GamePlayers}}}],
+		[node,'base','io-base','json-parse','querystring-stringify-simple',
+		 'game-players'
+ 		],
+		[ \js_function_decl(fetchData, [],
+				    \[
+'    Y.io("',DataServer,'", {data:{game:"',Game,'",user:"',User,'"},
+			     on:{success:function(id,o) {
+				   var result = Y.JSON.parse(o.responseText);
+				   if(result.start) { window.location.href="',GameLink,'" }
+				   else { gamePlayers.updatePlayers(result.players)}
+				 }}})\n'
+				     ]),
+		  \js_new(gamePlayers,
+			  'Y.mazzle.GamePlayers'({container:'#players',
+						  user:User,
+						  players:Players,
+						  maxNumberOfPlayers:Max,
+						  emptyShow:symbol(true)
+						 })),
+		  %\js_call(fetchData)
+   		  \js_call('Y.later'(500, symbol('Y'), symbol(fetchData), {}, symbol(true)))
+  		]).
+
+
+%%	html_game_page(+Game, +URL, +User, +PlayHead, +Player, +Tags)
+%
+%	Emit an html page with an active tagging game.
+
+html_game_page(Game, URL, User, PlayHead, Players, Tags) :-
+	display_label(URL, Title),
+	reply_html_page(yaz,
+			[ title(['YAZ tagging game - ', Title])
+			],
+			[ \html_requires(css('game.css')),
+			  \html_page_containers(Title),
+			  script(type('text/javascript'),
+				 \html_page_yui(Game, URL, User, PlayHead, Players, Tags))
+			]).
+
+html_page_containers(Title) -->
+ 	html([ h2(Title),
+	       div(id(main),
+		   [ div(id(videoplayer), []),
+		     div(class(input),
+			 [ input([type(text), id(taginput)]),
+			   div(id(suggest), []),
+ 			   div([id(tags)], [])
+			 ])
+		   ]),
+	       div(id(players), [])
+	     ]).
+
+html_page_yui(Game, URL, User, PlayHead, Players, Tags) -->
+	{ http_absolute_location(js('videoplayer/'), FilePath, []),
+	  http_absolute_location(js('videoplayer/videoplayer.js'), VideoPlayer, []),
+	  http_absolute_location(js('game/input.js'), GameInput, []),
+	  http_absolute_location(js('game/players.js'), GamePlayers, []),
+	  http_location_by_id(http_game_data, DataServer),
+	  setting(request_interval, RequestInterval),
+	  video_source(URL, Video)
+	},
+	html_requires(js('videoplayer/swfobject.js')),
+ 	js_yui3([{modules:{'game-players':{fullpath:GamePlayers},
+			   'video-player':{fullpath:VideoPlayer},
+			   'game-input':{fullpath:GameInput}
+ 			  }}
+		],
+		[node,event,widget,anim,
+		 'io-base','json-parse','querystring-stringify-simple',
+		 'video-player','game-input','game-players'
+		],
+		[ \js_new(videoPlayer,
+			  'Y.mazzle.VideoPlayer'({filepath:FilePath,
+ 						  src:Video,
+						  width:640,
+						  height:380,
+						  controls:symbol(false),
+						  autoplay:symbol(true),
+						  start:PlayHead
+						 })),
+		  \js_new(gameInput,
+			  'Y.mazzle.GameInput'({input:'#taginput',
+						output:'#tags',
+						tags:Tags
+ 					       })),
+		  \js_new(gamePlayers,
+			  'Y.mazzle.GamePlayers'({container:'#players',
+						  user:User,
+						  players:Players
+						 })),
+		  \js_support_functions(Game, User, DataServer),
+		  \js_call('Y.later'(RequestInterval, symbol('Y'),
+				     symbol(fetchData), symbol({}), symbol(true))),
+		  \js_call('videoPlayer.render'('#videoplayer')),
+		  \js_input_method
+ 		]).
+
+js_support_functions(Game, User, DataServer) -->
+	js_function_decl(fetchData, [tag],
+			 \[
+'   var data = {game:"',Game,'",user:"',User,'",playhead:videoPlayer.getTime()*1000};
+    if(tag.label) {data.tag = tag.label}
+    if(tag.uri) {data.taguri = tag.uri}
+    Y.io("',DataServer,'", {data: data,
+			    on: {success:handleResponse}
+			   });\n'
+			  ]),
+
+	js_function_decl(handleResponse, [id, o],
+			 \[
+'    var data = Y.JSON.parse(o.responseText);
+    gamePlayers.updatePlayers(data.players);
+    gameInput.updateTags(data.tags);\n'
+			  ]).
+
+js_input_method -->
+	{ setting(ac, true) },
+	!,
+	html(['gameInput.set("autoAddTag", false);\n',
+	      \js_freebase_suggest
+	     ]).
+js_input_method -->
+	js_yui3_on(gameInput, enter, fetchData).
+
+js_freebase_suggest -->
+	html_requires('http://freebaselibs.com/static/suggest/1.2.1/suggest.min.css'),
+	html_requires(js('jquery/jquery-1.4.2.min.js')),
+   	html_requires('http://freebaselibs.com/static/suggest/1.2.1/suggest.min.js'),
+ 	html(\[
+'$("#taginput").suggest({parent:"#suggest",
+			 soft:true,
+			 required:true,
+			 nomatch:"",
+			 status:["","","",""],
+			 flyout:false})\n',
+'.bind("fb-select", function(e, data) {
+     var tag = 	{label:data.name, uri:data.id};
+     fetchData(tag);
+     gameInput.addTag(tag);
+})\n',
+'.bind("fb-required", function(e) {
+    if($("#taginput:focus").length>0) {
+	var tag = {label:$("#taginput").val()};
+        $(".fbs-pane").css("display", "none");
+        fetchData(tag);
+        gameInput.addTag(tag);}
+ });\n'
+	      ]).
+
+
+		 /*******************************
+		 *	    game events		*
+		 *******************************/
+
+%%	create_game(+URL, +Player, -Game, +Options)
+%
+%	Player starts a new game for Video.
+
+create_game(URL, Player, Game, _Options) :-
+	waiting_game(URL, Game, _),
+	!,
+	(   user_process_creator(Game, Player)
+	->  new_player_score(Game, Player) % just to make sure
+	;   join_game(Game, Player)
+	).
+create_game(URL, Player, Game, Options) :-
+	option(video(Video), Options, _),
+	option(title(Title), Options, _),
+   	create_user_process([rdf:type=pprime:'Game',
+			     opmv:used=URL
+			    ], Game),
+	new_player_score(Game, Player),
+	add_video(URL, Video, Title, _),
+	debug(game, 'Game ~w created for ~w by ~w', [Game,Video,Player]).
+
+new_player_score(Game, Player) :-
+	(   player_score(Game, Player, _)
+	->  retractall(player_score(Game, Player, _))
+	;   true
+	),
+	assert(player_score(Game, Player, 0)).
+
+%%	game_video_start(+Game, -URL, -PlayHead) is det
+%
+%	True if PlayHead is the current time of the Video. The PlayHead
+%	is determined by the startTime of the game. If no startTime is
+%	defined the Game process is started.
+
+game_video_start(Game, URL, PlayHead) :-
+	rdf(Game, opmv:used, URL),
+	!,
+	setting(video_buffer_time, BufferTime),
+	(   rdf(Game, opmv:wasStartedAt, literal(type(_, XMLDateTime)))
+	->  parse_time(XMLDateTime, StartTime),
+	    get_time(Time),
+	    PlayHead is (Time - StartTime)+BufferTime
+	;   start_user_process(Game),
+	    PlayHead = BufferTime
+	).
+game_video_start(_Game, '', 0). % for testing
+
+%%	join_game(+Game, +Player) is det
+%
+%	Asserts that Player has joined game.
+
+join_game(Game, Player) :-
+ 	(   user_process_joined(Game, Player)
+	->  set_active_process(Game)
+	;   join_user_process(Game),
+	    debug(game, 'Game ~w joined by ~w', [Game, Player]),
+	    new_player_score(Game, Player)
+	).
+
+%%	quit_game(+Game, +Player)
+%
+%	Assert quit event.
+%
+%	@TBD fix this!!!
+
+quit_game(Game, Player) :-
+	left_game(Game, Player),
+	!.
+quit_game(Game, Player) :-
+	debug(game, 'Quit game ~w by ~w', [Game, Player]),
+	get_time(Time),
+	rdf_bnode(QuitEvent),
+	player_score(Game, Player, Score),
+	rdf_transaction(assert_quit_event(QuitEvent, Game, Player, Score, Time)),
+	retractall(player_score(Game, Player, Score)),
+	debug(game, 'Game quit with event ~w', [QuitEvent]).
+
+assert_quit_event(ID, Game, Player, Score, Time) :-
+	get_time(Time),
+	rdf_assert(ID, sem:subEventOf, Game, Game),
+	rdf_assert(ID, rdf:type, pprime:'QuitGame', Game),
+	rdf_assert(ID, sem:hasActor, Player, Game),
+	rdf_assert(ID, sem:timeStampedAt, literal(Time), Game),
+	rdf_assert(ID, pprime:finalScore, literal(Score), Game).
+
+
+%%	add_tag(+Game, +Player, +Tag, +TagURI, +PlayHeadTime)
+%
+%	Asserts that User has entered a Tag.
+
+add_tag(Game, Player, TagLabel, TagURI, PlayHead) :-
+	rdf(Game, opmv:used, URL),
+	(   nonvar(TagURI)
+	->  Tag = TagURI
+	;   Tag = TagLabel
+	),
+	create_video_annotation(URL, literal(Tag), PlayHead, Player, AnnotationId),
+	debug(game, 'Added tag ~w at time ~w by ~w (~w)', [Tag, PlayHead, Player, AnnotationId]).
+
+%%	active_player(+Game, -Player, -Name, Score)
+%
+%	Player is active in Game.
+
+active_player(Game, Player, Name, Score) :-
+	user_process_joined(Game, Player),
+	player_score(Game, Player, Score), % this would be retracted if the user has left the game
+	display_label(Player, Name).
+
+%%	left_game(+Game, -Player)
+%
+%	Player has stopped playing Game.
+
+left_game(Game, Player) :-
+	rdf(QuitEvent, rdf:type, pprime:'QuitGame', Game),
+ 	rdf(QuitEvent, sem:hasActor, Player, Game).
+
+
+%%	user_annotation(+Game, +User, +Interval, -Tag, -Time, -Type,
+%%	-Match, -Order)
+%
+%	Tag is entered by User during Game.
+
+user_annotation(Game, User, Interval, Tag, Label, Time, Type, Match, Order) :-
+ 	rdf(Annotation, pprime:creator, User, Game),
+	rdf(Annotation, rdf:value, TagTerm),
+	rdf(Annotation, pprime:videoPlayhead, Time0),
+	literal_to_number(Time0, Time),
+	tag_type(TagTerm, Type, Tag, Label),
+ 	matching_type(Game, User, TagTerm, Time, Interval, Match, Order).
+
+tag_type(literal(Tag), literal, Tag, Tag) :- !.
+tag_type(Tag, uri, Tag, Label) :-
+	rdf(Tag, rdfs:label, literal(Label)).
+
+%%	user_matched_tag(+Game, +User, +PlayHead, +Interval, -Tag,
+%%	-Label, -Type, -Match, Order)
+%
+%	Tag is entered by User during Game.
+
+user_matched_tag(Game, User, PlayHead, Interval, Tag, Label, Type, Match, Order) :-
+	rdf(Annotation, pprime:creator, User, Game),
+	rdf(Annotation, pprime:videoPlayhead, literal(Time0), Game),
+	literal_to_number(Time0, Time),
+	Time > PlayHead-Interval,
+	rdf(Annotation, rdf:value, TagTerm, Game),
+	tag_type(TagTerm, Type, Tag, Label),
+	matching_type(Game, User, TagTerm, Time, Interval, Match, Order),
+	Match \== @false.
+
+%%	matching_type(+Game, +User, +Tag, +Time, +Interval, -MatchType,
+%%	-Order)
+%
+%	Matchtype is one of [....] indicating how Tag can be matched.
+
+matching_type(Game, User, Tag, Time, Interval, MatchType, Order) :-
+	match_existing_tags(Game, User, Tag, Time, Interval, Matches),
+	(   Matches = []
+	->  MatchType = @false,
+	    Order = 0
+	;   user_best_match(Matches, MatchType),
+	    tag_order(Matches, 1, Order)
+ 	).
+
+tag_order([], N, N).
+tag_order([match(_, _, Diff, _)|_T], N, N) :-
+	Diff =< 0, !.
+tag_order([_|T], N0, N) :-
+	N1 is N0+1,
+	tag_order(T, N1, N).
+
+%%	tag_match(+Game, +User, +Tag, +Time, +Interval, -Player,
+%%	-Diff)
+%
+%	Returns players that entered the same Tag within Interval of
+%	Time.
+
+tag_match(Game, User, Tag, PlayHead, Interval, Player, Diff, exact, Type) :-
+	matching_annotation(Game, Tag, Annotation, Type),
+ 	rdf(Annotation, pprime:videoPlayhead, literal(Time0), Game),
+	literal_to_number(Time0, Time),
+	Diff is PlayHead-Time,
+	Interval >= abs(Diff),
+	rdf(Annotation, pprime:creator, Player, Game),
+	User \== Player.
+
+matching_annotation(Game, Tag, Annotation, Type) :-
+	rdf(Annotation, rdf:value, Tag, Game),
+	(   Tag = literal(_)
+	->  Type = literal
+	;   Type = uri
+	).
+matching_annotation(Game, literal(Tag), Annotation, uri) :- !,
+	rdf(Annotation, rdf:value, TagURI, Game),
+	rdf(TagURI, rdfs:label, literal(exact(Tag),_)).
+matching_annotation(Game, TagURI, Annotation, literal) :-
+	rdf(TagURI, rdfs:label, literal(Tag)),
+	rdf(Annotation, sem:involves, literal(exact(Tag),_), Game).
+
+
+:- http_handler(yaz('gamedata'), http_game_data, []).
+
+%%	http_game_data(+Request)
+%
+%	Return JSON object with players in a game.
+
+http_game_data(Request) :-
+ 	http_parameters(Request,
+			[  game(Game,
+				[uri, description('URL of current Game')]),
+			   user(User,
+				[uri, description('URL of current User')]),
+			   playhead(Playhead,
+				[number, description('Current time of the video play head (in miliseconds)')]),
+			   tag(Tag,
+			       [optional(true),
+				description('Optionally a new tag can be added')]),
+			   taguri(TagURI,
+				  [optional(true),
+				   description('Optionally the new tag can have a URI')])
+			]),
+	setting(match_interval, Interval),
+	(   nonvar(Tag)
+ 	->  add_tag(Game, User, Tag, TagURI, Playhead),
+	    update_scores(Game, User, Tag, TagURI, Playhead, Interval)
+	;   true
+	),
+
+	PlayerObj = json([player=P, name=Name, score=Score]),
+	findall(PlayerObj,
+		active_player(Game, P, Name, Score),
+		Players),
+
+	TagObj = json([tag=T, label=L, type=Type, match=Match, order=Order]),
+	findall(TagObj,
+		user_matched_tag(Game, User, Playhead, Interval, T, L, Type, Match, Order),
+		Tags),
+
+	reply_json(json([user=User, players=Players, tags=Tags])).
+
+
+%%	update_scores(+Game, +User, +Tag, +TagURI, +Playhead, +Interval)
+%
+%	Find matching tags within interval of PlayHead and update player
+%	scores.
+
+update_scores(Game, User, TagL, TagURI, Playhead, Interval) :-
+	(   nonvar(TagURI)
+	->  Tag = TagURI,
+	    Type = uri
+	;   Tag = literal(TagL),
+	    Type = literal
+	),
+	match_existing_tags(Game, User, Tag, Playhead, Interval, Matches),
+	(   Matches = []
+	->  true
+	;   length(Matches, C0),
+	    Total is C0+1,
+	    update_player_scores(Matches, 1, Total, Game),
+	    user_best_match(Matches, Match),
+	    tag_match_points(Match, Type, Total, 0, Total, Points),
+	    update_player_score(Game, User, Points)
+ 	).
+
+user_best_match(Matches, Match) :-
+	maplist(user_match, Matches, Pairs0),
+	keysort(Pairs0, Pairs1),
+	reverse(Pairs1, [_Points-Match|_]).
+
+user_match(match(Match,_,_,_), P-Match) :-
+	(   Match = generic
+	->  match_points(specific, P)
+	;   match_points(Match, P)
+	).
+
+%%	match_existing_tags(+Game, +User, +Tag, +Playhead, +Interval,
+%%	-Matches)
+%
+%	Returns all matching tag within Interval of Playhead
+
+match_existing_tags(Game, User, Tag, Playhead, Interval, Matches) :-
+	findall(Diff-match(Match, Type, Diff, Player),
+		tag_match(Game, User, Tag, Playhead, Interval, Player, Diff, Match, Type),
+		Matches0),
+	keysort(Matches0, Matches1),
+	reverse(Matches1, Matches2),
+	pairs_values(Matches2, Matches).
+
+%%	update_players_scores(+Matches, +EntryOrder, +TotalMatches,
+%%	+Game)
+%
+%	Compute the scores for each player in Matches and update
+%	their score according to the type of Match.
+
+update_player_scores([], _, _, _).
+update_player_scores([match(Match,Type,Diff,Player)|Ms], N, Count, Game) :-
+	N1 is N + 1,
+  	tag_match_points(Match, Type, N, Diff, Count, Points),
+	update_player_score(Game, Player, Points),
+	update_player_scores(Ms, N1, Count, Game).
+
+update_player_score(Game, Player, Points) :-
+	player_score(Game, Player, OldScore),
+	retractall(player_score(Game, Player, OldScore)),
+	NewScore is OldScore+Points,
+	assert(player_score(Game, Player, NewScore)).
+
+tag_match_points(Match, Type, Order, _Diff, _Total, Points) :-
+	match_points(Match, MatchPoints),
+	type_points(Type, TypePoints),
+	Points0 is MatchPoints + TypePoints,
+ 	(   Order = 1
+	->  Points is Points0*2
+	;   Points = Points0
+	).
+
+match_points(exact, 50).
+match_points(stem, 50).
+match_points(specific, 100).
+match_points(generic, 20).
+match_points(related, 20).
+
+type_points(uri, 50).
+type_points(literal, 0).
+
+
+:- http_handler(yaz('waitingdata'), http_waiting_data, []).
+
+%%	http_waiting_data(+Request)
+%
+%	Return JSON object with waiting players in game.
+
+http_waiting_data(Request) :-
+ 	http_parameters(Request,
+			[  game(Game,
+				[uri, description('URL of current Game')])
+ 			]),
+	(   rdf(Game, opmv:wasStartedAt, _)
+	->  reply_json(json([start= @true]))
+	;   PlayerObj = json([player=P, name=N]),
+	    findall(PlayerObj, active_player(Game, P, N, _), Players),
+	    length(Players, Count),
+	    setting(max_player_count, Max),
+	    (   Count >= Max
+	    ->  reply_json(json([start= @true]))
+	    ;   reply_json(json([players=Players]))
+	    )
+	).
+
+
+%%	assert_channel_info
+%
+%	Store info of channel videos in RDF.
+
+assert_channel_info :-
+	rdf_transaction((   channel(URL, Video, Title, Duration),
+			    add_video(URL, Video, Title, Duration),
+ 			    fail
+			;   true
+			)).
+
+%%	add_video(+URL, ?Video, ?Title, ?Duration)
+%
+%	Store video properties in RDF.
+
+add_video(URL, Video, Title, Duration) :-
+	%rdf_retractall(URL, _, _),
+	cond_object_assert(URL, pprime:video, Video, video),
+	cond_object_assert(URL, dc:title, literal(Title), video),
+	cond_object_assert(URL, pprime:duration, literal(Duration), video).
+
+cond_object_assert(S,P,O,G) :-
+	ground(O),
+	!,
+	(   rdf(S,P,O)
+	->  true
+	;   rdf_assert(S,P,O,G)
+	).
+cond_object_assert(_,_,_,_).
+
+
+:- assert_channel_info.
diff --git a/applications/yaz_game_recap.pl b/applications/yaz_game_recap.pl
new file mode 100644
index 0000000..d37922e
--- /dev/null
+++ b/applications/yaz_game_recap.pl
@@ -0,0 +1,342 @@
+:- module(yaz_game_recap,
+	  [  ]).
+
+:- 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(user_process)).
+:- use_module(library(video_annotation)).
+
+:- use_module(components(label)).
+:- use_module(components(yaz_page)).
+
+:- http_handler(yaz(gamerecap), http_yaz_game_recap, []).
+:- http_handler(yaz('data/update'), http_yaz_api_update_tags, []).
+:- http_handler(yaz('data/provenance'), http_yaz_api_provenance, []).
+
+%%	http_yaz_game_recap(+Request)
+%
+%	Emit the a video player with a tag carousel running along side
+%	of it.
+
+http_yaz_game_recap(Request) :-
+	ensure_logged_on(_),
+	http_parameters(Request,
+			[ video(Video,
+				[description('Current video')]),
+			  process(Process,
+			       [optional(true), desription('When set only annotations within this process are shown')]),
+			  user(User,
+				[optional(true), description('When set only annotations created by this user are shown')]),
+			  interval(Interval,
+				   [default(0), number,
+				    description('When set one entry per tag is returned in interval (in milliseconds)')]),
+			  confirmed(Confirmed,
+				    [boolean, default(false),
+				     description('When true only tags that are entered by >1 user are shown')]),
+			  limit(Limit,
+				[default(1000), number,
+				 description('limit number of tags shown')]),
+			  start(StartTime,
+				[default(0),description('Start time of the video')])
+			]),
+	Options = [process(Process),
+		   user(User),
+		   interval(Interval),
+		   confirmed(Confirmed)
+		  ],
+	create_user_process([rdf:type=pprime:'GameRecap',
+			     opmv:used=Video
+			    ], _Process),
+	video_annotations(Video, Annotations0, Options),
+	sort_by_arg(Annotations0, 2, Annotations1),
+	list_limit(Annotations1, Limit, Annotations, _),
+	html_video_page(Video, Annotations, StartTime, Options).
+
+
+%%	html_video_page(+Video, +Annotations, +StartTime, +Options)
+%
+%	Emit an HTML page with a video player and a tag carousel.
+
+html_video_page(Video, Annotations, StartTime, Options) :-
+	reply_html_page(yaz,
+			[ title(['YAZ - ', Video])
+			],
+			[ \html_requires(css('player.css')),
+ 			  div(class('video-results'),
+			      \html_video_page_containers(Video, Options)),
+			 script(type('text/javascript'),
+				\html_video_page_yui(Video, Annotations, StartTime, Options))
+			]).
+
+html_video_page_containers(Video, _Options) -->
+	{ display_label(Video, Title)
+  	},
+	html([ h2(Title),
+ 	       div(id(video),
+		   [ div(id(tagplayer), []),
+		     div(id(videoplayer), [])
+		   ]),
+	       div(style('float:left;width:50%'),
+		   [ h4(['Pending actions ',
+			 input([id(submitChanges), type(submit), value(submit)])
+			]),
+		     div(id(changehistory), [])
+		   ]),
+	       div(style('float:left;width:50%'),
+		   [ h4(['Provenance']),
+		     div(id(provenance), [])
+		   ])
+ 	     ]).
+
+:- json_object
+     i(uri:atom, time:number),
+     uri(value:uri) + [type=uri],
+     literal(lang:atom, value:_) + [type=literal],
+     literal(type:atom, value:_) + [type=literal],
+     literal(value:atom) + [type=literal],
+     annotation(tag:_, startTime:number, endTime:number, annotations:list).
+
+html_video_page_yui(Video, Annotations, StartTime, _Options) -->
+	{ video_source(Video, Src),
+ 	  http_absolute_location(js('videoplayer/'), FilePath, []),
+	  http_absolute_location(js('videoplayer/videoplayer.js'), VideoPlayer, []),
+	  http_absolute_location(js('tagcarousel/tagcarousel.js'), TagCarousel, []),
+	  http_absolute_location(js('changehistory/changehistory.js'), ChangeHistory, []),
+	  prolog_to_json(Annotations, JSONTags)
+   	},
+	html_requires(js('videoplayer/swfobject.js')),
+ 	js_yui3([{modules:{'video-player':{fullpath:VideoPlayer},
+			   'tag-carousel':{fullpath:TagCarousel},
+			   'change-history':{fullpath:ChangeHistory}
+			  }}
+		],
+		[node,event,widget,anim,
+		 'querystring-stringify-simple','io','json',
+  		 'video-player','tag-carousel','change-history'
+ 		],
+		[ \js_new(videoPlayer,
+			  'Y.mazzle.VideoPlayer'({filepath:FilePath,
+ 						  src:Src,
+						  width:640,
+						  height:480,
+						  autoplay:symbol(false),
+						  controls:symbol(true),
+ 						  start:StartTime
+						 })),
+		  \js_new(tagCarousel,
+			  'Y.mazzle.TagCarousel'({tags:JSONTags,
+						  height:480,
+						  width:200,
+						  edit:true,
+						  remove:true
+						 })),
+		  \js_new(changeHistory,
+			  'Y.mazzle.ChangeHistory'({height:200,
+						    width:300
+ 						 })),
+  		  'var oldTime;\n',
+ 		  \js_call('videoPlayer.render'('#videoplayer')),
+		  \js_call('tagCarousel.render'('#tagplayer')),
+		  \js_call('changeHistory.render'('#changehistory')),
+  		  \js_yui3_on(videoPlayer, timeChange, \js_video_time_change),
+		  \js_yui3_on(tagCarousel, itemSelect, \js_tag_select),
+ 		  \js_yui3_on(tagCarousel, itemSelect, \js_fetch_provenance),
+		  \js_yui3_event(tagCarousel, 'on', itemUpdate, 'changeHistory.addActionHandler', changeHistory),
+ 		  \js_yui3_event(changeHistory, 'on', undo, 'tagCarousel.undo', tagCarousel),
+		  \js_yui3_on('Y.one("#submitChanges")', click, \js_submit_changes(Video))
+   		]).
+
+js_tag_select -->
+	js_function([e],
+		    \[
+'    if(e.tag.startTime)
+     { var time = (e.tag.startTime/1000)-2;
+       videoPlayer.setTime(time, true);
+     }\n'
+		    ]).
+
+js_video_time_change -->
+	js_function([e],
+		    \[
+'    var time = Math.round(e.time);
+     if(time!==oldTime) {
+	 oldTime = time;
+	 tagCarousel.focusTime(Math.round(e.time)+1);
+     }\n'
+		    ]).
+
+js_submit_changes(Video) -->
+	{ http_location_by_id(http_yaz_api_update_tags, TagUpdateServer)
+	},
+	js_function([e],
+		    [
+'    var actions = Y.JSON.stringify(changeHistory.getActiveActions());\n',
+     \js_call('Y.io'(TagUpdateServer, {method:'POST',
+				       data:{video:Video,
+					     action:symbol(actions)},
+				       on:{success:symbol('changeHistory.disableAll')},
+				       context:symbol(changeHistory)
+				      }))
+		     ]).
+
+js_fetch_provenance -->
+	{ http_location_by_id(http_yaz_api_provenance, ProvenanceServer)
+	},
+	js_function([e],
+		    \[
+'    var uris = [],
+	 as = e.tag.annotations;
+     for(var i=0;i<as.length;i++) {
+	 uris.push(as[i].uri);
+     }\n',
+'    Y.io("',ProvenanceServer,'", {data:{annotation:uris},
+				   on:{success: function(id,o) {
+					  Y.one("#provenance").setContent(o.responseText);
+							    }
+				      }
+				  })\n'
+		     ]).
+
+
+
+%%	http_yaz_api_update_tags(+Request)
+%
+%	Handler for POST submission of tag modifications.
+
+http_yaz_api_update_tags(Request) :-
+ 	ensure_logged_on(_),
+	http_parameters(Request,
+			[ video(Video,
+				[description('URL of video')]),
+			  action(Actions,
+				 [jsonaction,description('Array of tag updates')])
+
+			]),
+	debug(yaz(update), '~w', Actions),
+	process_actions(Actions, Video),
+ 	reply_json(json([success='updates saved',
+ 			 video=Video
+ 			])).
+
+http:convert_parameter(jsonaction, Atom, Term) :-
+	atom_json_term(Atom, JSON, []),
+	json_to_prolog(JSON, Term).
+
+:- json_object
+    edit(annotation:_, newvalue:atom) + [type=edit],
+    remove(annotation:_) + [type=remove].
+
+%%	process_actions(+Actions, +Video)
+%
+%	Update the DB according to Actions.
+
+process_actions([], _).
+process_actions([Action|As], Video) :-
+	action_term(Action, Type, Tag, Annotations0, NewValue),
+	maplist(annotation_uri, Annotations0, Annotations),
+ 	debug(yaz(update), '~W annotation entries for tag ~w', [Type, Tag]),
+	(   Type = remove
+	->  maplist(remove_video_annotation(Video), Annotations)
+	;   Type = edit
+	->  change_annotations(Annotations, NewValue)
+	),
+	process_actions(As, Video).
+
+annotation_uri(json([uri=URI|_]), URI).
+annotation_uri(i(URI, _Time), URI).
+
+action_term(remove(Annotation), remove, Tag, Annotations, _) :-
+	Annotation = annotation(Tag, _, _, Annotations).
+action_term(edit(Annotation, New), edit, Tag, Annotations, New) :-
+	Annotation = annotation(Tag, _, _, Annotations).
+
+change_annotations([], _).
+change_annotations([Annotation|As], NewValue) :-
+ 	update_annotation_value(Annotation, NewValue),
+	change_annotations(As, NewValue).
+
+
+%%	http_yaz_api_provenance(+Request)
+%
+%	Handler for POST submission of tag modifications.
+
+http_yaz_api_provenance(Request) :-
+ 	http_parameters(Request,
+			[ annotation(Annotations,
+				[zero_or_more,
+				 description('URI of an annotation object')])
+
+			]),
+	Annotations = [Annotation],
+	annotation_provenance(Annotation, Provenance),
+	html_current_option(content_type(Type)),
+	phrase(html(table(tbody([\table_head,
+				 \html_provenance(Provenance)
+				])
+			 )), HTML),
+	format('Content-type: ~w~n~n', [Type]),
+	print_html(HTML).
+
+table_head -->
+	html(tr([th(time),
+		 th(user),
+		 th(action),
+		 th(value),
+		 th(playhead)
+		])).
+
+html_provenance([]) --> !.
+html_provenance([action(_,Time,User,_,Action)|T]) -->
+	html_provenance_action(Action,Time,User),
+	html_provenance(T).
+
+html_provenance_action(added(_, _, Value, PlayHead), Time, User) -->
+ 	html(tr([ td(\html_time(Time)),
+		  td(\html_user(User)),
+		  td(added),
+		  td(Value),
+		  td(PlayHead)
+		])).
+html_provenance_action(removed(_, _), Time, User) -->
+ 	html(tr([ td(\html_time(Time)),
+		  td(\html_user(User)),
+		  td(removed),
+		  td([])
+ 		])).
+html_provenance_action(valueChange(_, Value), Time, User) -->
+ 	html(tr([ td(\html_time(Time)),
+		  td(\html_user(User)),
+		  td(changed),
+		  td(Value),
+		  td([])
+ 		])).
+html_provenance_action(timeChange(_, PlayHead), Time, User) -->
+ 	html(tr([ td(\html_time(Time)),
+		  td(\html_user(User)),
+		  td(changed),
+		  td([]),
+		  td(PlayHead)
+ 		])).
+
+html_time(TimeStamp) -->
+	{ format_time(atom(Formatted), '%Y-%m-%d %T', TimeStamp) },
+	html(Formatted).
+html_user(UserURL) -->
+	{ display_label(UserURL, Name)
+	},
+	html(Name).
diff --git a/applications/yaz_player.pl b/applications/yaz_player.pl
new file mode 100644
index 0000000..d2658f7
--- /dev/null
+++ b/applications/yaz_player.pl
@@ -0,0 +1,154 @@
+:- module(yaz_player,
+	  [ http_yaz_player/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(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(components(label)).
+:- use_module(components(yaz_page)).
+
+:- http_handler(yaz(player), http_yaz_player, []).
+
+
+%%	http_yaz_player(+Request)
+%
+%	Emit the a video player with a tag carousel running along side
+%	of it.
+
+http_yaz_player(Request) :-
+	http_parameters(Request,
+			[ video(Video,
+				[description('Current video')]),
+			  process(Process,
+			       [optional(true), desription('When set only annotations within this process are shown')]),
+			  user(User,
+				[optional(true), description('When set only annotations from this user are shown')]),
+			  interval(Interval,
+				   [default(10000), number,
+				    description('When set one entry per tag is returned in interval (in milliseconds)')]),
+			  confirmed(Confirmed,
+				    [boolean, default(false),
+				     description('When true only tags that are entered by >1 user are shown')]),
+			  limit(Limit,
+				[default(1000), number,
+				 description('limit number of tags shown')]),
+			  start(StartTime,
+				[default(0),description('Start time of the video')])
+			]),
+	Options = [process(Process),
+		   user(User),
+		   interval(Interval),
+		   confirmed(Confirmed)
+		  ],
+	video_annotations(Video, Annotations0, Options),
+	sort_by_arg(Annotations0, 2, Annotations1),
+	list_limit(Annotations1, Limit, Annotations, _),
+	html_video_page(Video, Annotations, StartTime, Options).
+
+
+%%	html_video_page(+Video, +Annotations, +StartTime, +Options)
+%
+%	Emit an HTML page with a video player and a tag carousel.
+
+html_video_page(Video, Annotations, StartTime, Options) :-
+	reply_html_page(yaz,
+			[ title(['YAZ - ', Video])
+			],
+			[ \html_requires(css('player.css')),
+ 			  div(class('video-results'),
+			      \html_video_page_containers(Video, Options)),
+			 script(type('text/javascript'),
+				\html_video_page_yui(Video, Annotations, StartTime, Options))
+			]).
+
+html_video_page_containers(Video, _Options) -->
+	{ display_label(Video, Title),
+	  http_link_to_id(http_yaz_tag_garden, [video(Video)], Link)
+ 	},
+	html([ h2(Title),
+	       a(href(Link), 'Garden this video'),
+	       div([id(video)],
+		   [ div(id(videoplayer), []),
+		     div(id(tagplayer), [])
+		   ])
+	     ]).
+
+:- json_object
+     i(uri:atom, time:number),
+     uri(value:uri) + [type=uri],
+     literal(lang:atom, value:_) + [type=literal],
+     literal(type:atom, value:_) + [type=literal],
+     literal(value:atom) + [type=literal],
+     annotation(tag:_, startTime:number, endTime:number, annotations:list).
+
+html_video_page_yui(Video, Annotations, StartTime, _Options) -->
+	{ video_source(Video, Src),
+ 	  http_absolute_location(js('videoplayer/'), FilePath, []),
+	  http_absolute_location(js('videoplayer/videoplayer.js'), VideoPlayer, []),
+	  http_absolute_location(js('tagcarousel/tagcarousel.js'), TagCarousel, []),
+	  prolog_to_json(Annotations, JSONTags)
+   	},
+    html_requires(js('videoplayer/swfobject.js')),
+ 	js_yui3([{modules:{'video-player':{fullpath:VideoPlayer},
+			   'tag-carousel':{fullpath:TagCarousel}
+			  }}
+		],
+		[node,event,widget,anim,
+  		 'video-player','tag-carousel'
+ 		],
+		[ \js_new(videoPlayer,
+			  'Y.mazzle.VideoPlayer'({filepath:FilePath,
+ 						  src:Src,
+						  width:640,
+						  height:480,
+						  autoplay:symbol(false),
+						  controls:symbol(true),
+ 						  start:StartTime
+						 })),
+		  \js_new(tagPlayer,
+			  'Y.mazzle.TagCarousel'({tags:JSONTags,
+						  height:480,
+						  width:200
+						 })),
+  		  'var oldTime;\n',
+ 		  \js_call('videoPlayer.render'('#videoplayer')),
+		  \js_call('tagPlayer.render'('#tagplayer')),
+  		  \js_yui3_on(videoPlayer, timeChange, \js_video_time_change),
+		  \js_yui3_on(tagPlayer, itemSelect, \js_tag_select)
+  		]).
+
+js_tag_select -->
+	js_function([e],
+		    \[
+'    if(e.tag.startTime)
+     { var time = (e.tag.startTime/1000)-2;
+       videoPlayer.setTime(time, true);
+     }\n'
+		    ]).
+
+js_video_time_change -->
+	js_function([e],
+		    \[
+'    var time = Math.round(e.time);
+     if(time!==oldTime) {
+	 oldTime = time;
+	 tagPlayer.focusTime(Math.round(e.time)+1);
+     }\n'
+		    ]).
diff --git a/applications/yaz_tag_garden.pl b/applications/yaz_tag_garden.pl
new file mode 100644
index 0000000..b1c97b7
--- /dev/null
+++ b/applications/yaz_tag_garden.pl
@@ -0,0 +1,341 @@
+:- module(yaz_tag_garden,
+	  [ http_yaz_tag_garden/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(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(user_process)).
+:- use_module(library(video_annotation)).
+:- use_module(library(tag_match)).
+%:- use_module(library(reconcile)).
+
+:- use_module(components(label)).
+:- use_module(components(yaz_page)).
+
+:- use_module(api(video_frames)).
+
+:- setting(reconcile_server, atom,
+	   'http://standard-reconcile.freebaseapps.com/reconcile',
+	   'URL of a reconcile server, use "local" for built-in service of this server').
+
+:- http_handler(yaz(taggarden), http_yaz_tag_garden, []).
+:- http_handler(yaz('data/frames'), http_data_frames, []).
+
+http_yaz_tag_garden(Request) :-
+	ensure_logged_on(_),
+	http_parameters(Request,
+			[ video(Video,
+				[description('Current video')]),
+ 			  limit(_Limit,
+				[default(1000), number,
+				 description('limit number of tags shown')])
+			]),
+ 	create_user_process([rdf:type=pprime:'TagGarden',
+			     opmv:used=Video
+			    ], _Process),
+	findall(Tag, video_tag(Video, literal(Tag)), Tags0),
+	sort(Tags0, Tags),
+	concept_candidates(Tags, Pairs),
+	tag_clusters(Pairs, TagClusters),
+	maplist(cluster_annotation(Video), TagClusters, Annotations0),
+	sort_by_arg(Annotations0, 2, Annotations1),
+	reverse(Annotations1, Annotations),
+  	html_garden_page(Video, Annotations, []).
+
+cluster_annotation(Video, Tags, annotation(Ts, Count)) :-
+	findall(literal(Tag), (member(Tag-_, Tags),
+		      video_tag(Video, literal(Tag))
+		     ),
+		Ts0),
+	sort(Ts0, Ts),
+	length(Ts0, Count).
+
+concept_candidates([], []).
+concept_candidates([Tag|Ts], [Tag-Cs|Rest]) :-
+	findall(C, find_tag_concept(Tag, C, _), Cs),
+	concept_candidates(Ts, Rest).
+
+
+tag_clusters([], []).
+tag_clusters([Tag|T0], [[Tag|Tags]|T]) :-
+	similar_tags(T0, Tag, Tags0, Rest0),
+	extend_cluster(Tags0, Rest0, Tags, Rest),
+	tag_clusters(Rest, T).
+
+similar_tags([], _, [], []).
+similar_tags([Tag|T], Tag0, [Tag|Tags], Rest) :-
+	my_tag_match(Tag, Tag0),
+	!,
+	similar_tags(T, Tag0, Tags, Rest).
+similar_tags([Tag|T], Tag0, Tags, [Tag|Rest]) :-
+	similar_tags(T, Tag0, Tags, Rest).
+
+extend_cluster([], Rest, [], Rest).
+extend_cluster([Tag|Ts], Tags, Extend, Rest) :-
+	append(Extend0, [Tag|Extend1], Extend),
+	similar_tags(Tags, Tag, Extend0, Rest0),
+	extend_cluster(Ts, Rest0, Extend1, Rest).
+
+my_tag_match(T1-_, T2-_) :-
+	snowball(english, T1, T),
+	snowball(english, T2, T).
+my_tag_match(_T1-Cs1, _T2-Cs2) :-
+	member(C, Cs1),
+	member(C, Cs2).
+	% tag_match:tag_concept_match(C1, C2, _).
+
+
+
+
+%%	http_data_frames(+Request)
+%
+%       Emit a JSON object with all frames for a given tag and video.
+
+http_data_frames(Request) :-
+	http_parameters(Request,
+			[ video(Video,
+				[description('Current video')]),
+			  process(Process,
+			       [optional(true), desription('When set only annotations within this process are shown')]),
+			  user(User,
+				[optional(true), description('When set only annotations created by this user are shown')]),
+			  limit(_Limit,
+				[default(1000), number,
+				 description('limit number of tags shown')]),
+			  tag(Tags,
+			      [jsonresource, description('Tag assinged to the video')])
+			]),
+	Options = [process(Process),
+		   user(User)
+ 		  ],
+ 	Obj = Time-json([tag=Label, entry=Id, time=Time]),
+	findall(Obj, (member(T,Tags),
+		      tag_term_label(T,_,Label),
+		      video_annotation(Video, Id, T, Time, Options)), TagEntries0),
+	keysort(TagEntries0, TagEntries),
+	pairs_values(TagEntries, Fragments),
+ 	reply_json(json([fragments=Fragments])).
+
+
+		 /*******************************
+		 *               HTML		*
+		 *******************************/
+
+%%	html_garden_page(+Video, +Annotations,  +Options)
+%
+%	Emit an HTML page for tag gardening.
+
+html_garden_page(Video, Annotations, Options) :-
+	reply_html_page(yaz,
+			[ title(['YAZ - ', Video])
+			],
+			[ \html_requires(css('garden.css')),
+ 			  div(class('yui3-skin-sam'),
+			      \html_page_layout(Video)),
+			  script(type('text/javascript'),
+				 \html_page_yui(Video, Annotations, Options))
+			]).
+
+html_page_layout(Video) -->
+	{ display_label(Video, Title)
+ 	},
+	html([ h2(Title),
+	       div(id(tags),
+		   [ %h4('Tags'),
+		     div(id(taglist), [])
+		   ]),
+	       div(id(main),
+		   [ div([id(concepts), class(hidden)],
+			 [ div(id(tagReconcile), [])
+			 ]),
+		     %h4('Fragments'),
+ 		     div(id(frames), [])
+		   ]),
+	       div([id(suggest), class(hidden)],
+		   [ input([type(text), id(taginput)]),
+		     div(id(suggestResults), [])
+ 		   ])
+ 	     ]).
+
+		 /*******************************
+		 *               JS		*
+		 *******************************/
+
+:- json_object
+     i(uri:atom, time:number),
+     uri(value:uri) + [type=uri],
+     literal(lang:atom, value:_) + [type=literal],
+     literal(type:atom, value:_) + [type=literal],
+     literal(value:atom) + [type=literal],
+     annotation(tag:_, count:number).
+
+%%	html_page_yui(+Video, +Annotations, +Options)
+%
+%	Emit JavaScript for the tag gardening page.
+
+html_page_yui(Video, Annotations, _Options) -->
+	{ video_source(Video, Src, Duration),
+ 	  http_absolute_location(js('videoplayer/'), PlayerPath, []),
+	  http_absolute_location(js('videoplayer/videoplayer.js'), VideoPlayer, []),
+	  http_absolute_location(js('tagcarousel/tagcarousel.js'), TagCarousel, []),
+	  http_absolute_location(js('videoframes/videoframes.js'), VideoFrames, []),
+	  http_absolute_location(js('timeline/timeline.js'), Timeline, []),
+	  http_location_by_id(serve_video_frame, FrameServer),
+	  http_location_by_id(http_data_frames, DataServer),
+	  (   setting(reconcile_server, local)
+	  ->  http_location_by_id(http_reconcile, ReconcileServer)
+	  ;   setting(reconcile_server, ReconcileServer)
+	  ),
+  	  prolog_to_json(Annotations, JSONTags)
+  	},
+	html_requires(js('videoplayer/swfobject.js')),
+ 	js_yui3([{modules:{'video-player':{fullpath:VideoPlayer},
+			   'tag-carousel':{fullpath:TagCarousel},
+			   'video-frames':{fullpath:VideoFrames},
+			   'timeline':{fullpath:Timeline}
+			  }}
+		],
+		[node,event,widget,anim,slider,'align-plugin',
+		 'querystring-stringify-simple','io','jsonp','json',
+  		 'video-player','tag-carousel','timeline',
+		 'video-frames'
+		],
+		[\js_new(tagList,
+			 'Y.mazzle.TagCarousel'({topIndent:symbol(false),
+						 tags:JSONTags,
+						 height:500,
+						 width:200,
+						 edit:true,
+						 suggest:symbol('Y.one("#suggest")')
+						})),
+		 \js_new(videoFrames,
+			 'Y.mazzle.VideoFrames'({frameServer:FrameServer,
+						 dataServer:DataServer,
+						 video:Src,
+						 duration:Duration,
+						 playerPath:PlayerPath
+ 						})),
+		 'Y.one("#suggest").plug(Y.Plugin.Align);\n',
+ 		 \js_call('tagList.render'('#taglist')),
+		 \js_call('videoFrames.render'('#frames')),
+ 		 \js_yui3_on(tagList, itemSelect, \js_tag_select(Video)),
+ 		 \js_yui3_on(videoFrames, confirmSelect, \js_confirm_select),
+		 %\js_call('videoFrames.fetchData'),
+		 \js_freebase_suggest
+ 		]).
+
+
+js_tag_select(Video) -->
+ 	js_function([e],
+		    [ '	var tag = Y.JSON.stringify(e.tag.tag);
+			videoFrames.set("confirm", true);
+		        videoFrames.fetchData({video:"',Video,'", tag:tag});\n'
+		    ]).
+
+js_concept_select -->
+	js_function([e],
+		    [ 'videoFrames.set("concept", e.concept);\n'
+		    ]).
+
+js_confirm_select -->
+	{ http_location_by_id(http_confirm_fragment, Path)
+ 	},
+	js_function([e],
+		    [ 'var f = e.frame;
+		       var tag = e.concept ? e.concept.name : f.tag;
+		       var uri = e.concept ? e.concept.id : null;\n',
+		      \js_call('Y.io'(Path,
+				      {data: {type:symbol('e.type'),
+					      video:symbol('f.video'),
+					      starttime:symbol('f.time'),
+					      tag:symbol(tag),
+					      uri:symbol(uri)}
+  				      }))
+		    ]).
+
+js_freebase_suggest -->
+	html_requires('http://freebaselibs.com/static/suggest/1.2.1/suggest.min.css'),
+	html_requires(js('jquery/jquery-1.4.2.min.js')),
+   	html_requires('http://freebaselibs.com/static/suggest/1.2.1/suggest.min.js'),
+ 	html(\[
+'$("#taginput").suggest({parent:"#suggestResults",
+			 soft:true,
+			 required:true,
+  			 flyout:true})\n'
+	      ]).
+
+
+:- http_handler(yaz(confirm), http_confirm_fragment, []).
+
+%%	http_confirm_fragment(+Request)
+%
+%	Handler for confirmation of video fragment
+
+http_confirm_fragment(Request) :-
+	http_in_session(SessionID),
+	logged_on(User, SessionID),
+	http_parameters(Request,
+			[ video(Video,
+				[description('URL of video')]),
+			  starttime(StartTime,
+			       [number, description('StartTime of fragment')]),
+			  endtime(EndTime,
+				  [number, optional(true), description('EndTime of fragment')]),
+			  type(RoleType,
+			       [optional(true), description('Role of the tag')]),
+			  tag(Tag,
+			      [description('Tag being confirmed')]),
+  			  uri(URI,
+ 			      [optional(true), description('URI of confirmed concept')])
+			]),
+	(   var(EndTime0)
+	->  EndTime is StartTime + 10000
+	;   EndTime = EndTime0
+	),
+ 	rdf_transaction(assert_confirm_event(Video, StartTime, EndTime, Tag, URI, RoleType, User)),
+	reply_json(json([success='confirmation saved',
+ 			 user=User,
+			 video=Video,
+			 starttime=StartTime,
+			 endtime=EndTime,
+			 tag=Tag,
+			 uri=URI
+			])).
+
+assert_confirm_event(Video, StartTime, EndTime, Tag, URI, RoleType, User) :-
+	rdf_bnode(CE),
+  	rdf_assert(CE, rdf:type, pprime:'ConfirmEvent', User),
+	rdf_assert(CE, sem:involves, Video, User),
+ 	rdf_assert(CE, sem:hasActor, User, User),
+
+	rdf_bnode(FA),
+	rdf_assert(FA, rdf:type, pprime:'FragmentAnnotation', User),
+	rdf_assert(FA, sem:subEventOf, CE, User),
+	rdf_assert(FA, sem:hasBeginTimeStamp, literal(StartTime), User),
+	rdf_assert(FA, sem:hasEndTimeStamp, literal(EndTime), User),
+ 	rdf_assert(FA, sem:involves, literal(Tag), User),
+	(   var(URI); URI==null
+	->  URI = null
+	;   rdf_assert(FA, sem:involves, URI, User)
+ 	),
+	(   var(Type)
+	->  Type = null
+	;   rdf_assert(FA, pprime:role, RoleType, User)
+	).
+
+
diff --git a/applications/yaz_tags.pl b/applications/yaz_tags.pl
new file mode 100644
index 0000000..fc15243
--- /dev/null
+++ b/applications/yaz_tags.pl
@@ -0,0 +1,95 @@
+:- module(yaz_tags,
+	  [ http_yaz_tags/1
+ 	  ]).
+
+:- 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(user(user_db)).
+
+:- use_module(library(yaz_util)).
+:- use_module(library(video_annotation)).
+
+:- use_module(components(yaz_page)).
+:- use_module(components(paginator)).
+
+:- http_handler(yaz(tags), http_yaz_tags, []).
+
+%%	http_tags(+Request)
+%
+%       Emit all tags a user has added.
+
+http_yaz_tags(Request) :-
+	http_parameters(Request,
+			[ user(User,
+				[optional(true), description('Current user id')]),
+			  offset(Offset,
+				[default(0), integer, description('Offset of the result list')]),
+			  limit(Limit,
+				[default(100), integer, description('Limit on the number of results')])
+ 			]),
+ 	findall(Value-Annotation,
+		user_tag(User, Annotation, Value),
+ 		Pairs0),
+ 	keysort(Pairs0, Pairs),
+	group_pairs_by_key(Pairs, Groups),
+	length(Groups, NumberOfResults),
+	pairs_sort_by_value_count(Groups, CountTags),
+	list_offset(CountTags, Offset, OffsetResults),
+	list_limit(OffsetResults, Limit, LimitResults, _),
+	delete_nonground([user(User)], Options),
+	html_tags_page(LimitResults, NumberOfResults, Offset, Limit, Options).
+
+user_tag(User, Annotation, Value) :-
+	nonvar(User),
+	!,
+	rdf(Annotation, pprime:creator, User),
+	annotation_value(Annotation, Value).
+user_tag(_User, Annotation, Value) :-
+ 	annotation_value(Annotation, Value).
+
+%%	html_tags_page(+Results, +NumberOfResults, +Offset, +Limit,
+%%	+User)
+%
+%	Emit html page with a list of tags.
+
+html_tags_page(Results, NumberOfResults, Offset, Limit, Options) :-
+  	reply_html_page(yaz,
+			[ title(['YAZ - ', tags])
+			],
+			[\html_requires(css('tags.css')),
+			 div(class('topic tag-results'),
+			     [ div(class(header),
+				   h2([ 'You added ', \tag_count(NumberOfResults)])),
+			       div(class(body),
+				   ul(class('tag-list'),
+				      \html_tag_list(Results, Options))),
+			       div(class(footer),
+				   div(class(paginator),
+				       \html_paginator(NumberOfResults, Offset, Limit)))
+			     ])
+			]).
+
+tag_count(1) -->
+	html('1 tag ').
+tag_count(N) -->
+	html([N, ' tags ']).
+
+%%	html_tag_list(+Tags:tag-tag_entries, +Options)
+%
+%	Emit an html list with tags.
+
+html_tag_list([], _) --> !.
+html_tag_list([Count-Tag|T], Options) -->
+	{ tag_term_label(Tag, Term, Label),
+	  http_link_to_id(http_yaz_videos, [tag(Term)|Options], Link)
+ 	},
+	html(li([a(href(Link), Label), ' (', Count, ')'])),
+	html_tag_list(T, Options).
+
+
+
diff --git a/applications/yaz_user.pl b/applications/yaz_user.pl
new file mode 100644
index 0000000..7d904c2
--- /dev/null
+++ b/applications/yaz_user.pl
@@ -0,0 +1,211 @@
+:- module(yaz_user,
+	  [http_yaz_home/1,
+	   http_yaz_user/1,
+ 	   html_tag_cloud//2
+ 	  ]).
+
+:- 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(semweb/rdf_db)).
+:- use_module(user(user_db)).
+
+:- use_module(library(yaz_util)).
+:- use_module(library(video_annotation)).
+
+:- use_module(components(yaz_page)).
+
+:- use_module(applications(yaz_videos)).
+:- use_module(applications(yaz_tags)).
+
+:- http_handler(yaz(.), http_yaz_home, []).
+:- http_handler(yaz(user), http_yaz_user, []). % to user home page
+
+%%	http_yaz_home(+Request)
+%
+%       Emit yaz homepage, including videos, tags and ranks.
+%       Show User specific info when logged on.
+
+http_yaz_home(_Request) :-
+	logged_on(User0, _),
+	(   nonvar(User0)
+	->  user_property(User0, url(User)),
+	    Options = [user(User)]
+	;   Options = []
+	),
+	user_videos(User, Videos),
+	list_limit(Videos, 5, RecentProcesses, _),
+	group_pairs_by_key(Videos, GroupedProcesses),
+	list_limit(GroupedProcesses, 5, RecentVideos, _),
+   	popular_tags(User, 100, Tags),
+	html_home_page(RecentProcesses, RecentVideos, Tags, Options).
+
+%%	user_videos(?User, +Limit, -RecentVideos)
+%
+%	Returns a list Videos that have been annotated, sorted by Time.
+%
+%	Params:
+%	 * User
+%	 When defined Videos are limited to annotated by this User.
+
+user_videos(User, SortedVideos) :-
+	findall(Time-(Video-process(Process, Time, [])),
+		annotation_process(User, Video, Process, Time),
+		Pairs0),
+	keysort(Pairs0, Pairs1),
+	reverse(Pairs1, Pairs),
+	pairs_values(Pairs, SortedVideos).
+
+%%	popular_tags(?User, +Limit, -AnnotationsByTag)
+%
+%	Returns a list with the most popular tags, Tag-[Annotations]
+%
+%	Param
+%	 * User
+%        when defined limited to the tags added by User.
+
+popular_tags(User, Limit, PopularTags) :-
+	findall(Value-Annotation,
+		user_tag(User, Annotation, Value),
+ 		Pairs0),
+ 	keysort(Pairs0, Pairs),
+	group_pairs_by_key(Pairs, Groups),
+	pairs_sort_by_value_count(Groups, Tags),
+	list_limit(Tags, Limit, PopularTags, _).
+
+user_tag(User, Annotation, Value) :-
+	nonvar(User),
+	!,
+	rdf(Annotation, pprime:creator, User),
+	annotation_value(Annotation, Value).
+user_tag(_User, Annotation, Value) :-
+ 	annotation_value(Annotation, Value).
+
+
+%%	http_yaz_user(+Request)
+%
+%	Same as http_yaz_home, but ensure user to be logged on.
+
+http_yaz_user(Request) :-
+	ensure_logged_on(_User),
+	http_yaz_home(Request).
+
+
+%%	html_home_page(+Processes, +Videos, +Tags, Options)
+%
+%	Emit home page for User.
+
+html_home_page(Processes, Videos, Tags, Options) :-
+	reply_html_page(yaz,
+			[ title(['YAZ - ',
+				 \page_title(Options)])
+			],
+			[ \html_requires(css('user.css')),
+			  div([id(processes), class(topic)],
+			       \html_process_stream(Processes, Options)),
+			   div([id(videos), class(topic)],
+			       \html_video_stream(Videos, Options)),
+			  div([id(tags), class(topic)],
+			      \html_tag_stream(Tags, Options))
+			]).
+
+page_title(Options) -->
+	{ option(user(User), Options)
+	},
+	html([User, '\'s annotation zone']).
+page_title(_Options) -->
+	html(['annotation zone']).
+
+
+html_process_stream(Processes, Options) -->
+	{ http_link_to_id(http_yaz_videos, Options, Link)
+	},
+ 	html([ div(class(header),
+		   h2(a(href(Link), \process_stream_header(Options)))),
+	       div(class(body),
+		   ul(class('thumb-list'),
+		      \html_process_list(Processes, Options)))
+	     ]).
+
+html_process_list([], _) --> !.
+html_process_list([Video-ProcessObj|Vs], Options) -->
+	{ ProcessObj = process(Process, _, _)
+	},
+	html(li(class('video'),
+		\html_video_item(Video, [ProcessObj],
+				 [process(Process)|Options]))),
+ 	html_process_list(Vs, Options).
+
+process_stream_header(Options) -->
+	{ option(user(_User), Options)
+	},
+	html('Your recent activity').
+process_stream_header(_Options) -->
+	html('Recent activity').
+
+
+html_video_stream(Videos, Options) -->
+	{ http_link_to_id(http_yaz_videos, Options, Link)
+	},
+ 	html([ div(class(header),
+		   h2(a(href(Link), \video_stream_header(Options)))),
+	       div(class(body),
+		   ul(class('thumb-list'),
+		      \html_video_list(Videos, Options)))
+	     ]).
+
+video_stream_header(Options) -->
+	{ option(user(_User), Options)
+	},
+	html('Your recently tagged videos').
+video_stream_header(_Options) -->
+	html('Recently tagged videos').
+
+
+html_tag_stream(TopNTags, Options) -->
+	{ http_link_to_id(http_yaz_tags, Options, Link)
+	},
+ 	html([ div(class(header),
+		   h2(a(href(Link), \tag_stream_header(Options)))),
+	       div(class(body),
+		   p(class('tag-cloud'),
+		       \html_tag_cloud(TopNTags, Options)))
+	     ]).
+tag_stream_header(Options) -->
+	{ option(user(_User), Options)
+	},
+	html('Your most popular tags').
+tag_stream_header(_Options) -->
+	html('Most popular tags').
+
+%%	html_tag_cloud(+Pairs:count-tag, +Options)
+%
+%	Emit an HTML tag cloud.
+
+html_tag_cloud([], _) --> !.
+html_tag_cloud(Tags, Options) -->
+	{ maplist(tag_term_pair, Tags, TagsByLabel),
+	  keysort(TagsByLabel, Sorted),
+	  pairs_values(Sorted, TagTerms),
+	  pairs_keys(Tags, Counts),
+	  max_list(Counts, Max),
+	  min_list(Counts, Min)
+ 	},
+	html_tag_cloud(TagTerms, Min, Max, Options).
+
+html_tag_cloud([], _, _, _) --> !.
+html_tag_cloud([tag(Term, Label, Count)|T], Min, Max, Options) -->
+	{ http_link_to_id(http_yaz_videos, [tag(Term)|Options], Link),
+	  Size0 is (log((20*max((Count-Min),1)) / max((Max-Min),5))) * 10,
+	  Size is max(10, Size0)
+	},
+	html([' ',
+	      a([title(Count),
+		 href(Link),
+		 style('font-size:'+Size+'px')], Label),
+	      ' ']),
+	html_tag_cloud(T, Min, Max, Options).
+
+tag_term_pair(Count-Tag, Label-tag(Term, Label, Count)) :-
+	tag_term_label(Tag, Term, Label).
diff --git a/applications/yaz_videos.pl b/applications/yaz_videos.pl
new file mode 100644
index 0000000..3a82034
--- /dev/null
+++ b/applications/yaz_videos.pl
@@ -0,0 +1,202 @@
+:- module(yaz_videos,
+	  [ http_yaz_videos/1,
+ 	    html_video_list//2,
+	    html_video_item//3
+	  ]).
+
+:- 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(paginator)).
+
+:- http_handler(yaz(videos), http_yaz_videos, []).
+
+%%	http_yaz_videos(+Request)
+%
+%       Emit a all videos a user has annotated.
+
+http_yaz_videos(Request) :-
+	http_parameters(Request,
+			[ user(User,
+				[optional(true), description('Current user id')]),
+			  tag(Tag,
+			      [optional(true), description('Limit videos by tag')]),
+ 			  offset(Offset,
+				[default(0), integer, description('Offset of the result list')]),
+			  limit(Limit,
+				[default(20), integer, description('Limit on the number of results')])
+ 			]),
+ 	user_video_processes(User, Tag, Pairs0),
+	keysort(Pairs0, Pairs),
+	group_pairs_by_key(Pairs, Groups),
+	length(Groups, NumberOfResults),
+	SortedVideos = Groups,
+	list_offset(SortedVideos, Offset, OffsetResults),
+	list_limit(OffsetResults, Limit, LimitResults, _),
+	delete_nonground([user(User), tag(Tag)], Options),
+	html_videos_page(LimitResults, NumberOfResults, Offset, Limit, Options).
+
+%%	user_video_processes(?User, ?Value, -Pairs:video-process)
+%
+%	Returns a list of the Nth Videos that have been recently
+%	annotated.
+%
+%	Params:
+%	 * User
+%	 When defined Videos are limited to annotated by this User.
+%
+%	 * Value
+%	 When defined Videos are limit to those annotated with Value.
+
+
+user_video_processes(User, Value, Pairs) :-
+	nonvar(Value),
+	!,
+	findall(Video-process(Process, Time, Annotations),
+		annotation_value_process(User, Video, Value, Process, Time, Annotations),
+		Pairs).
+user_video_processes(User, _Value, Pairs) :-
+ 	findall(Video-process(Process, Time, []),
+		annotation_process(User, Video, Process, Time),
+		Pairs).
+
+annotation_value_process(User, Video, Value, Process, StartTime, [annotation(Value, Times)]) :-
+	annotation_process(User, Video, Process, StartTime),
+	findall(Time,
+		value_annotation(literal(Value), Process, User, Time),
+		Times),
+	Times = [_|_].
+
+
+%%	html_videos_page(+Video, +NumberOfResults, +Offset, +Limit,
+%%	+User, +Annotation)
+%
+%	Emit HTML page with a list of Videos.
+
+html_videos_page(Results, NumberOfResults, Offset, Limit, Options) :-
+	reply_html_page(yaz,
+			[ title(['YAZ - tagged videos'])
+			],
+			[ \html_requires(css('videos.css')),
+			  div(class(topic),
+			      [ div(class(header),
+				    h2(\message(NumberOfResults, Options))),
+				div(class(body),
+				    ul(class('thumb-list'),
+				       \html_video_list(Results, Options))),
+				div(class(footer),
+					div(class(paginator),
+					    \html_paginator(NumberOfResults, Offset, Limit)
+					   ))
+			      ])]).
+
+message(N, Options) -->
+	{ option(user(_User), Options)
+ 	},
+	!,
+	html(['You tagged ',
+	      \video_count(N),
+	      \tag_message(Options)
+	     ]).
+message(N, Options) -->
+	html([\video_count(N),
+	      ' tagged ',
+	      \tag_message(Options)
+	     ]).
+
+video_count(1) -->
+	html('1 video').
+video_count(N) -->
+	html([N, ' videos']).
+
+tag_message(Options) -->
+	{ option(tag(Tag), Options)
+ 	},
+	html([' with tag ', Tag]).
+tag_message(_) --> !.
+
+
+%%	html_video_list(+Videos, +Options)//
+%
+%	Emit html with a list of videos.
+
+html_video_list([], _) --> !.
+html_video_list([Video-Processes|Vs], Options) -->
+	html(li(class('video'),
+		\html_video_item(Video, Processes, Options))),
+ 	html_video_list(Vs, Options).
+
+html_video_item(URL, Processes, Options) -->
+	{ display_label(URL, Title),
+	  video_source(URL, Video),
+	  truncate_atom(Title, 47, ShortTitle),
+	  http_link_to_id(http_yaz_player, [video(URL)|Options], Link),
+	  http_link_to_id(serve_video_frame, [url(Video),time(5)], Frame)
+ 	},
+	html(div(class('item-content'),
+		 [ a(href(Link),
+		     div(class('thumb-container'),
+			 img([width('140px'), alt('no image available'), title(Title), src(Frame)], []))),
+		   a([href(Link), title(Title)],
+		     ShortTitle),
+		   div(class('processes'),
+		       \html_process_list(Processes, Video, Link))
+		 ])).
+
+%%	html_process_list(+Processes, +Video, +Link)//
+%
+%	Emit html with a list of annotation processes.
+
+html_process_list([], _, _) --> !.
+html_process_list([process(_Process, Time, Annotations)|T], Video, Link) -->
+	html(div(class('process'),
+		[ div(class('process-time'), Time),
+		  div(class('annotations'),
+		      \html_annotations(Annotations, Video, Link))
+		])),
+	html_process_list(T, Video, Link).
+
+/*
+	  process_time(StartTime, Time),
+	  (   format_time(string(FormattedTime), '%d %B %H:%M', Time)
+	  ->  true
+	  ;   FormattedTime = StartTime
+	  )
+*/
+
+
+html_annotations([], _, _) --> !.
+html_annotations([annotation(Value, Times0)|Ts], Video, Link) -->
+	{ tag_term_label(Value, _Term, TagLabel),
+	  sort(Times0, Times)
+ 	},
+	html([ div(class('annotation-value'),
+		   [ TagLabel, ': ' ]),
+	       ul(class('annotation-times'),
+		  \html_annotation_times(Times, Video, Link))
+	     ]),
+	html_annotations(Ts, Video, Link).
+
+html_annotation_times([], _, _) --> !.
+html_annotation_times([Time|T], Video, Link) -->
+	{ Seconds is Time/1000,
+	  SeekTime is Seconds-5,
+ 	  format_time(string(FormattedTime), '%M:%S', Seconds)
+	},
+	html(li(class('tag-time'),
+		a(href(Link+'&start='+SeekTime), FormattedTime))),
+	html_annotation_times(T, Video, Link).
+
+
diff --git a/components/paginator.pl b/components/paginator.pl
new file mode 100644
index 0000000..e37da9a
--- /dev/null
+++ b/components/paginator.pl
@@ -0,0 +1,88 @@
+:- module(html_paginator,
+	  [ html_paginator//3
+	  ]).
+
+:- use_module(library(http/http_wrapper)).
+:- use_module(library(http/http_host)).
+:- use_module(library(http/html_write)).
+
+%	html_paginator(+NumberOfResults, +Offset, +Limit)
+%
+%	Emit HTML paginator.
+
+html_paginator(Total, _Offset, Limit) -->
+	{ Total < Limit },
+	!.
+html_paginator(Total, Offset, Limit) -->
+	{ http_current_request(Request),
+	  request_url_components(Request, URLComponents),
+	  Pages is ceiling(Total/Limit),
+	  ActivePage is floor(Offset/Limit),
+	  (   ActivePage < 9
+	  ->  EndPage is min(10, Pages)
+	  ;   EndPage is min(10+ActivePage, Pages)
+	  ),
+	  StartPage is max(0, EndPage-20),
+	  (   select(search(Search0), URLComponents, Cs)
+	  ->  delete(Search0, offset=_, Search)
+	  ;   Search = Search0
+	  ),
+ 	  parse_url(URL, [search(Search)|Cs]),
+	  (   Search = []
+	  ->  Delim = '?'
+	  ;   Delim = '&'
+	  )
+	},
+ 	prev_page(ActivePage, Limit, URL, Delim),
+	html_pages(StartPage, EndPage, Limit, URL, Delim, ActivePage),
+	next_page(ActivePage, Pages, Limit, URL, Delim).
+
+prev_page(0, _, _, _) --> !.
+prev_page(Active, Limit, URL, Delim) -->
+	{ Offset is (Active-1)*Limit,
+	  First = 0
+	},
+	html([span(class(first), a(href(URL+Delim+'offset='+First), '<<')),
+	      span(class(prev), a(href(URL+Delim+'offset='+Offset), '<'))]).
+
+next_page(_, 0, _, _, _) --> !.
+next_page(Active, Last, _, _, _) -->
+	{ Active is Last-1 },
+	!.
+next_page(Active, Last, Limit, URL, Delim) -->
+	{ Offset is (Active+1)*Limit,
+	  LastOffset is (Last-1)*Limit
+	},
+	html([span(class(next), a(href(URL+Delim+'offset='+Offset), '>')),
+	      span(class(last), a(href(URL+Delim+'offset='+LastOffset), '>>'))]).
+
+html_pages(N, N, _, _, _, _) --> !.
+html_pages(N, Pages, Limit, URL, Delim, ActivePage) -->
+	{ N1 is N+1,
+	  Offset is N*Limit,
+ 	  (   N = ActivePage
+	  ->  Class = active
+	  ;   Class = ''
+	  )
+ 	},
+	html(span(class(Class), a(href(URL+Delim+'offset='+Offset), N1))),
+	html_pages(N1, Pages, Limit, URL, Delim, ActivePage).
+
+
+%%	request_url_components(+Request, -URLComponents)
+%
+%	URLComponents contains all element in Request that together
+%	create the request URL.
+
+request_url_components(Request, [ protocol(http),
+				  host(Host), port(Port),
+				  path(Path), search(Search)
+				]) :-
+	http_current_host(Request, Host, Port,
+			  [ global(false)
+			  ]),
+ 	(   option(x_redirected_path(Path), Request)
+	->  true
+	;   option(path(Path), Request, /)
+	),
+	option(search(Search), Request, []).
diff --git a/components/yaz_page.pl b/components/yaz_page.pl
new file mode 100644
index 0000000..c165631
--- /dev/null
+++ b/components/yaz_page.pl
@@ -0,0 +1,67 @@
+:- module(yaz_page,
+	  [yaz_page//1
+	  ]).
+
+:- 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(user(user_db)).
+
+:- multifile
+	user:body//2.
+
+user:body(yaz, Body) -->
+	yaz_page(Body).
+
+%%	yaz_page(+Body)
+%
+%	Hook to provide the same layout and style for each YAZ page.
+
+yaz_page(Body) -->
+	html_requires(css('yaz.css')),
+	html(body([\html_page_header,
+		   div(id(body),
+		       div(id(content), Body))
+  		  ])).
+
+%%	html_page_header//
+%
+%	Emit header of the html page.
+
+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_search),
+		       ul(id(pagenavigation), \html_navigation),
+		       div(id(pagecontrols), \html_page_controls)
+		     ]))).
+
+html_search -->
+	{ setting(search:target_class, Class) },
+	html(form(action(location_by_id(http_interactive_search)),
+		  \search_field('', Class))).
+
+html_navigation -->
+	html([li(a(href(location_by_id(http_yaz_game)), game))
+	      %li(a(href(location_by_id(http_yaz_annotate)), annotate))
+	     ]).
+
+html_page_controls -->
+	login.
+
+login -->
+	{ logged_on(User, _),
+	  nonvar(User)
+ 	},
+	!,
+	html(div(class(login),
+		 [ User, ' | ',
+		   a(href(location_by_id(http_yaz_logout)), 'Sign out')
+		 ])).
+login -->
+ 	html(div(class(login),
+		 a(href(location_by_id(http_yaz_user)), 'Sign in'))).
+
+
diff --git a/config-available/yaz.pl b/config-available/yaz.pl
index afdd6a9..228ff41 100644
--- a/config-available/yaz.pl
+++ b/config-available/yaz.pl
@@ -3,3 +3,22 @@
 /** <module> Your Annotation Zone
 */
 
+:- use_module(library(semweb/rdf_db)).
+
+% rdf stuff
+:- rdf_register_ns(sem, 'http://semanticweb.cs.vu.nl/2009/04/event/').
+:- rdf_register_ns(pprime, 'http://semanticweb.cs.vu.nl/prestoprime/').
+:- rdf_register_ns(opmv, 'http://purl.org/net/opmv/ns#').
+
+% yaz applications (or actually the different pages)
+:- use_module(applications(yaz_admin)).
+:- use_module(applications(yaz_user)).
+:- use_module(applications(yaz_videos)).
+:- use_module(applications(yaz_tags)).
+:- use_module(applications(yaz_game)).
+:- use_module(applications(yaz_player)).
+:- use_module(applications(yaz_game_recap)).
+:- use_module(applications(yaz_tag_garden)).
+
+% http path and handlers
+http:location(yaz, cliopatria(yaz), []).
diff --git a/lib/rdf_history.pl b/lib/rdf_history.pl
new file mode 100644
index 0000000..5bd71e8
--- /dev/null
+++ b/lib/rdf_history.pl
@@ -0,0 +1,444 @@
+/*  $Id$
+
+    Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        wielemak@science.uva.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 1985-2007, University of Amsterdam
+
+    This program is free software; you can redistribute it and/or
+    modify it under the terms of the GNU General Public License
+    as published by the Free Software Foundation; either version 2
+    of the License, or (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+    As a special exception, if you link this library with other files,
+    compiled with a Free Software compiler, to produce an executable, this
+    library does not by itself cause the resulting executable to be covered
+    by the GNU General Public License. This exception does not however
+    invalidate any other reasons why the executable file might be covered by
+    the GNU General Public License.
+*/
+
+:- module(rdf_history,
+	  [ rdfh_transaction/1,		% :Goal
+	    rdfh_assert/3,		% +S,+P,+O
+	    rdfh_retractall/3,		% +S,+P,+O
+	    rdfh_update/3,		% +S[->NS],+P[->NP],+O[->[NO]
+	    rdfh_db_transaction/3,	% ?DB, +Condition, ?Transaction
+	    rdfh_triple_transaction/2,	% +Triple, -Transaction
+	    rdfh_transaction_member/2,	% ?Action, +Transaction
+	    rdfh_transaction_memberchk/2% ?Action, +Transaction
+	  ]).
+:- use_module(library('http/http_session')).
+:- use_module(library(lists)).
+:- use_module(library(record)).
+:- use_module(library(error)).
+:- use_module(library(debug)).
+:- use_module(library('semweb/rdf_persistency')).
+:- use_module(library('semweb/rdf_db')).
+:- use_module(user(user_db)).
+
+
+/** <module> RDF Persistent store change history
+
+This  module  deals  with  accessing  the   journal  files  of  the  RDF
+persistency layer to get insight in the   provenance  and history of the
+RDF database. It is designed for   Wiki-like collaborative editing of an
+RDF graph. We make the following assumptions:
+
+ * Users are identified using a URI, typically an OpenID (http://openid.net/)
+ * Triples created by a user are added to a named graph identified by the
+   URI of the user.
+ * Changes are grouped using rdf_transaction(Goal, log(Message, User))
+ * The number that is associated with the named graph of a triple (normally
+   expressing the line number in the source) is used to store the time-stamp.
+   Although this information is redundant (the time stamp is the same as
+   for the transaction), it allows for binary search through the history
+   file for the enclosing transaction.
+
+@tbd	Cleanup thoughts on delete and update.
+
+@author	Jan Wielemaker
+*/
+
+		 /*******************************
+		 *	   DECLARATIONS		*
+		 *******************************/
+
+:- module_transparent
+	rdfh_transaction/1.
+
+:- rdf_meta
+	rdfh_assert(r,r,o),
+	rdfh_retractall(r,r,o),
+	rdfh_update(t,t,t).
+
+:- multifile
+	rdfh_hook/1.
+
+:- record
+	rdf_transaction(id:integer,
+			nesting:integer,
+			time:number,
+			message,
+			actions:list,
+			other_graphs:list).
+
+
+		 /*******************************
+		 *	   MODIFICATIONS	*
+		 *******************************/
+
+%%	rdfh_transaction(:Goal) is semidet.
+%
+%	Run Goal using rdf_transaction/2, using information from the HTTP
+%	layer to provide OpenID and session-id.
+
+rdfh_transaction(Goal0) :-
+	rdfh_user(User),
+	rdfh_graph(Graph),
+	transaction_context(Context),
+	rdf_global_term(Goal0, Goal),
+	rdf_transaction(Goal, log(rdfh([user(User),graph(Graph)|Context]), Graph)).
+
+
+%%	rdfh_assert(+S, +P, +O) is det.
+%
+%	Assert a triple, adding current  user   and  time  to the triple
+%	context.
+
+rdfh_assert(S,P,O) :-
+	(   rdf_active_transaction(log(rdfh(_), Graph))
+	->  rdfh_time(Time),
+	    rdf_assert(S,P,O,Graph:Time)
+	;   throw(error(permission_error(assert, triple, rdf(S,P,O)),
+			context(_, 'No rdfh_transaction/1')))
+	).
+
+
+%%	rdfh_retractall(+S, +P, +O) is det.
+%
+%	Retract triples that  match  {S,P,O}.   Note  that  all matching
+%	triples are added to the journal, so   we can undo the action as
+%	well as report on  retracted  triples,   even  if  multiple  are
+%	retracted at the same time.
+%
+%	One of the problems we are faced   with is that a retract action
+%	goes into the journal of  the   user  whose triple is retracted,
+%	which may or may not be the one who performed the action.
+
+rdfh_retractall(S,P,O) :-
+	(   rdf_active_transaction(log(rdfh(_), _User))
+	->  rdf_retractall(S,P,O)
+	;   throw(error(permission_error(retract, triple, rdf(S,P,O)),
+			context(_, 'No rdfh_transaction/1')))
+	).
+
+
+%%	rdfh_update(+S, +P, +O) is det.
+%
+%	More tricky stuff, replacing a triple by another. Typically this
+%	will be changing the predicate or object. Provenance info should
+%	move the new triple to the user making the change, surely if the
+%	object is changed. If the  predicate   is  changed  to a related
+%	predicate, this actually becomes less obvious.
+%
+%	Current simple-minded approach is  to  turn   an  update  into a
+%	retract and assert. The S,P,O specifications are either a ground
+%	value or of the form _Old_ =|->|= _New_. Here is an example:
+%
+%	==
+%	rdfh_update(Work, Style, wn:oldstyle -> wn:newstyle)
+%	==
+
+rdfh_update(S,P,O) :-
+	(   rdf_active_transaction(log(rdfh(_), User))
+	->  update(S,P,O, rdf(RS, RP, RO), rdf(AS, AP, AO)),
+	    must_be(ground, RS),
+	    must_be(ground, RP),
+	    must_be(ground, RO),
+	    rdfh_time(Time),
+	    rdf_retractall(RS, RP, RO),
+	    rdf_assert(AS, AP, AO, User:Time)
+	;   throw(error(permission_error(retract, triple, rdf(S,P,O)),
+			context(_, 'No rdfh_transaction/1')))
+	).
+
+update(Ss, Ps, Os, rdf(S0, P0, O0), rdf(S,P,O)) :-
+	update(Ss, S0, S),
+	update(Ps, P0, P),
+	update(Os, O0, O).
+
+update(From->To, From, To) :- !.
+update(Value, Value, Value).
+
+
+%%	transaction_context(-Term) is det.
+%
+%	Context to pass with an RDF transaction.   Note that we pass the
+%	user. We don't need this for simple additions, but we do need it
+%	to track deletions.
+
+transaction_context(Context) :-
+	(   rdfh_session(Session)
+	->  Context = [session(Session)]
+	;   Context = []
+	).
+
+%%	rdfh_session(-Session) is semidet.
+%
+%	Session is a (ground) identifier for the current session.
+
+rdfh_session(Session) :-
+	rdfh_hook(session(Session)), !.
+rdfh_session(Session) :-
+	catch(http_session_id(Session), _, fail).
+
+
+%%	rdfh_user(-URI) is det.
+%
+%	Get user-id of current session.
+%
+%	@tbd	Make hookable, so we can use the SeRQL user/openid hooks
+
+rdfh_user(User) :-
+	rdfh_hook(user(User)), !.
+rdfh_user(OpenId) :-
+	http_session_id(SessionID),
+	user_property(User, session(SessionID)),
+	user_property(User, url(OpenId)).
+
+
+%%	rdfh_graph(-URI) is det.
+%
+%	Get graph-id in which triples are asserted.
+%	Default is the URL of the User.
+
+rdfh_graph(Graph) :-
+	rdfh_hook(graph(Graph)), !.
+rdfh_graph(User) :-
+	rdfh_user(User).
+
+
+%%	rdfh_time(-Time:integer) is det.
+%
+%	Get time stamp as integer.  Second resolution is enough, and
+%	avoids rounding problems associated with floats.
+
+rdfh_time(Seconds) :-
+	get_time(Now),
+	Seconds is round(Now).
+
+
+		 /*******************************
+		 *	 EXAMINE HISTORY	*
+		 *******************************/
+
+%%	rdfh_triple_transaction(+Triple:rdf(S,P,O), -Transaction) is nondet.
+%
+%	True if the (partial) Triple is modified in Transaction.
+
+rdfh_triple_transaction(Triple, Transaction) :-
+	rdf_global_term(Triple, rdf(S,P,O)),
+	rdf(S,P,O,DB:Time),
+	After is Time - 1,
+	rdfh_db_transaction(DB, after(After), Transaction),
+	rdfh_transaction_member(assert(S,P,O,Time), Transaction).
+
+%%	rdfh_db_transaction(?DB, +Condition, ?Transaction) is nondet.
+%
+%	True if Transaction satisfying  Condition   was  executed on DB.
+%	Condition is one of:
+%
+%	  * true
+%	  Always true, returns all transactions.
+%	  * id(Id)
+%	  Specifies the identifier of the transaction.  Only makes sense
+%	  if DB is specified as transaction identifiers are local to each
+%	  DB.
+%	  * after(Time)
+%	  True if transaction is executed at or after Time.
+%
+%	  @tbd	More conditions (e.g. before(Time)).
+
+rdfh_db_transaction(DB, true, Transaction) :- !,
+	rdf_journal_file(DB, Journal),
+	journal_transaction(Journal, Transaction).
+rdfh_db_transaction(DB, id(Id), Transaction) :- !,
+	must_be(atom, DB),
+	rdf_journal_file(DB, Journal),
+	open_journal(Journal, Fd),
+	call_cleanup((seek_journal(Fd, id(Id)),
+		      read_transaction(Fd, Transaction)),
+		     close(Fd)).
+rdfh_db_transaction(DB, Condition, Transaction) :- !,
+	valid_condition(Condition),
+	rdf_journal_file(DB, Journal),
+	open_journal(Journal, Fd),
+	seek_journal(Fd, Condition),
+	stream_transaction(Fd, Transaction).
+
+valid_condition(Var) :-
+	var(Var), !,
+	instantiation_error(Var).
+valid_condition(after(Time)) :- !,
+	must_be(number, Time).
+valid_condition(Cond) :-
+	type_error(condition, Cond).
+
+%%	open_journal(+File, -Stream) is det.
+%
+%	Open a journal file.  Journal files are always UTF-8 encoded.
+
+open_journal(JournalFile, Fd) :-
+	open(JournalFile, read, Fd, [encoding(utf8)]).
+
+%%	journal_transaction(+JournalFile, ?Transaction) is nondet.
+%
+%	True if Transaction is a transaction in JournalFile,
+
+journal_transaction(JournalFile, Transaction) :-
+	open_journal(JournalFile, Fd),
+	stream_transaction(Fd, Transaction).
+
+stream_transaction(JFD, Transaction) :-
+	call_cleanup(read_transaction(JFD, Transaction), close(JFD)).
+
+read_transaction(In, Transaction) :-
+	repeat,
+	   read(In, T0),
+	(   T0 == end_of_file
+	->  !, fail
+	;   transaction(T0, In, T),	% transaction/3 is not steadfast
+	    T = Transaction
+	).
+
+transaction(begin(Id, Nest, Time, Msg), In,
+	    rdf_transaction(Id, Nest, Time, Msg, Actions, Others)) :- !,
+	read(In, T2),
+	read_transaction_actions(T2, Id, In, Actions, Others).
+transaction(start(_), _, _) :- !, fail.	% Open journal
+transaction(end(_), _, _) :- !, fail.   % Close journal
+transaction(Action, _, Action).		% Action outside transaction?
+
+read_transaction_actions(end(Id, _, Others), Id, _, [], Others) :- !.
+read_transaction_actions(end_of_file, _, _, [], []) :- !. % TBD: Incomplete transaction (error)
+read_transaction_actions(Action, Id, In, Actions, Others) :-
+	ignore_in_transaction(Action), !,
+	read(In, T2),
+	read_transaction_actions(T2, Id, In, Actions, Others).
+read_transaction_actions(Action, Id, In, [Action|Actions], Others) :-
+	read(In, T2),
+	read_transaction_actions(T2, Id, In, Actions, Others).
+
+ignore_in_transaction(start(_)).
+ignore_in_transaction(end(_)).
+ignore_in_transaction(begin(_,_,_,_)).
+ignore_in_transaction(end(_,_,_)).
+
+
+%%	seek_journal(+Fd:stream, +Spec) is semidet.
+%
+%	See an open journal descriptor to the start of a transaction
+%	specified by Spec.  Spec is one of:
+%
+%	  * after(Time)
+%	  First transaction at or after Time.  Fails if there are no
+%	  transactions after time.
+%	  * id(Id)
+%	  Start of transaction labeled with given Id.  Fails if there
+%	  is no transaction labeled Id.
+%
+%	The implementation relies on the incrementing identifier numbers
+%	and time-stamps.
+
+seek_journal(Fd, Spec) :-
+	stream_property(Fd, file_name(File)),
+	size_file(File, Size),
+	Here is Size//2,
+	Last = last(-),
+	(   is_after_spec(Spec)
+	->  (   bsearch_journal(Fd, 0, Here, Size, Spec, Last)
+	    ->	true
+	    ;	arg(1, Last, StartOfTerm),
+		StartOfTerm \== (-),
+		seek(Fd, StartOfTerm, bof, _)
+	    )
+	;   bsearch_journal(Fd, 0, Here, Size, Spec, Last)
+	).
+
+is_after_spec(after(_Time)).
+
+%%	bsearch_journal(+Fd, +Start, +Here, +End, +Spec, !Last) is semidet.
+%
+%	Perform a binary search in the journal opened as Fd.
+
+bsearch_journal(Fd, Start, Here, End, Spec, Last) :-
+	start_of_transaction(Fd, Here, StartOfTerm, Begin), !,
+	compare_transaction(Spec, Begin, Diff),
+	(   Diff == (=)
+	->  seek(Fd, StartOfTerm, bof, _)
+	;   Diff == (<)
+	->  NewHere is Start+(Here-Start)//2,
+	    NewHere < Here,
+	    nb_setarg(1, Last, StartOfTerm),
+	    bsearch_journal(Fd, Start, NewHere, Here, Spec, Last)
+	;   NewHere is StartOfTerm+(End-StartOfTerm)//2,
+	    NewHere > StartOfTerm,
+	    bsearch_journal(Fd, StartOfTerm, NewHere, End, Spec, Last)
+	).
+bsearch_journal(Fd, Start, Here, _End, Spec, Last) :-
+	NewHere is Start+(Here-Start)//2,
+	NewHere	< Here,
+	bsearch_journal(Fd, Start, NewHere, Here, Spec, Last).
+
+compare_transaction(id(Id), begin(Id2,_,_,_), Diff) :- !,
+	compare(Diff, Id, Id2).
+compare_transaction(after(Time), begin(_,_,T,_), Diff) :- !,
+	compare(Diff, Time, T).
+
+%%	start_of_transaction(+Fd, +From, -Start, -Term) is semidet.
+%
+%	Term is the start  term  of   the  first  transaction after byte
+%	position From. Fails if no transaction can be found after From.
+
+start_of_transaction(Fd, From, Start, Term) :-
+	seek(Fd, From, bof, _),
+	skip(Fd, 10),
+	repeat,
+	    seek(Fd, 0, current, Start),
+	    read(Fd, Term),
+	    (	transaction_start(Term)
+	    ->	!
+	    ;	Term == end_of_file
+	    ->	!, fail
+	    ;	fail
+	    ).
+
+transaction_start(begin(_Id,_Nest,_Time,_Message)).
+
+%%	rdfh_transaction_member(Action, Transaction) is nondet.
+%
+%	True if Action is an action in Transaction.
+
+rdfh_transaction_member(Action, Transaction) :-
+	rdf_transaction_actions(Transaction, Actions),
+	member(Action, Actions).
+
+%%	rdfh_transaction_memberchk(Action, Transaction) is det.
+%
+%	True if Action is an action in Transaction.
+
+rdfh_transaction_memberchk(Action, Transaction) :-
+	rdf_transaction_actions(Transaction, Actions),
+	memberchk(Action, Actions).
diff --git a/lib/user_process.pl b/lib/user_process.pl
new file mode 100644
index 0000000..054acaf
--- /dev/null
+++ b/lib/user_process.pl
@@ -0,0 +1,177 @@
+:- module(user_process,
+	  [ current_user_process/1,        % -ProcessURI
+	    user_process_creator/2,        % +ProcessURI, ?User
+	    user_process_joined/2,         % +ProcessURI, ?User
+	    set_active_process/1,          % +ProcessURI
+	    create_user_process/2,         % +Properties, -ProcessURI
+	    start_user_process/1,          % ?ProcessURI
+	    join_user_process/1,           % +ProcessURI
+ 	    end_user_process/1,	           % +ProcessURI
+	    add_resource_properties/2,	   % +URI, +Properties:list(p=v)
+	    resource_properties/2	   % +URI, ?Properties:list(p=v)
+	  ]).
+
+:- use_module(library(http/http_session)).
+:- use_module(library(semweb/rdf_db)).
+:- use_module(user(user_db)).
+
+/** <module> Creation of processes in which annotations are made/modified
+
+This module deals with the creation of processes for annotation
+sessions. A process is modelled using the Open Provenance Model (OPM)
+http://openprovenance.org/.
+
+@author	Michiel Hildebrand
+*/
+
+:- rdf_meta
+	create_user_process(t, r).
+
+%%	current_user_process(-Process)
+%
+%	Process is the current annotation session User is involved
+%	in.
+
+current_user_process(Process) :-
+	http_session_data(process(Process)),
+	\+ rdf(Process, opmv:wasEndedAt, _).
+
+%%	user_process_creator(+Process, ?User)
+%
+%	True if User started Process
+%
+user_process_creator(Process, User) :-
+	rdf(Process, opmv:wasControlledBy, User).
+
+%%	user_process_joined(+Process, ?User)
+%
+%	True if User joined a Process
+
+user_process_joined(Process, User) :-
+	rdf_has(Process, opmv:wasControlledBy, User).
+
+%%	set_active_process(+Process)
+%
+%	Store current Process as the active proces in current http
+%	session.
+
+set_active_process(Process) :-
+	http_session_retractall(process(_)),
+ 	http_session_assert(process(Process)).
+
+%%	create_user_process(+Properties, -Process)
+%
+%	True if Process is the current process of User and has
+%	Properties. Creates a new user process if it doesn't exist.
+
+create_user_process(Properties, Process) :-
+	current_user_process(Process),
+	\+ rdf(Process, opmv:wasStartedAt, _),
+	resource_properties(Process, Properties),
+	!,
+	set_active_process(Process).
+create_user_process(Properties,	Process) :-
+	rdf_bnode(Process),
+	current_user_url(User),
+	set_active_process(Process),
+	http_session_id(Session),
+	rdf_transaction((rdf_assert(Process, rdf:type, opmv:'Process', Process),
+ 			 rdf_assert(Process, opmv:wasControlledBy, User, Process),
+			 rdf_assert(Process, pprime:session, Session, Process),
+			 add_resource_properties_(Properties, Process)
+			)),
+	debug(user_process, 'Process ~w created by ~w', [Process, User]).
+
+%%	start_user_process(?Process)
+%
+%	Start a process by assert the start time. When Process is
+%	variable a new process is created.
+
+start_user_process(Process) :-
+	var(Process),
+	!,
+	create_user_process([], Process),
+	start_user_process_(Process).
+start_user_process(Process) :-
+	start_user_process_(Process).
+
+start_user_process_(Process) :-
+	get_time(StartTime0),
+	format_iso_dateTime(StartTime0, StartTime),
+	rdf_transaction(rdf_assert(Process, opmv:wasStartedAt, literal(type(xsd:date, StartTime)), Process)),
+	debug(user_process, 'Process ~w started at ~w', [Process, StartTime]).
+
+%%	end_user_process(+Process)
+%
+%	End a process, by asserting the endTime
+
+end_user_process(Process) :-
+ 	get_time(EndTime0),
+	format_iso_dateTime(EndTime0, EndTime),
+	rdf_transaction((rdf_assert(Process, opmv:wasEndedAt, literal(type(xsd:date, EndTime), Process), Process)
+  			)),
+	debug(user_process, 'Process ~w ended at ~w', [Process, EndTime]).
+
+%%	join_user_process(+Process)
+%
+%	Add current user agent to a Process.
+
+join_user_process(Process) :-
+	current_user_url(User),
+	set_active_process(Process),
+  	rdf_transaction(rdf_assert(Process, opmv:wasPerformedBy, User, Process)),
+	debug(user_process, 'Process ~w joined by ~w', [Process, User]).
+
+
+		 /*******************************
+		 *   handy RDF resource stuff	*
+		 *******************************/
+
+%%	add_resource_properties(+URI, +Properties:list(p=v))
+%
+%	Assert properties about a URI.
+
+add_resource_properties(URI, Ps) :-
+	rdf_transaction(add_resource_properties_(Ps, URI)).
+
+add_resource_properties_([], _).
+add_resource_properties_([P=V|Ps], URI) :-
+	(   rdf(URI, P, V)
+	->  true
+	;   rdf_assert(URI, P, V, URI)
+	),
+	add_resource_properties_(Ps, URI).
+
+
+%%	resource_properties(+Resource, +Properties:list(p=v))
+%
+%	True if URI has all Properties.
+
+resource_properties(URI, Ps) :-
+	resource_properties_(Ps, URI).
+
+resource_properties_([], _).
+resource_properties_([P=V|Ps], URI) :-
+	rdf_has(URI, P, V),
+	resource_properties_(Ps, URI).
+
+
+		 /*******************************
+		 *               misc		*
+		 *******************************/
+
+%%	format_iso_date(+TimeStamp, -ISODate)
+%
+%       Format timestamp in ISO.
+
+format_iso_dateTime(TS, Formatted) :-
+	format_time(atom(Formatted), '%Y-%m-%dT%T', TS).
+
+%%	current_user_url(-UserURL)
+%
+%	True if UserURL is URL of user in this session.
+
+current_user_url(User) :-
+	http_session_id(SessionID),
+	user_property(User0, session(SessionID)),
+	user_property(User0, url(User)).
diff --git a/lib/video_annotation.pl b/lib/video_annotation.pl
new file mode 100644
index 0000000..99165a6
--- /dev/null
+++ b/lib/video_annotation.pl
@@ -0,0 +1,431 @@
+:- module(yaz_video_annotation,
+	  [ annotation_process/4,         % ?User, ?Video, ?Process
+	    value_annotation/4,           % +Value, ?Process, +User, -Time
+	    video_annotations/3,          % +Video, -Annotations, +Options
+	    video_annotation/4,	          % +Video, -AnnotationId, -Value, -Time
+	    video_annotation/5,	          % +Video, -AnnotationId, -Value, -Time, +Options
+	    video_tag/2,                  % +Video, -Tag
+ 	    video_provenance/2,           % +Video, -Provenance
+	    video_transaction/2,          % +Video, -Transaction
+	    annotations_per_interval/3,	  % +Annotations, +Interval, +Groups
+	    annotation_value/2,		  % +AnnotationId, -Value
+	    annotation_provenance/2,	  % +AnnotationId, -Provenance
+	    annotation_transaction/2,     % +AnnotationId, -Transaction
+	    process_provenance/3,         % +Process, +Condiation, -Provenance
+	    process_transaction/3,        % +Process, +Condition, -Transaction
+	    user_transaction/4,           % +Process, +User, +Condition, -Transaction
+
+	    create_video_annotation/4,    % +Video, +Value, +Playhead, -AnnotationId
+	    create_video_annotation/5,    % +Video, +Value, +Playhead, +User, -AnnotationId
+	    remove_video_annotation/2,    % +Video, +AnnotationId
+	    update_annotation_value/2,    % +AnnotationId, +Value
+	    update_annotation_time/2      % +AnnotationId, +Time
+	  ]).
+
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_parameters)).
+:- use_module(library(http/http_path)).
+:- use_module(library(http/http_json)).
+:- use_module(library(http/json)).
+:- use_module(library(http/json_convert)).
+:- use_module(library(http/http_session)).
+:- use_module(library(semweb/rdf_db)).
+:- use_module(user(user_db)).
+
+:- use_module(library(rdf_history)).
+:- use_module(library(user_process)).
+:- use_module(library(yaz_util)).
+
+/** <module> Handling of time-based video annotations
+
+This module deals with accessing and modifying video annotations. It
+uses the rdf_history  for   Wiki-like collaborative editing of an
+RDF graph.
+
+The video annotations can be accessed, created and modified through
+an HTTP API yaz/data/video
++(list,create,remove,update/value,update/time)
+The API uses the current session to provide provenance information to
+the created and modified triples.
+
+@TBD Support compound time objects for intervals
+@TBD rdf_history to OPM library for export of provenance
+
+@author	Michiel Hildebrand
+*/
+
+
+
+		 /*******************************
+		 *	   db access		*
+		 *******************************/
+
+%%	annotation_process(?User, ?Video, ?Process, -Time)
+%
+%	True if Video is annotated by User and has at least one
+%	transaction. When User is undefined all processes are returned.
+
+annotation_process(User, Video, Process, Time) :-
+	nonvar(User),
+	!,
+	rdf_has(Process, opmv:wasControlledBy, User),
+	rdf(Process, opmv:used, Video),
+	rdf(Process, opmv:wasStartedAt, literal(type(_, Time))),
+	once(user_transaction(Process, User, true, _)).
+annotation_process(_, Video, Process, Time) :-
+	rdf(Process, opmv:used, Video),
+	rdf(Process, opmv:wasStartedAt, literal(type(_, Time))),
+	once(user_transaction(Process, _User, true, _)).
+
+%%	value_annotation(+Value, ?Process, ?User, -Time)
+%
+%	True if Time is playHead at which Value has been added.
+
+value_annotation(Value, Process, User, Time) :-
+	rdf(Annotation, rdf:value, Value, Process),
+	rdf(_, pprime:hasAnnotation, Annotation),
+ 	rdf(Annotation, pprime:creator, User),
+	rdf(Annotation, pprime:videoPlayhead, literal(Time0)),
+	literal_to_number(Time0, Time).
+
+
+%%	video_annotations(+Video, -Annotations, +Options)
+%
+%	Returns all Annotations for Video.
+%	Options:
+%
+%        * user(User)
+%	 Limit to annotations created by User
+%
+%	 * process(Process)
+%	 Limit to annotations made or modified within Process
+%
+%	 * interval(Interval)
+%	 group all annotations with a similar value and within interval
+%	 together.
+
+video_annotations(Video, Annotations, Options) :-
+	A = [Value,Time]-Id,
+	findall(A, video_annotation(Video, Id, Value, Time, Options), As0),
+	keysort(As0, As),
+	(   option(interval(Interval), Options),
+	    Interval > 0
+	->  annotations_per_interval(As, Interval, Annotations)
+	;   maplist(annotation_term, As, Annotations)
+	).
+
+annotation_term([Value,Time]-Id, annotation(Value,Time,Time,[i(Id,Time)])).
+
+%%	annotations_per_interval(+Terms, +Interval, -GroupedAnnotations)
+%
+%	A group contains all annotations with a similar value and within
+%	time Interval. Similarity of the annotation value is defined by
+%	matching_annotation_value/2.
+
+annotations_per_interval([], _, []).
+annotations_per_interval([[Value,Start]-Id|T], Interval, [A|As]) :-
+	A = annotation(Value, Start, End, [i(Id,Start)|Is]),
+	matching_value_in_interval(T, Value, Start, Start, Interval, Is, End, Rest),
+ 	annotations_per_interval(Rest, Interval, As).
+
+matching_value_in_interval([[V0,T0]-Id|As], V, Time, _, Interval, [i(Id,T0)|Is], End, Rest) :-
+	matching_annotation_value(V0, V),
+ 	T0 < Time+Interval,
+	!,
+	matching_value_in_interval(As, V, Time, T0, Interval, Is, End, Rest).
+matching_value_in_interval(Rest, _V, _Time, End, _Interval, [], End, Rest).
+
+matching_annotation_value(V, V).
+
+
+%%	video_annotation(+Video, -AnnotationId, -Value, -Time).
+%	video_annotation(+Video, -AnnotationId, -Value, -Time,
+%	+Options).
+%
+%	True if Video is annotated with AnnotationId and has properties
+%	Value and Time.
+
+video_annotation(Video, AnnotationId, Value, Time) :-
+	video_annotation(Video, AnnotationId, Value, Time, []).
+
+video_annotation(Video, AnnotationId, Value, Time, Options) :-
+	option(process(Process), Options, _),
+	option(user(User), Options, _),
+ 	rdf(Video, pprime:hasAnnotation, AnnotationId, Process),
+	once(rdf(AnnotationId, pprime:creator, User)),
+ 	rdf(AnnotationId, rdf:value, Value),
+	rdf(AnnotationId, pprime:videoPlayhead, Time0),
+	literal_to_number(Time0, Time).
+
+%%	video_tag(+Video, -Tag)
+%
+%	Tag is an annotation of Video.
+
+video_tag(Video, Tag) :-
+	rdf(Video, pprime:hasAnnotation, AnnotationId),
+  	rdf(AnnotationId, rdf:value, Tag).
+
+%%	video_provenance(+Video, -Provenance)
+%
+%	Provenance is a list of all Transactions on
+%	Video.
+
+video_provenance(Video, Provenance) :-
+	findall(T, video_transaction(Video, T), Transactions0),
+	sort_by_arg(Transactions0, 2, Transactions),
+	transactions_to_provenance(Transactions, Provenance).
+
+%%	video_transactions(+Video, -Transactions)
+%
+%	True if Transaction is a addition or a modification of an
+%	annotation on Video.
+
+video_transaction(Video, Transaction) :-
+	findall(P, rdf(P,opmv:used,Video), Processes),
+	member(Process, Processes),
+ 	rdfh_db_transaction(Process, true, Transaction).
+
+
+%%	annotation_value(?AnnotationId, ?Value)
+%
+%	True if Value is used in Annotation.
+
+annotation_value(Annotation, Value) :-
+ 	rdf(_, pprime:hasAnnotation, Annotation),
+	rdf(Annotation, rdf:value, Value).
+
+%%	annotation_provenance(+AnnotationId, -Provenance)
+%
+%	Provenance a list of all Transactions on
+%	AnnotationId.
+
+annotation_provenance(AnnotationId, Provenance) :-
+	findall(T, annotation_transaction(AnnotationId, T), Transactions0),
+	sort(Transactions0, Transactions),
+	transactions_to_provenance(Transactions, Provenance).
+
+%%	annotation_transactions(+AnnotationId, -Transactions)
+%
+%	True if Transaction is an addition or a modification of an
+%	annotation.
+
+annotation_transaction(AnnotationId, Transaction) :-
+	findall(P, rdf(AnnotationId,_,_,P), Processes0),
+	sort(Processes0, Processes),
+	member(Process:_Time, Processes),
+	%After is Time - 1,
+	rdfh_db_transaction(Process, true, Transaction),
+	is_annotation_transaction(Transaction, AnnotationId).
+
+is_annotation_transaction(Transaction, Id) :-
+	(   rdfh_transaction_memberchk(assert(Id,_,_,_), Transaction)
+	->  true
+	;   rdfh_transaction_memberchk(assert(_,_,Id,_), Transaction)
+	->  true
+	).
+
+%%	process_provenance(+Process, +Condition, -Provenance)
+%
+%	Provenance is a list of Transactions in
+%	Process
+
+process_provenance(Process, Cond, Provenance) :-
+	findall(T, process_transaction(Process, Cond, T), Transactions0),
+	sort(Transactions0, Transactions),
+	transactions_to_provenance(Transactions, Provenance).
+
+%%	process_transaction(+Process, -Transaction)
+%
+%	True if Transaction is a transaction done in Process.
+
+process_transaction(Process, Cond, Transaction) :-
+	rdfh_db_transaction(Process, Cond, Transaction),
+	Transaction = rdf_transaction(_,_,_,rdfh([_,graph(Process)|_]), _, _).
+
+%%	user_transaction(+Process, +User, +Condition, -Transaction)
+%
+%	True if Transaction is performed by User in Process.
+%
+%       Param
+%        *Condition see @rdfh_db_transaction/3.
+
+user_transaction(Process, User, Cond, Transaction) :-
+	rdfh_db_transaction(Process, Cond, Transaction),
+	Transaction = rdf_transaction(_,_,_,rdfh([user(User)|_]), _, _).
+
+		 /*******************************
+		 *           DB update	        *
+		 *******************************/
+
+:- http_handler(yaz('data/video/create'), http_create_video_annotation, []).
+:- http_handler(yaz('data/video/remove'), http_remove_video_annotation, []).
+:- http_handler(yaz('data/video/update/value'), http_update_video_annotation_value, []).
+:- http_handler(yaz('data/video/update/time'), http_update_video_annotation_time, []).
+
+
+%%	http_save_tag_entry(+Request).
+%
+%	Handler to store a tag entry for a URI.
+%	See http://n2.talis.com/wiki/RDF_JSON_Specification for JSON
+%	notation of RDF object.
+
+http_create_video_annotation(Request) :-
+	logged_on(_),
+  	http_parameters(Request,
+			[ video(Video,
+			      [description('URL of a video')]),
+			  value(Value,
+				[jsonresource, description('JSON notation of an RDF object')]),
+			  time(Time,
+			       [number, description('Time within current video')])
+			]),
+	create_video_annotation(Video, Value, Time, AnnotationId),
+	reply_json(json([annotation=AnnotationId])).
+
+%%	create_video_annotation(+Video, +Value, +Time, -AnnotationId)
+%
+%	Assert an annotation for Video at time Playhead. Returns the Id
+%	of the annotation object.
+
+create_video_annotation(Video, Value0, Time0, AnnotationId) :-
+	atom(Video),
+	valid_value(Value0, Value),
+	valid_time(Time0, Time),
+	rdf_bnode(AnnotationId),
+	rdfh_transaction((rdfh_assert(Video, pprime:hasAnnotation, AnnotationId),
+			  rdfh_assert(AnnotationId, rdf:value, Value),
+			  rdfh_assert(AnnotationId, pprime:videoPlayhead, Time)
+			 )).
+
+%%	create_video_annotation(+Video, +Value, +Time,
+%%	+User, -AnnotationId)
+%
+%	HACK to implicitly store the User.
+%	@TBD provide a means to quickly access the creator of a tag from
+%	the provenance.
+
+create_video_annotation(Video, Value0, Time0, User, AnnotationId) :-
+	atom(Video),
+	valid_value(Value0, Value),
+	valid_time(Time0, Time),
+	rdf_bnode(AnnotationId),
+	rdfh_transaction((rdfh_assert(Video, pprime:hasAnnotation, AnnotationId),
+			  rdfh_assert(AnnotationId, rdf:value, Value),
+			  rdfh_assert(AnnotationId, pprime:videoPlayhead, Time),
+			  rdfh_assert(AnnotationId, pprime:creator, User)
+			 )).
+
+%%	remove_video_annotation(+Video, +AnnotationId)
+%
+%	Retract a video annotation.
+
+remove_video_annotation(Video, AnnotationId) :-
+	atom(Video),
+	atom(AnnotationId),
+	rdfh_transaction((rdfh_retractall(Video, pprime:hasAnnotation, AnnotationId)
+			  %rdfh_retractall(AnnotationId, rdf:value, _),
+			  %rdfh_retractall(AnnotationId, pprime:videoPlayhead, _)
+			 )).
+
+%%	update_annotation_value(+AnnotationId, +NewValue)
+%
+%	Replace the existing annotation value with NewValue.
+
+update_annotation_value(AnnotationId, NewValue0) :-
+	atom(AnnotationId),
+	valid_value(NewValue0, NewValue),
+	rdf(AnnotationId, rdf:value, Value),
+	rdfh_transaction((rdfh_update(AnnotationId, rdf:value, Value->NewValue))).
+
+
+%%	update_annotation_time(+AnnotationId, +Time)
+%
+%	Replace the existing annotation time with Time.
+
+update_annotation_time(AnnotationId, NewTime0) :-
+	atom(AnnotationId),
+ 	valid_time(NewTime0, NewTime),
+ 	rdf(AnnotationId, pprime:videoPlayhead, Time),
+	rdfh_transaction((rdfh_update(AnnotationId, pprime:videoPlayhead, Time->NewTime))).
+
+
+%%	transactions_to_provenance(+TransactionList, -Provenance)
+%
+%	Translate a list of transaction to a provenance description.
+
+transactions_to_provenance([], []).
+transactions_to_provenance([T|Ts], [P|Ps]) :-
+	T = rdf_transaction(Id, _Nesting, Time, rdfh(Message), Actions, _Graphs),
+	canonical_action(Actions, CanonicalAction),
+	!,
+	memberchk(user(User), Message),
+	memberchk(graph(Graph), Message),
+	P = action(Id,Time,User,Graph,CanonicalAction),
+ 	transactions_to_provenance(Ts, Ps).
+transactions_to_provenance([_T|Ts], Ps) :-
+ 	transactions_to_provenance(Ts, Ps).
+
+canonical_action([assert(Video, _, AnnotationId, _),
+		  assert(_, P1, Value, _),
+		  assert(_, P2, Time, _)
+		  |_% hack
+		 ], Action) :-
+	rdf_equal(P1, rdf:value),
+	rdf_equal(P2, pprime:videoPlayhead),
+	!,
+	Action = added(Video, AnnotationId, Value, Time).
+canonical_action([retract(Video, P, AnnotationId, _)
+ 		 ], Action) :-
+	rdf_equal(P, pprime:hasAnnotation),
+	!,
+	Action = removed(AnnotationId, Video).
+canonical_action(Actions, Action) :-
+	(   Actions = [ retract(AnnotationId, P, _Value, _),
+			assert(AnnotationId, P, NewValue, _)
+		      ]
+	->  true
+	;   Actions = [	assert(AnnotationId, P, NewValue, _) ]
+	),
+ 	(   rdf_equal(P, pprime:videoPlayhead)
+	->  Type = timeChange
+	;   rdf_equal(P, rdf:value)
+	->  Type = valueChange
+	),
+	Action =.. [Type, AnnotationId, NewValue].
+
+
+%%	valid_value(+Value, -ValidValue)
+%
+%	True if Value is ground and either a literal or a URI.
+
+valid_value(Value, Valid) :-
+	ground(Value),
+	(   Value = literal(_) % TBD test for lang and type?
+	->  Valid = Value
+	;   Value = uri(Valid)
+	->  atom(Valid)
+	;   atom(Value)
+	->  Valid = literal(Value)
+	;   type_error(value_object, Value)
+	).
+
+%%	valid_time(+Time, -ValidTime)
+%
+%	True if Value is ground and either a literal or a number.
+
+valid_time(Time, Valid) :-
+	ground(Time),
+	(   Time = literal(_)
+	->  Valid = Time
+ 	;   number(Time)
+	->  Valid = literal(Time)
+	;   type_error(time_object, Time)
+	).
+
+
+		 /*******************************
+		 *               misc		*
+		 *******************************/
+
+rdf_history:rdfh_hook(graph(Process)) :-
+	current_user_process(Process).
diff --git a/lib/yaz_util.pl b/lib/yaz_util.pl
new file mode 100644
index 0000000..6773138
--- /dev/null
+++ b/lib/yaz_util.pl
@@ -0,0 +1,304 @@
+:- module(yaz_util,
+	  [ list_offset/3,
+	    list_limit/4,
+	    pairs_sort_by_value_count/2,
+	    arg_key/3,
+	    sort_by_arg/3,
+	    sort_by_arg/4,
+	    group_by_arg/3,
+	    display_label/2,
+	    tag_label/2,
+	    tag_term_label/3,
+	    literal_to_number/2,
+	    is_annotation_event/1,
+	    game_time/3,
+	    tag_entry_time/2,
+	    iri_to_url/2,
+	    delete_nonground/2,
+	    video_source/2,
+	    video_source/3
+	  ]).
+
+:- use_module(library(semweb/rdf_db)).
+:- use_module(library(semweb/rdfs)).
+:- use_module(library(semweb/rdf_label)).
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/json)).
+:- use_module(library(http/json_convert)).
+
+:- rdf_meta
+        is_annotation_event(r),
+	annotation_class(r),
+	%label_property(r),
+	display_label(r, -).
+
+%%	list_offset(+List, +N, -SmallerList)
+%
+%	SmallerList starts at the nth element of List.
+
+list_offset(L, N, []) :-
+	length(L, Length),
+	Length < N,
+	!.
+list_offset(L, N, L1) :-
+	list_offset_(L, N, L1).
+
+list_offset_(L, 0, L) :- !.
+list_offset_([_|T], N, Rest) :-
+	N1 is N-1,
+	list_offset_(T, N1, Rest).
+
+%%	list_limit(+List, +N, -SmallerList, -Rest)
+%
+%	SmallerList ends at the nth element of List.
+
+list_limit(L, N, L, []) :-
+	length(L, Length),
+	Length < N,
+	!.
+list_limit(L, N, L1, Rest) :-
+	list_limit_(L, N, L1, Rest).
+
+list_limit_(Rest, 0, [], Rest) :- !.
+list_limit_([H|T], N, [H|T1], Rest) :-
+	N1 is N-1,
+	list_limit_(T, N1, T1, Rest).
+
+%%	pairs_sort_by_value_count(+Pairs:key-list,
+%%	-Sorted:listcount-key)
+%
+%	Sorted is a list with the keys of Pairs sorted by the number of
+%	elements in the value list.
+
+pairs_sort_by_value_count(Grouped, Sorted) :-
+ 	pairs_value_count(Grouped, Counted),
+	keysort(Counted, Sorted0),
+	reverse(Sorted0, Sorted).
+
+pairs_value_count([], []).
+pairs_value_count([Key-Values|T], [Count-Key|Rest]) :-
+	length(Values, Count),
+ 	pairs_value_count(T, Rest).
+
+
+%%	sort_by_arg(+ListOfTerms, +Arg, -SortedList)
+%
+%	SortedList contains the Terms from ListOfTerms sorted by their
+%	nth Arg.
+
+sort_by_arg(List, Arg, Sorted) :-
+	maplist(arg_key(Arg), List, Pairs),
+	keysort(Pairs, SortedPairs),
+	pairs_values(SortedPairs, Sorted).
+
+%%	sort_by_arg(+ListOfTerms, +Arg, +Direction, -SortedList)
+%
+%	SortedList contains the Terms from ListOfTerms sorted by their
+%	nth Arg.
+
+sort_by_arg(List, Arg, Direction, Sorted) :-
+	sort_by_arg(List, Arg, Sorted0),
+	(   Direction == desc
+	->  reverse(Sorted0, Sorted)
+	;   Sorted = Sorted0
+	).
+
+%%	group_by_arg(+ListOfTerms, +Arg, -GroupedList)
+%
+%	GroupedList contains the Terms from ListOfTerms grouped by their
+%	nth Arg.
+
+group_by_arg(List, Arg, Sorted) :-
+	maplist(arg_key(Arg), List, Pairs),
+	keysort(Pairs, SortedPairs),
+	group_pairs_by_key(SortedPairs, Sorted).
+
+arg_key(Args, Term, Keys-Term) :-
+	is_list(Args),
+	!,
+	args(Args, Term, Keys).
+arg_key(Arg, Term, Key-Term) :-
+	arg(Arg, Term, Key).
+
+args([A], Term, [Key]) :- !,
+	arg(A, Term, Key).
+args([A|As], Term, [Key|Ks]) :-
+	arg(A, Term, Key),
+	args(As, Term, Ks).
+
+
+/*
+:- multifile
+	label_property/1.		% ?Resource
+
+%%	label_property(?Property) is nondet.
+%
+%	True if the value of  Property   can  be  used to (non-uniquely)
+%	describe an object to the user.
+
+label_property(P) :-
+	cliopatria:label_property(P).
+label_property(skos:prefLabel).
+label_property(dc:title).
+label_property(skos:altLabel).
+label_property(rdfs:label).
+*/
+
+%%	display_label(+Resource, -Txt)
+%
+%	Txt is a label of Resource suited for display.
+
+display_label(R, Label) :-
+	label_property(P),
+	rdf_has(R, P, Lit),
+	!,
+	literal_text(Lit, Label).
+display_label(R, Label) :-
+	rdfs_label(R, Label).
+
+
+%%	literal_to_number(+Literal, ?Number)
+%
+%	Conversion between RDF literal and numbers.
+
+literal_to_number(Literal, Number) :-
+	literal_text(Literal, Txt),
+	(   number(Txt)
+	->  Number = Txt
+	;   atom_number(Txt, Number)
+	).
+
+%%	tag_label(?Term, ?Label)
+%
+%	Label is the label of Term.
+
+tag_label(Term, Label) :-
+	rdf(Term, rdfs:label, Literal),
+	literal_text(Literal, Label).
+
+%%	tag_term_label(+Tag, -Term, -Label)
+%
+%	Term is the URI of a Tag, or the label in case of a literal.
+
+tag_term_label(Tag, Term, Label) :-
+	(   Tag = literal(_)
+	->  literal_text(Tag, Label),
+	    Term = Label % hmm do we want this, do language tags matter?
+	;   rdf(Tag, rdf:type, pprime:'Term')
+	->  tag_label(Tag, Label),
+	    Term = ''
+	;   Term = Tag,
+	    display_label(Tag, Label)
+	).
+
+
+%%	is_annotation_event(+Resource)
+%
+%	True if Resource is of type that we consider an annotation event
+
+is_annotation_event(R) :-
+	rdf(R, rdf:type, Class),
+	annotation_class(Class),
+	!.
+
+annotation_class(pprime:'Game').
+annotation_class(pprime:'AnnotationSession').
+
+
+%%	game_time(?Game, ?StartTime, ?EndTime)
+%
+%	True if StartTime is the value of sem:beginsAt and EndTime the
+%	value of sem:endsAt.
+
+game_time(Game, StartTime, EndTime) :-
+	rdf(Game, opmv:wasStartedAt, Start),
+	literal_text(Start, StartTime),
+	(   rdf(Game, sem:wasEndedAt, End)
+	->  literal_text(End, EndTime)
+	;   EndTime = 0
+	).
+
+%%	tagentry_entry_time(?EntryId, ?Time)
+%
+%	Time is the time of tag entry.
+
+tag_entry_time(TagEntry, Time) :-
+	rdf(TagEntry, pprime:videoPlayhead, Time0),
+	literal_to_number(Time0, Time).
+
+%%	iri_to_url(+IRI, -URL) is det.
+%
+%	Translate a IRI (using arbitrary unicode characters) into an
+%	URL that can be handled to http_open/3, etc.
+%
+%	@tbd	Very incomplete.  We must map other forbidden characters
+%		and do UTF-8 and % encoding for anything >= 128.
+
+iri_to_url(IRI, URL) :-
+	atom_codes(IRI, Codes),
+	phrase(iri_to_url(Codes), URLCodes),
+	atom_codes(URL, URLCodes).
+
+iri_to_url([]) -->
+	[].
+iri_to_url([H|T]) -->
+	map_code(H), !,
+	iri_to_url(T).
+iri_to_url([H|T]) -->
+	[H],
+	iri_to_url(T).
+
+
+map_code(32) --> "%20".		% Space
+map_code(43) --> "%20".		% +
+
+
+%	hook into html_write:attribute_value//1.
+
+:- multifile
+	html_write:expand_attribute_value//1.
+
+html_write:expand_attribute_value(link_to_id(ID, Params)) -->
+	{ http_link_to_id(ID, Params, Location) },
+	html_write:html_quoted_attribute(Location).
+
+%%	delete_nonground(+ListIn, -ListOut)
+%
+%	Remove nonground terms from List.
+
+delete_nonground([], []).
+delete_nonground([H|T], [H|Rest]) :-
+	ground(H),
+	!,
+	delete_nonground(T, Rest).
+delete_nonground([_H|T], Rest) :-
+ 	delete_nonground(T, Rest).
+
+
+%%	video_source(+URL, -Video)
+%
+%	True if Video is a pprime:video of URL.
+%	Otherwise URL might be a Video???
+
+video_source(URL, Video, Duration) :-
+	video_source(URL, Video),
+	(   rdf(URL, pprime:duration, literal(Duration))
+	->  true%atom_number(Duration0, Duration)
+	;   Duration = 0
+	).
+
+video_source(URL, Video) :-
+	rdf_has(URL, pprime:video, Video).
+video_source(URL, URL).
+
+
+
+http:convert_parameter(jsonresource, Atom, Term) :-
+	atom_json_term(Atom, JSON, []),
+	json_to_prolog(JSON, Term).
+
+:- json_object
+    uri(value:uri) + [type=uri],
+    literal(lang:atom, value:_) + [type=literal],
+    literal(type:atom, value:_) + [type=literal],
+    literal(value:atom) + [type=literal].
diff --git a/rdf/cpack/yaz.ttl b/rdf/cpack/yaz.ttl
index 02d3923..c1d72c3 100644
--- a/rdf/cpack/yaz.ttl
+++ b/rdf/cpack/yaz.ttl
@@ -14,10 +14,7 @@
 <> a cpack:Package ;
 	cpack:packageName "yaz" ;
 	dcterms:title "Your Annotation Zone" ;
-	cpack:author [ a foaf:Person ;
-		       foaf:name "@FOAFNAME@" ;
-		       foaf:mbox "@FOAFMBOX@" ;
-		     ] ;
+	cpack:author <http://www.few.vu.nl/~michielh/me> ;
 	cpack:primaryRepository
 	    [ a cpack:GitRepository ;
 	      cpack:gitURL <git://semanticweb.cs.vu.nl/home/hildebra/git/ClioPatria/yaz.git>
diff --git a/web/css/annotate.css b/web/css/annotate.css
new file mode 100644
index 0000000..bb8dd39
--- /dev/null
+++ b/web/css/annotate.css
@@ -0,0 +1,49 @@
+/* input form */
+form .inputline {
+	padding-top: 5px;
+}
+.inputline .label {
+	float: left;
+	width: 6em;
+	padding-top: 0.4em;
+	height: 1.5em;
+}
+.inputline input {
+}
+
+.videobox {
+	overflow: auto;
+}
+#video {
+	float: left;
+}
+#annotate {
+}
+#tags {
+    margin: 0;
+    padding: 0;
+}
+li.ui-tagbar {
+    list-style: none;
+    margin: 5px 0 0 0;
+}
+.ui-tagbar .tag-slider {
+    margin: 4px 15px 0 45px;
+}
+.ui-tagbar .tag-times input {
+    margin-right: 2px;
+    border: 1px solid #AAA;
+    text-align: right;
+}
+.ui-tagbar .tag-play {
+    background-image: url('play.png');
+    background-repeat: no-repeat;
+    margin: 4px 0 0 4px;
+    height: 16px;
+    width:20px;
+    float:left
+}
+
+.fbs-reset {
+	text-align: left;
+}
\ No newline at end of file
diff --git a/web/css/game.css b/web/css/game.css
new file mode 100644
index 0000000..3219f7e
--- /dev/null
+++ b/web/css/game.css
@@ -0,0 +1,165 @@
+#main {
+	float: left;
+	width: 640px;
+	margin-right: 20px;
+}
+
+#players {
+	height: 400px;
+	width: 200px;
+	float: left;
+	overflow: auto;
+	border: 1px solid #DDD;
+	-moz-border-radius: 3px;
+	border-radius: 3px;
+}
+
+#videoplayer {
+	width: 100%;
+	height: 380px;
+}
+
+#taginput {
+	font-size:20px;
+	margin-top:10px;
+	padding:1px 0;
+	width:100%;
+}
+
+#waiting {
+	overflow: auto;
+}
+#options {
+	margin-top: 10px;
+}
+#waiting #players {
+	height: 100%;
+}
+h4.message {
+	font-size: 150%;
+	text-align: center;
+	margin: 0;
+	padding: 5px 0;
+	background-color: #EEE;
+}
+#waiting #video {
+	float: left;
+	margin-right: 20px;
+}
+#waiting #options {
+	font-size: 150%;
+}
+
+/* players */
+ul.game-players {
+	margin: 0;
+	padding: 0;
+}
+.game-players li {
+	list-style: none;
+	margin: 1px 0;
+	padding: 4px 8px;
+	overflow: auto;
+	font-size: 150%;
+}
+.game-players li .count {
+	float: left;
+	padding-right: 5px;
+}
+.game-players li .name {
+	float: left;
+}
+.game-players li .score {
+	float: right;
+}
+
+/* tags */
+
+#tags {
+	margin-top: 10px;
+	overflow: auto;
+}
+ul.tag-list {
+	margin: 0;
+	padding: 0;
+}
+.tag-list li {
+	float: left;
+	list-style: none;
+	margin: 2px 4px 2px 0;
+	padding: 4px 8px;
+	
+	border: 1px solid #DDD;
+	-moz-border-radius: 3px;
+	border-radius: 3px;
+	background-color: #F2F2F2;
+}
+.tag-list li.exact {
+	border-color: olive;
+	background-color: olive;
+	color: white;
+}
+.tag-list li.first {
+	border-color: navy;
+	background-color: navy;
+	color: white;
+}
+.tag-list li.uri {
+	text-decoration: underline;
+}
+.hidden {
+	display: none;
+}
+
+/* channels */
+.channels {
+	
+}
+.channel {
+	float: left;
+	width: 200px;
+	overflow: hidden;
+	margin-right: 15px;
+}
+.channel h4 {
+	margin: 0 0 5px;
+	padding: 0 3px;
+	height: 1.2em;
+	overflow: hidden;
+}
+.channel .players {
+	margin: 5px 0;
+	padding: 0 3px;
+	text-align: center;
+}
+.channel img {
+	width: 100%;
+}
+
+/* input form */
+form .inputline {
+	padding-top: 5px;
+}
+.inputline .label {
+	float: left;
+	width: 6em;
+	padding-top: 0.4em;
+	height: 1.5em;
+}
+.inputline input {
+}
+
+/* freebase suggest */
+#suggest {
+	position: absolute;
+}
+.fbs-pane {
+	text-align: left;
+}
+	/* show only first 4 suggestions */
+.fbs-list li {
+	display: none;
+}
+.fbs-list li:nth-child(-n+4) {
+	display:block;
+}
\ No newline at end of file
diff --git a/web/css/garden.css b/web/css/garden.css
new file mode 100644
index 0000000..0d5ae82
--- /dev/null
+++ b/web/css/garden.css
@@ -0,0 +1,233 @@
+#body {
+	margin: 0 auto;
+}
+
+/* page layout */
+#main {
+    padding-left: 225px;
+}
+#tags {
+	float: left;
+	width: 200px;
+	height: 600px;
+}
+#frames {
+}
+#video {
+}
+
+/* element style */
+
+h4 {
+	margin: 0;
+	padding-bottom: 2px;
+	border-color: #BBB;
+	border-style: solid;
+	border-width: 0 0 1px;
+	font-weight: normal;
+	font-size: 130%;
+}
+
+/* video frames */
+.yui3-video-frames-content {
+	overflow: hidden;
+}
+.yui3-video-frames ul.frames-list {
+	margin: 0;
+	padding: 0;
+	overflow: auto;
+	height: 500px;
+}
+.yui3-video-frames li {
+	width: 175px;
+	float: left;
+	overflow: hidden;
+	list-style: none;
+	margin: 0 10px 10px 0;
+}
+.yui3-video-frames img {
+	width: 100%;
+}
+.yui3-video-frames .frame-confirm {
+	text-align: center;
+	color: white;
+	background-color: #222;
+	padding: 3px 0;
+}
+.yui3-video-frames .tag {
+	text-align: center;
+	padding: 3px 0;
+	background-color: #DDD;
+}
+.yui3-video-frames li.hidden {
+	display: none;
+}
+.yui3-video-frames .frame-confirm.depicted {
+	background-color: green;
+}
+.yui3-video-frames .frame-confirm.associated {
+	background-color: blue;
+}
+.yui3-video-frames .frame-confirm.rejected  {
+	background-color: red;
+}
+.yui3-video-frames .users {
+	z-index:4;
+	width: 20px;
+	height: 20px;
+	position:relative;
+	margin-bottom: -20px;
+	background-color:white;
+	-moz-border-radius: 0 0 20px 0;
+	border-radius: 0 0 20px 0;
+}
+.yui3-video-frames .image {
+	position: relative;
+	z-index: 2;
+	height: 98px;
+	overflow: hidden;
+}
+.yui3-video-frames .users.hidden {
+	display: none;
+}
+
+/* videoplayer */
+.yui3-videoplayer {
+	position: absolute;
+	padding-left: -1px;
+	z-index:3;
+}
+.yui3-videoplayer-hidden {
+	display:none;
+}
+
+/* tag list */
+.yui3-tag-carousel-content {
+	overflow:auto;
+}
+.yui3-tag-carousel ul {
+	margin: 0;
+	padding: 0;
+}
+.yui3-tag-carousel li {
+	overflow: hidden;
+	list-style: none;
+	margin: 1px 0;
+	padding: 4px 8px;
+}
+.yui3-tag-carousel li .label {
+	cursor: pointer;
+	float: left;
+}
+.yui3-tag-carousel li .count {
+	float: right;
+	background-color:#CCCCCC;
+	color:white;
+	padding: 1px 2px;
+	-moz-border-radius: 6px;
+	border-radius: 6px;
+}
+.yui3-tag-carousel li.focus,
+.yui3-tag-carousel li.focus .count,
+.yui3-tag-carousel li.focus a {
+	background-color: #1057AE;
+	color: #FFF;
+}
+.yui3-tag-carousel li .edit,
+.yui3-tag-carousel li .remove {
+	float: right;
+	padding: 0 4px;
+}
+.yui3-tag-carousel li .edit a,
+.yui3-tag-carousel li .remove a {
+	color: #AAA;
+}
+.yui3-tag-carousel li .edit a:hover,
+.yui3-tag-carousel li .remove a:hover {
+	color: red;
+}
+
+.yui3-tag-carousel li .label input {
+	width: 120px;
+}
+
+
+/* tabview */
+.yui3-tabview-list {
+	margin: 0;
+	padding: 0 0 2px;
+	border-color: #BBB;
+	border-style: solid;
+	border-width: 0 0 1px;
+}
+.yui3-tab a:link {
+	font-size: 130%;
+	padding: 0 10px 2px 0;
+}
+.yui3-tab-selected a:link {
+	text-decoration: underline;
+}
+
+.controls {
+	clear: both;
+	overflow: hidden;
+}
+.controls .control {
+	float: left;
+	margin-right: 20px;
+}
+.controls input {
+	width: 2em;
+	margin: 0 5px;
+	padding: 0;
+}
+.controls label {
+	padding-right: 5px;
+}
+
+/* timeline */
+.yui3-timeline {
+	background-color:#CCCCCC;
+	height:15px;
+	margin-bottom:5px;
+	width:100%;
+}
+.yui3-timeline ul {
+	margin: 0;
+	padding: 0;
+}
+.yui3-timeline li {
+	list-style: none;
+	position: absolute;
+	margin: 1px 0;
+	height: 18px;
+	background-color:yellow;
+}
+.yui3-timeline li.hidden {
+	display: none;
+}
+.yui3-timeline li.highlight {
+	background-color:red;
+}
+
+/* concept browser */
+.yui3-columnbrowser .hd {
+	display: none;
+}
+
+/* suggest */
+.fbs-reset {
+	text-align: left;
+	z-index: 99;
+}
+#suggest {
+	margin: -3px 0 0 -3px;
+	position: absolute;
+	z-index: 99;
+}
+#suggest input {
+	width: 125px;
+}
+#suggest.hidden {
+	display: none;
+}
\ No newline at end of file
diff --git a/web/css/player.css b/web/css/player.css
new file mode 100644
index 0000000..a6ab3a1
--- /dev/null
+++ b/web/css/player.css
@@ -0,0 +1,122 @@
+#body {
+	margin: 0 auto;
+}
+
+/* element style */
+
+/* controls */
+.topcontrols {
+	text-align: right;
+	height: 20px;
+}
+.topcontrols a {
+	padding-top: 5px;
+	color: #CCC;
+}
+#video {
+	overflow: hidden;
+}
+/* tag list */
+
+/* tag player */
+#videoplayer {
+	float: left;
+}
+#tagplayer {
+	float: left;
+}
+#tagplayer.hidden {
+	display: none;
+}
+#tagplayer .yui3-tag-carousel {
+	background: transparent;
+	overflow: auto;
+}
+
+/* tag carousel */
+.yui3-tag-carousel ul {
+	margin: 0;
+	padding: 0;
+}
+.yui3-tag-carousel li {
+	overflow: hidden;
+	list-style: none;
+	margin: 1px 0;
+	padding: 4px 8px;
+	/*border-top: 1px solid #f2f2f2;*/
+}
+.yui3-tag-carousel li.focus .label {
+    font-size: 175%;
+}
+.yui3-tag-carousel li.hidden {
+	display: none;
+}
+.yui3-tag-carousel li .label {
+	cursor: pointer;
+	float: left;
+}
+.yui3-tag-carousel li .count {
+	float: right;
+	color: #AAA;
+}
+
+.yui3-tag-carousel li .edit,
+.yui3-tag-carousel li .remove {
+	float: right;
+	padding: 0 4px;
+}
+.yui3-tag-carousel li .edit a,
+.yui3-tag-carousel li .remove a {
+	color: #AAA;
+}
+.yui3-tag-carousel li .edit a:hover,
+.yui3-tag-carousel li .remove a:hover {
+	color: red;
+}
+
+.yui3-tag-carousel li .label input {
+	width: 120px;
+}
+
+.controls {
+	margin-top: 10px;
+}
+
+.tag-hit {
+}
+
+
+/* change history widget */
+.yui3-change-history ul {
+	margin: 0;
+	padding: 0;
+}
+.yui3-change-history li {
+	overflow: hidden;
+	list-style: none;
+	margin: 1px 0;
+	padding: 4px 0 4px 8px;
+	border-bottom: 1px solid #EEE;
+	
+}
+.yui3-change-history li.disabled {
+	color: #AAA;
+}
+
+.yui3-change-history-content {
+	overflow: auto;
+}
+
+.yui3-change-history li .i {
+	background-color:#CCCCCC;
+	color:white;
+	margin-right:4px;
+	padding: 1px 2px;
+	-moz-border-radius: 6px;
+	border-radius: 6px;
+}
+
+th,
+td {
+	padding: 2px 4px;
+}
\ No newline at end of file
diff --git a/web/css/tags.css b/web/css/tags.css
new file mode 100644
index 0000000..49f0635
--- /dev/null
+++ b/web/css/tags.css
@@ -0,0 +1,10 @@
+/* tags */
+.tag-list {
+	margin: 15px 0;
+	padding: 0;
+}
+.tag-list li {
+	overflow: auto;
+	list-style: none;
+	margin-bottom: 10px;
+}
diff --git a/web/css/user.css b/web/css/user.css
new file mode 100644
index 0000000..264a1ee
--- /dev/null
+++ b/web/css/user.css
@@ -0,0 +1,44 @@
+/* videos */
+
+.thumb-list {
+	overflow: auto;
+}
+
+.thumb-list {
+	margin: 10px 0;
+	padding: 0;
+}
+.thumb-list li {
+	float: left;
+	list-style: none;
+	margin-right: 20px;
+}	
+.thumb-list li .item-content {
+	width: 150px;
+	overflow: hidden;
+}
+.thumb-list .thumb-container {
+	margin-bottom: 5px
+}
+.thumb-list .games {
+	padding-top: 3px;
+	font-size: 95%;
+	color: #666;
+}
+
+/* tags */
+
+#tags .body {
+	background-color: #F5F5F5;
+}
+
+#tags .tag-cloud {
+	width: 600px;
+	margin: 0 auto;
+	padding: 20px 0;
+	text-align: center;
+}
+
+.tag-cloud a {
+	padding: 0 0.5em;
+}
\ No newline at end of file
diff --git a/web/css/videopage.css b/web/css/videopage.css
new file mode 100644
index 0000000..5b462eb
--- /dev/null
+++ b/web/css/videopage.css
@@ -0,0 +1,209 @@
+#body {
+	margin: 0 auto;
+}
+
+/* page layout */
+#main {
+    padding-left: 225px;
+}
+#tags {
+	float: left;
+	width: 200px;
+	height: 600px;
+}
+#concepts {
+}
+#concepts.hidden {
+	display:none;
+}
+#frames {
+}
+#video {
+}
+
+/* element style */
+
+h4 {
+	margin: 0;
+	padding-bottom: 2px;
+	border-color: #BBB;
+	border-style: solid;
+	border-width: 0 0 1px;
+	font-weight: normal;
+	font-size: 130%;
+}
+
+/* tag reconcile */
+.yui3-tag-reconcile {
+	width: 100%;
+}
+.yui3-tag-reconcile ul {
+	margin: 0;
+	padding: 0;
+}
+.yui3-tag-reconcile li {
+	list-style: none;
+	padding: 4px;
+	margin: 0;
+}
+.yui3-tag-reconcile li .types span {
+	padding: 0 5px;
+}
+.yui3-tag-reconcile .selection {
+	padding: 5px 0;
+	overflow: auto;
+}
+.yui3-tag-reconcile li.selected {
+	font-size: 125%;
+}
+.yui3-tag-reconcile .toggle {
+	padding-top: 1em;
+	float: right;
+}
+#suggest {
+	margin: 5px 0;
+	width: 100%;
+}
+
+/* video frames */
+.yui3-video-frames-content {
+	overflow: auto;
+}
+.yui3-video-frames ul {
+	margin: 0;
+	padding: 0;
+}
+.yui3-video-frames li {
+	width: 200px;
+	float: left;
+	overflow: hidden;
+	list-style: none;
+	margin: 0 10px 10px 0;
+}
+.yui3-video-frames li img {
+	width: 100%;
+}
+.yui3-video-frames .frame-confirm {
+	text-align: center;
+	color: white;
+	background-color: #222;
+	margin-top: -5px;
+	padding: 4px 0;
+}
+.yui3-video-frames .tag {
+	text-align: center;
+	margin-top: -5px;
+	padding: 4px 0;
+	background-color: #DDD;
+}
+.yui3-video-frames li.depicted .frame-confirm {
+	background-color: green;
+}
+.yui3-video-frames li.associated .frame-confirm {
+	background-color: blue;
+}
+.yui3-video-frames li.rejected .frame-confirm {
+	background-color: red;
+}
+
+/* controls */
+.topcontrols {
+	text-align: right;
+	height: 20px;
+}
+.topcontrols a {
+	padding-top: 5px;
+	color: #CCC;
+}
+
+/* tag list */
+
+#taglist .yui3-tag-carousel-content {
+	overflow:auto;
+}
+#taglist .yui3-tag-carousel li.focus,
+#taglist .yui3-tag-carousel li.focus .count,
+#taglist .yui3-tag-carousel li.focus a {
+	background-color: #1057AE;
+	color: #FFF;
+}
+#taglist .yui3-tag-carousel li.focus .label {
+    font-size: 100%;
+}
+
+
+/* tag player */
+#video.hidden {
+	display: none;
+	position: absolute;
+}
+#videoplayer {
+	float: left;
+}
+#tagplayer {
+	float: left;
+	background-color: #C4C4C4;
+	opacity: 0.5;
+	margin-left: -100px;
+}
+#tagplayer.hidden {
+	display: none;
+}
+#tagplayer .yui3-tag-carousel {
+	background: transparent;
+	color: #FFF;
+	overflow: hidden;
+	font-size: 90%;
+}
+
+/* tag carousel */
+.yui3-tag-carousel ul {
+	margin: 0;
+	padding: 0;
+}
+.yui3-tag-carousel li {
+	overflow: hidden;
+	list-style: none;
+	margin: 1px 0;
+	padding: 4px 8px;
+	/*border-top: 1px solid #f2f2f2;*/
+}
+.yui3-tag-carousel li.focus .label {
+    font-size: 175%;
+}
+.yui3-tag-carousel li .label {
+	cursor: pointer;
+	font-size: 110%;
+	float: left;
+}
+.yui3-tag-carousel li .count {
+	float: right;
+	color: #AAA;
+}
+
+.controls {
+	margin-top: 10px;
+}
+
+.tag-hit {
+}
+
+
+/* facets */
+.facets {
+	float: left;	
+}
+.facet {
+	margin: 5px;
+}
+.facet-title {
+	font-weight: bold;
+}
+.facet-values {
+	max-height: 200px;
+	width: 150px;
+	overflow: auto;
+}
+.facet-value {
+	padding: 2px 4px;
+}
\ No newline at end of file
diff --git a/web/css/videos.css b/web/css/videos.css
new file mode 100644
index 0000000..28b5a5c
--- /dev/null
+++ b/web/css/videos.css
@@ -0,0 +1,34 @@
+/* videos */
+.thumb-list {
+	margin: 15px 0;
+	padding: 0;
+}
+.thumb-list li.video {
+	overflow: auto;
+	list-style: none;
+	margin-bottom: 15px;
+}
+.thumb-list .thumb-container {
+	float: left;
+	margin-right: 5px;
+}
+.thumb-list .processes {
+	font-size: 95%;
+	color: #666;
+}
+.process {
+	overflow: auto;
+	margin-top: 4px;
+}
+.annotation-value {
+	float: left;
+}
+ul.annotation-times {
+	margin-left: 5px;
+	padding: 0;
+}
+.annotation-times li {
+	float: left;
+	margin-left: 5px;
+	list-style: none;
+}
\ No newline at end of file
diff --git a/web/css/yaz.css b/web/css/yaz.css
new file mode 100644
index 0000000..f7deeca
--- /dev/null
+++ b/web/css/yaz.css
@@ -0,0 +1,149 @@
+body {
+	color: #222;
+	font-family: Arial,Helvetica,sans-serif;
+	font-size: 12px;
+	text-align: center;
+}
+
+/* header */
+#header {
+	border-bottom: 1px solid #EEE;
+}
+#header .header-content {
+	height:2em;
+	margin:1.5em auto 0;
+	padding-bottom:0.8em;
+	text-align:left;
+	width:980px;
+}
+
+#header h1 {
+	margin: 0;
+	float: left;
+	font-size: 2em;
+}
+#header h1 a:hover,
+#header h1 a:visited {
+	color: olive;
+	text-decoration: none;
+}
+
+/* navigation links */
+#pagenavigation {
+	float:left;
+	height:2em;
+	line-height: 1em;
+	margin: 0 0 0 1em;
+	padding: 0.2em 0;
+}
+#pagenavigation li {
+	float: left;
+	margin: 0;
+	padding: 0.3em 8px;
+	list-style:none;
+	font-size: 1.2em;
+	border-left: 1px solid #CCC;
+}
+
+/* search */
+#pagesearch {
+	float: left;
+	margin-left: 2em;
+}
+
+#pagesearch .btn {
+	border:1px solid #CCCCCC;
+	font-size:1em;
+	height:2em;
+	vertical-align: bottom;
+ }
+#pagesearch .inp {
+	border:1px solid #CCCCCC;
+	font-size:1em;
+	height:1.4em;
+	padding:0.2em;
+	width:20em;
+}
+
+/* control links e.g. login */
+#pagecontrols {
+	float: right;
+	line-height: 1em;
+	height:2em;
+	padding-top: 0.6em;
+}
+
+#pagecontrols .login {
+	text-align: right;
+}
+
+#body {
+	width: 980px;
+	margin: 20px auto;
+	text-align: left;
+}
+
+a {
+	text-decoration: none;
+}
+a:link {
+	color: olive;
+}
+a:visited {
+	color: olive;
+}
+a:hover {
+	text-decoration: underline;
+}
+
+a img {
+	border:none;
+}	
+
+.topic .header {
+	border-bottom: 1px solid #CCC;
+	color: olive;
+}
+
+.header h2 {
+	margin-bottom: 3px;
+	font-size: 133%;
+}
+.header h2 a {
+	color: olive;
+}
+.body {
+	padding: 10px 0;
+	margin-bottom: 20px;
+	overflow: auto;
+}
+
+.paginator {
+	text-align: center;
+	margin: 10px 0 20px;
+}
+.paginator a {
+	border: 1px solid #CCC;
+	margin: 0 2px;
+	padding: 3px;
+}
+.paginator .active a {
+	color: #CCC;
+	border-color: #CCC;
+}
+
+.thumb-container {
+	margin-bottom:5px;
+	min-height:90px;
+}
+.thumb-container img {
+	-moz-border-radius: 3px;
+	border-radius: 3px;
+	border: 1px solid #DDD;
+	overflow: hidden;
+	padding: 4px;	
+}
+
+h4 {
+	margin-bottom: 3px;
+}
\ No newline at end of file
diff --git a/web/js/changehistory/changehistory.js b/web/js/changehistory/changehistory.js
new file mode 100644
index 0000000..9e5e114
--- /dev/null
+++ b/web/js/changehistory/changehistory.js
@@ -0,0 +1,163 @@
+YUI.add('change-history', function(Y) {
+
+	var Lang = Y.Lang,
+		Widget = Y.Widget,
+		Node = Y.Node;
+
+	var NS = Y.namespace('mazzle');	
+	NS.ChangeHistory = ChangeHistory;
+	
+	/* ChangeHistory class constructor */
+	function ChangeHistory(config) {
+		ChangeHistory.superclass.constructor.apply(this, arguments);
+	}
+
+	/* 
+	 * Required NAME static field, to identify the Widget class and 
+	 * used as an event prefix, to generate class names etc. (set to the 
+	 * class name in camel case). 
+	 */
+	ChangeHistory.NAME = "change-history";
+
+	/*
+	 * The attribute configuration for the ChangeHistory widget. Attributes can be
+	 * defined with default values, get/set functions and validator functions
+	 * as with any other class extending Base.
+	 */
+	ChangeHistory.ATTRS = {
+		index: {
+			value: 0
+		}
+	};
+
+	/* Static constants used to define the markup templates used to create ChangeHistory DOM elements */
+	ChangeHistory.LIST_CLASS = 'tag-list';
+	ChangeHistory.LIST_TEMPLATE = '<ul class="'+ChangeHistory.LIST_CLASS+'"></ul>';
+
+	/* ChangeHistory extends the base Widget class */
+	Y.extend(ChangeHistory, Widget, {
+
+		initializer: function() {
+			this._listNode = null;
+			this._actions = [];
+		},
+
+		destructor : function() {
+		},
+
+		renderUI : function() {
+			var content = this.get("contentBox");
+			this._listNode = content.appendChild(Node.create(ChangeHistory.LIST_TEMPLATE));
+		},
+
+		bindUI : function() {
+			Y.delegate("click", this._itemSelect, this._listNode, "li", this);
+		},
+
+		syncUI : function() {
+			this._renderActions();
+		},
+
+		_renderActions : function() {
+			var actions = this._actions;
+			this._listNode.setContent("");
+			for(var i=0; i < actions.length; i++) {
+				this._listNode.append('<li>'
+					+'<span class="i">'+i+'</span>'
+					+this.formatAction(actions[i])
+					+'</li>');
+			}
+		},
+	
+		formatAction : function(action) {
+			var type = action.type;
+				annotation = action.annotation;
+			var label = annotation.tag ? '"'+annotation.tag.value+'"' : ""; 
+			if(action.newvalue) {label += ' to "'+action.newvalue+'"'}
+			if(action.startTime) {label += ' at time '+action.startTime}
+			if(action.endTime) {label += ' - '+action.endTime}
+			var html = '<span class="type">'+type+'</span>'
+					 + '<span class="label"> '+label+'</span>';
+			return html;
+		},
+		
+		addActionHandler : function(e) {
+			var action = e.details[0];
+			this.addAction(action);
+		},
+		
+		addAction : function(action) {
+			var actions = this._actions,
+				index = this.get("index"),
+				nodes = this._listNode.all("li");
+ 			// First we remove the actions after the current index (the redos).
+			if(index<actions.length) {
+				Y.log("remove redos from "+index);
+				this._actions = actions.slice(0, index);
+				for (var i=index; i < actions.length; i++) {
+					nodes.item(i).remove();
+				}
+			}
+			// Know we add the new history item
+			index++;
+			this._actions.push(action);
+			this.set("index", index);
+			this._listNode.append('<li>'
+					+'<span class="i">'+index+'</span>'
+					+this.formatAction(action)
+					+'</li>');
+		},
+		
+		getActiveActions : function() {
+			var actions = this._actions,
+				index = this.get("index");
+
+			var active	= [];
+			for (var i=0; i < index; i++) {
+				var action = actions[i];
+				active[i] = {
+					type:action.type,
+					annotation:action.annotation
+				};
+				if(action.newvalue) { 
+					active[i].newvalue = action.newvalue;
+				}	
+			}
+			return active;
+		},
+		
+		disableAll : function() {
+			this.set("index", 0);
+			this._actions = [];
+			this._listNode.setContent("");
+			/*
+			this.set("index", 0);
+			this._listNode.all("li").each(function(node, i) {
+				node.addClass("disabled");
+			});*/
+		},
+		
+		_itemSelect : function(e) {
+			var nodes = e.container.all("li");
+				index = nodes.indexOf(e.currentTarget),
+				actions = this._actions,
+				undo = [];
+			
+			// We store the current index, so later we know 
+			// which actions are undos and redos
+			this.set("index", index);
+			
+			// The redo actions are indicated by CSS class "disabled"
+			// and collected in the history array which is send in the
+			// undo event.
+			for (var i=index; i < nodes.size(); i++) {
+				nodes.item(i).addClass("disabled");
+				undo.push(actions[i]);
+			};
+			Y.log("undo "+undo);
+			this.fire("undo", {history:undo});
+		}
+				
+	});
+	  
+}, 'gallery-2010.03.02-18' ,{requires:['node','widget']});
\ No newline at end of file
diff --git a/web/js/game/input.js b/web/js/game/input.js
new file mode 100644
index 0000000..e99529d
--- /dev/null
+++ b/web/js/game/input.js
@@ -0,0 +1,135 @@
+YUI.add('game-input', function(Y) {
+	
+	var NS = Y.namespace('mazzle');	
+	NS.GameInput = GameInput;
+	
+	function GameInput(config) {
+		GameInput.superclass.constructor.apply(this, arguments);
+	}
+
+	GameInput.NAME = "game-input";
+
+	GameInput.ATTRS = {
+		input: {
+			value: null
+		},
+		output: {
+			value: null
+		},
+		tags: {
+			value: [],
+			setter: function(val, attr) {
+				if(Y.Lang.isArray(val)) {
+					return val;
+				} else {
+					var tags = this.get("tags");
+					tags.unshift(val);
+					return tags;
+				}
+			}
+		},
+		autoAddTag: {
+			value: true
+		}
+	};
+
+	GameInput.LIST_CLASS = 'tag-list';
+	GameInput.LIST_TEMPLATE = '<ul class="'+GameInput.LIST_CLASS+'"></ul>';
+
+	/* GameInput extends the Base class */
+	Y.extend(GameInput, Y.Base, {
+
+		initializer: function() {
+			if(this.get("input")) {
+				this.input = Y.one(this.get("input"));
+				this.input.on("keydown", this._onKeyDown, this);
+			}
+			if(this.get("output")) {
+				this.output = Y.one(this.get("output"));
+				this.list = this._renderTagList();
+				this._renderTags();
+			}
+		},
+
+		destructor : function() {
+		},
+		
+		updateTags : function(matched) {
+			var tags =  this.get("tags");
+			var i=0, j=0, length=tags.length;
+			for(i; i < matched.length; i++) {
+				var match = matched[i];
+				while(j<length&&(match.label!==tags[j].label)) {
+					j++;
+				}
+				var tag = tags[j];
+				if(tag&&(tag.match!==match.match)) {
+					if(tag.match !== match.match) {
+						tag.match = match.match;
+						tag.node.addClass(match.match);
+					}
+					if(tag.order !== match.order) {
+						tag.order !== match.order;
+						tag.node.addClass(this.orderClass(match));
+					}
+				}
+			}
+			this.set("tags", tags);
+		},
+
+		_renderTagList : function() {							
+			// add list
+			var	list = this.output.one("."+GameInput.LIST_CLASS);
+			if(!list) {
+				list = Y.Node.create(GameInput.LIST_TEMPLATE);
+				this.output.appendChild(list);
+			}
+			return list;
+		},
+		
+		_renderTags : function() {
+			var tags = this.get("tags");
+ 			if(tags) {
+				for(var i=0; i < tags.length; i++) {
+					this.list.append(this.formatTag(tags[i]));
+				}
+			}
+		},
+		
+		formatTag : function(tag) {
+			return "<li class='"
+				+this.matchClass(tag)+" "
+				+this.typeClass(tag)+" "
+				+this.orderClass(tag)+"'>"
+				+tag.label+"</li>";
+		},
+		
+		matchClass : function(tag) {
+			return tag.match||"tag";
+		},
+		typeClass : function(tag) {
+			return (tag.type=="uri"||tag.uri) ? "uri" : "literal";
+		},
+		orderClass : function(tag) {
+			return (tag.match&&tag.order===1) ? "first" : "";
+		},
+		
+		addTag : function(tag) {
+			this.input.set("value", "");
+			tag.node = Y.Node.create(this.formatTag(tag));
+			this.set("tags", tag);
+			this.list.prepend(tag.node);
+		},
+		
+		_onKeyDown : function(e) {
+			if(e.charCode === 13) {
+				var tag = {label:this.input.get("value")};
+				this.fire("enter", tag);
+				if(this.get("autoAddTag")) {
+					this.addTag(tag);
+				}
+			}
+		}
+	});
+	  
+}, 'gallery-2010.03.02-18' ,{requires:['node','base']});
\ No newline at end of file
diff --git a/web/js/game/players.js b/web/js/game/players.js
new file mode 100644
index 0000000..ba3476c
--- /dev/null
+++ b/web/js/game/players.js
@@ -0,0 +1,116 @@
+YUI.add('game-players', function(Y) {
+
+	var NS = Y.namespace('mazzle');	
+	NS.GamePlayers = GamePlayers;
+	
+	function GamePlayers(config) {
+		GamePlayers.superclass.constructor.apply(this, arguments);
+	}
+
+	GamePlayers.NAME = "game-players";
+
+	GamePlayers.ATTRS = {
+		container: {
+			value: null
+		},
+		maxNumberOfPlayers: {
+			value: 50
+		},
+		emptyShow: {
+			value: false
+		},
+		countShow: {
+			value: true
+		},
+		user: {
+			value: null
+		},
+		players: {
+			value: []
+		}
+	};
+
+	GamePlayers.LIST_CLASS = 'game-players';
+	GamePlayers.LIST_TEMPLATE = '<ul class="'+GamePlayers.LIST_CLASS+'"></ul>';
+
+	/* GamePlayers extends the base Widget class */
+	Y.extend(GamePlayers, Y.Base, {
+
+		initializer: function() {
+			if(Y.one(this.get("container"))) {
+				this.list = null;
+				this.el = [];
+				this._renderContent();
+				this._renderPlayers();
+				this.after("playersChange", this.syncUI);
+			}
+		},
+
+		destructor : function() {
+		},
+		
+		// TBD animate updates
+		updatePlayers : function(players) {
+			this.set("players", players);
+			this._renderPlayers();
+		},
+
+		_renderContent : function() {
+			var content = Y.one(this.get("container")),
+				max = this.get("maxNumberOfPlayers");
+							
+			// add list
+			var	list = content.one("."+GamePlayers.LIST_CLASS);
+			if(!list) {
+				list = Y.Node.create(GamePlayers.LIST_TEMPLATE);
+				content.appendChild(list);
+			}
+			for (var i=0; i < max; i++) {
+				var node = list.appendChild(Y.Node.create('<li class="player"></li>'));
+				if(!this.get("emptyShow")) {
+					node.addClass("hidden");
+				}
+				if(this.get("countShow")) {
+					var count=i+1;
+					node.append('<div class="count">'+count+'.</div>');
+				}
+				this.el[i] = node;
+			}
+			this.list = list;
+		},
+
+		_renderPlayers : function() {
+			var players = this.get("players"),
+				el = this.el;
+ 			if(players) {
+				players.sort(this.playerSort);
+				for(var i=0; i < players.length; i++) {
+					if(el[i]) {
+						el[i].setContent(this.formatPlayer(players[i], i));
+						el[i].removeClass("hidden");
+					}
+				}
+			}
+		},
+	
+		formatPlayer : function(player, index) {
+			var html = "",
+				name = (player.name == this.get("user")) ? "You" : player.name;
+				
+			if(this.get("countShow")) {
+				var count = index+1;
+				html += '<div class="count">'+count+'.</div>';
+			}
+			html += '<div class="name">'+name+'</div>';
+			if(player.score) {
+				html += '<div class="score">'+player.score+'</div>';
+			}
+			return html;
+		},
+
+		playerSort : function(p1, p2) {
+			return p1.score < p2.score;
+		}
+	});
+	  
+}, 'gallery-2010.03.02-18' ,{requires:['node','base']});
\ No newline at end of file
diff --git a/web/js/jquery/jquery-1.4.2.min.js b/web/js/jquery/jquery-1.4.2.min.js
new file mode 100644
index 0000000..7c24308
--- /dev/null
+++ b/web/js/jquery/jquery-1.4.2.min.js
@@ -0,0 +1,154 @@
+/*!
+ * jQuery JavaScript Library v1.4.2
+ * http://jquery.com/
+ *
+ * Copyright 2010, John Resig
+ * Dual licensed under the MIT or GPL Version 2 licenses.
+ * http://jquery.org/license
+ *
+ * Includes Sizzle.js
+ * http://sizzlejs.com/
+ * Copyright 2010, The Dojo Foundation
+ * Released under the MIT, BSD, and GPL Licenses.
+ *
+ * Date: Sat Feb 13 22:33:48 2010 -0500
+ */
+(function(A,w){function ma(){if(!c.isReady){try{s.documentElement.doScroll("left")}catch(a){setTimeout(ma,1);return}c.ready()}}function Qa(a,b){b.src?c.ajax({url:b.src,async:false,dataType:"script"}):c.globalEval(b.text||b.textContent||b.innerHTML||"");b.parentNode&&b.parentNode.removeChild(b)}function X(a,b,d,f,e,j){var i=a.length;if(typeof b==="object"){for(var o in b)X(a,o,b[o],f,e,d);return a}if(d!==w){f=!j&&f&&c.isFunction(d);for(o=0;o<i;o++)e(a[o],b,f?d.call(a[o],o,e(a[o],b)):d,j);return a}return i?
+e(a[0],b):w}function J(){return(new Date).getTime()}function Y(){return false}function Z(){return true}function na(a,b,d){d[0].type=a;return c.event.handle.apply(b,d)}function oa(a){var b,d=[],f=[],e=arguments,j,i,o,k,n,r;i=c.data(this,"events");if(!(a.liveFired===this||!i||!i.live||a.button&&a.type==="click")){a.liveFired=this;var u=i.live.slice(0);for(k=0;k<u.length;k++){i=u[k];i.origType.replace(O,"")===a.type?f.push(i.selector):u.splice(k--,1)}j=c(a.target).closest(f,a.currentTarget);n=0;for(r=
+j.length;n<r;n++)for(k=0;k<u.length;k++){i=u[k];if(j[n].selector===i.selector){o=j[n].elem;f=null;if(i.preType==="mouseenter"||i.preType==="mouseleave")f=c(a.relatedTarget).closest(i.selector)[0];if(!f||f!==o)d.push({elem:o,handleObj:i})}}n=0;for(r=d.length;n<r;n++){j=d[n];a.currentTarget=j.elem;a.data=j.handleObj.data;a.handleObj=j.handleObj;if(j.handleObj.origHandler.apply(j.elem,e)===false){b=false;break}}return b}}function pa(a,b){return"live."+(a&&a!=="*"?a+".":"")+b.replace(/\./g,"`").replace(/ /g,
+"&")}function qa(a){return!a||!a.parentNode||a.parentNode.nodeType===11}function ra(a,b){var d=0;b.each(function(){if(this.nodeName===(a[d]&&a[d].nodeName)){var f=c.data(a[d++]),e=c.data(this,f);if(f=f&&f.events){delete e.handle;e.events={};for(var j in f)for(var i in f[j])c.event.add(this,j,f[j][i],f[j][i].data)}}})}function sa(a,b,d){var f,e,j;b=b&&b[0]?b[0].ownerDocument||b[0]:s;if(a.length===1&&typeof a[0]==="string"&&a[0].length<512&&b===s&&!ta.test(a[0])&&(c.support.checkClone||!ua.test(a[0]))){e=
+true;if(j=c.fragments[a[0]])if(j!==1)f=j}if(!f){f=b.createDocumentFragment();c.clean(a,b,f,d)}if(e)c.fragments[a[0]]=j?f:1;return{fragment:f,cacheable:e}}function K(a,b){var d={};c.each(va.concat.apply([],va.slice(0,b)),function(){d[this]=a});return d}function wa(a){return"scrollTo"in a&&a.document?a:a.nodeType===9?a.defaultView||a.parentWindow:false}var c=function(a,b){return new c.fn.init(a,b)},Ra=A.jQuery,Sa=A.$,s=A.document,T,Ta=/^[^<]*(<[\w\W]+>)[^>]*$|^#([\w-]+)$/,Ua=/^.[^:#\[\.,]*$/,Va=/\S/,
+Wa=/^(\s|\u00A0)+|(\s|\u00A0)+$/g,Xa=/^<(\w+)\s*\/?>(?:<\/\1>)?$/,P=navigator.userAgent,xa=false,Q=[],L,$=Object.prototype.toString,aa=Object.prototype.hasOwnProperty,ba=Array.prototype.push,R=Array.prototype.slice,ya=Array.prototype.indexOf;c.fn=c.prototype={init:function(a,b){var d,f;if(!a)return this;if(a.nodeType){this.context=this[0]=a;this.length=1;return this}if(a==="body"&&!b){this.context=s;this[0]=s.body;this.selector="body";this.length=1;return this}if(typeof a==="string")if((d=Ta.exec(a))&&
+(d[1]||!b))if(d[1]){f=b?b.ownerDocument||b:s;if(a=Xa.exec(a))if(c.isPlainObject(b)){a=[s.createElement(a[1])];c.fn.attr.call(a,b,true)}else a=[f.createElement(a[1])];else{a=sa([d[1]],[f]);a=(a.cacheable?a.fragment.cloneNode(true):a.fragment).childNodes}return c.merge(this,a)}else{if(b=s.getElementById(d[2])){if(b.id!==d[2])return T.find(a);this.length=1;this[0]=b}this.context=s;this.selector=a;return this}else if(!b&&/^\w+$/.test(a)){this.selector=a;this.context=s;a=s.getElementsByTagName(a);return c.merge(this,
+a)}else return!b||b.jquery?(b||T).find(a):c(b).find(a);else if(c.isFunction(a))return T.ready(a);if(a.selector!==w){this.selector=a.selector;this.context=a.context}return c.makeArray(a,this)},selector:"",jquery:"1.4.2",length:0,size:function(){return this.length},toArray:function(){return R.call(this,0)},get:function(a){return a==null?this.toArray():a<0?this.slice(a)[0]:this[a]},pushStack:function(a,b,d){var f=c();c.isArray(a)?ba.apply(f,a):c.merge(f,a);f.prevObject=this;f.context=this.context;if(b===
+"find")f.selector=this.selector+(this.selector?" ":"")+d;else if(b)f.selector=this.selector+"."+b+"("+d+")";return f},each:function(a,b){return c.each(this,a,b)},ready:function(a){c.bindReady();if(c.isReady)a.call(s,c);else Q&&Q.push(a);return this},eq:function(a){return a===-1?this.slice(a):this.slice(a,+a+1)},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},slice:function(){return this.pushStack(R.apply(this,arguments),"slice",R.call(arguments).join(","))},map:function(a){return this.pushStack(c.map(this,
+function(b,d){return a.call(b,d,b)}))},end:function(){return this.prevObject||c(null)},push:ba,sort:[].sort,splice:[].splice};c.fn.init.prototype=c.fn;c.extend=c.fn.extend=function(){var a=arguments[0]||{},b=1,d=arguments.length,f=false,e,j,i,o;if(typeof a==="boolean"){f=a;a=arguments[1]||{};b=2}if(typeof a!=="object"&&!c.isFunction(a))a={};if(d===b){a=this;--b}for(;b<d;b++)if((e=arguments[b])!=null)for(j in e){i=a[j];o=e[j];if(a!==o)if(f&&o&&(c.isPlainObject(o)||c.isArray(o))){i=i&&(c.isPlainObject(i)||
+c.isArray(i))?i:c.isArray(o)?[]:{};a[j]=c.extend(f,i,o)}else if(o!==w)a[j]=o}return a};c.extend({noConflict:function(a){A.$=Sa;if(a)A.jQuery=Ra;return c},isReady:false,ready:function(){if(!c.isReady){if(!s.body)return setTimeout(c.ready,13);c.isReady=true;if(Q){for(var a,b=0;a=Q[b++];)a.call(s,c);Q=null}c.fn.triggerHandler&&c(s).triggerHandler("ready")}},bindReady:function(){if(!xa){xa=true;if(s.readyState==="complete")return c.ready();if(s.addEventListener){s.addEventListener("DOMContentLoaded",
+L,false);A.addEventListener("load",c.ready,false)}else if(s.attachEvent){s.attachEvent("onreadystatechange",L);A.attachEvent("onload",c.ready);var a=false;try{a=A.frameElement==null}catch(b){}s.documentElement.doScroll&&a&&ma()}}},isFunction:function(a){return $.call(a)==="[object Function]"},isArray:function(a){return $.call(a)==="[object Array]"},isPlainObject:function(a){if(!a||$.call(a)!=="[object Object]"||a.nodeType||a.setInterval)return false;if(a.constructor&&!aa.call(a,"constructor")&&!aa.call(a.constructor.prototype,
+"isPrototypeOf"))return false;var b;for(b in a);return b===w||aa.call(a,b)},isEmptyObject:function(a){for(var b in a)return false;return true},error:function(a){throw a;},parseJSON:function(a){if(typeof a!=="string"||!a)return null;a=c.trim(a);if(/^[\],:{}\s]*$/.test(a.replace(/\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g,"@").replace(/"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g,"]").replace(/(?:^|:|,)(?:\s*\[)+/g,"")))return A.JSON&&A.JSON.parse?A.JSON.parse(a):(new Function("return "+
+a))();else c.error("Invalid JSON: "+a)},noop:function(){},globalEval:function(a){if(a&&Va.test(a)){var b=s.getElementsByTagName("head")[0]||s.documentElement,d=s.createElement("script");d.type="text/javascript";if(c.support.scriptEval)d.appendChild(s.createTextNode(a));else d.text=a;b.insertBefore(d,b.firstChild);b.removeChild(d)}},nodeName:function(a,b){return a.nodeName&&a.nodeName.toUpperCase()===b.toUpperCase()},each:function(a,b,d){var f,e=0,j=a.length,i=j===w||c.isFunction(a);if(d)if(i)for(f in a){if(b.apply(a[f],
+d)===false)break}else for(;e<j;){if(b.apply(a[e++],d)===false)break}else if(i)for(f in a){if(b.call(a[f],f,a[f])===false)break}else for(d=a[0];e<j&&b.call(d,e,d)!==false;d=a[++e]);return a},trim:function(a){return(a||"").replace(Wa,"")},makeArray:function(a,b){b=b||[];if(a!=null)a.length==null||typeof a==="string"||c.isFunction(a)||typeof a!=="function"&&a.setInterval?ba.call(b,a):c.merge(b,a);return b},inArray:function(a,b){if(b.indexOf)return b.indexOf(a);for(var d=0,f=b.length;d<f;d++)if(b[d]===
+a)return d;return-1},merge:function(a,b){var d=a.length,f=0;if(typeof b.length==="number")for(var e=b.length;f<e;f++)a[d++]=b[f];else for(;b[f]!==w;)a[d++]=b[f++];a.length=d;return a},grep:function(a,b,d){for(var f=[],e=0,j=a.length;e<j;e++)!d!==!b(a[e],e)&&f.push(a[e]);return f},map:function(a,b,d){for(var f=[],e,j=0,i=a.length;j<i;j++){e=b(a[j],j,d);if(e!=null)f[f.length]=e}return f.concat.apply([],f)},guid:1,proxy:function(a,b,d){if(arguments.length===2)if(typeof b==="string"){d=a;a=d[b];b=w}else if(b&&
+!c.isFunction(b)){d=b;b=w}if(!b&&a)b=function(){return a.apply(d||this,arguments)};if(a)b.guid=a.guid=a.guid||b.guid||c.guid++;return b},uaMatch:function(a){a=a.toLowerCase();a=/(webkit)[ \/]([\w.]+)/.exec(a)||/(opera)(?:.*version)?[ \/]([\w.]+)/.exec(a)||/(msie) ([\w.]+)/.exec(a)||!/compatible/.test(a)&&/(mozilla)(?:.*? rv:([\w.]+))?/.exec(a)||[];return{browser:a[1]||"",version:a[2]||"0"}},browser:{}});P=c.uaMatch(P);if(P.browser){c.browser[P.browser]=true;c.browser.version=P.version}if(c.browser.webkit)c.browser.safari=
+true;if(ya)c.inArray=function(a,b){return ya.call(b,a)};T=c(s);if(s.addEventListener)L=function(){s.removeEventListener("DOMContentLoaded",L,false);c.ready()};else if(s.attachEvent)L=function(){if(s.readyState==="complete"){s.detachEvent("onreadystatechange",L);c.ready()}};(function(){c.support={};var a=s.documentElement,b=s.createElement("script"),d=s.createElement("div"),f="script"+J();d.style.display="none";d.innerHTML="   <link/><table></table><a href='/a' style='color:red;float:left;opacity:.55;'>a</a><input type='checkbox'/>";
+var e=d.getElementsByTagName("*"),j=d.getElementsByTagName("a")[0];if(!(!e||!e.length||!j)){c.support={leadingWhitespace:d.firstChild.nodeType===3,tbody:!d.getElementsByTagName("tbody").length,htmlSerialize:!!d.getElementsByTagName("link").length,style:/red/.test(j.getAttribute("style")),hrefNormalized:j.getAttribute("href")==="/a",opacity:/^0.55$/.test(j.style.opacity),cssFloat:!!j.style.cssFloat,checkOn:d.getElementsByTagName("input")[0].value==="on",optSelected:s.createElement("select").appendChild(s.createElement("option")).selected,
+parentNode:d.removeChild(d.appendChild(s.createElement("div"))).parentNode===null,deleteExpando:true,checkClone:false,scriptEval:false,noCloneEvent:true,boxModel:null};b.type="text/javascript";try{b.appendChild(s.createTextNode("window."+f+"=1;"))}catch(i){}a.insertBefore(b,a.firstChild);if(A[f]){c.support.scriptEval=true;delete A[f]}try{delete b.test}catch(o){c.support.deleteExpando=false}a.removeChild(b);if(d.attachEvent&&d.fireEvent){d.attachEvent("onclick",function k(){c.support.noCloneEvent=
+false;d.detachEvent("onclick",k)});d.cloneNode(true).fireEvent("onclick")}d=s.createElement("div");d.innerHTML="<input type='radio' name='radiotest' checked='checked'/>";a=s.createDocumentFragment();a.appendChild(d.firstChild);c.support.checkClone=a.cloneNode(true).cloneNode(true).lastChild.checked;c(function(){var k=s.createElement("div");k.style.width=k.style.paddingLeft="1px";s.body.appendChild(k);c.boxModel=c.support.boxModel=k.offsetWidth===2;s.body.removeChild(k).style.display="none"});a=function(k){var n=
+s.createElement("div");k="on"+k;var r=k in n;if(!r){n.setAttribute(k,"return;");r=typeof n[k]==="function"}return r};c.support.submitBubbles=a("submit");c.support.changeBubbles=a("change");a=b=d=e=j=null}})();c.props={"for":"htmlFor","class":"className",readonly:"readOnly",maxlength:"maxLength",cellspacing:"cellSpacing",rowspan:"rowSpan",colspan:"colSpan",tabindex:"tabIndex",usemap:"useMap",frameborder:"frameBorder"};var G="jQuery"+J(),Ya=0,za={};c.extend({cache:{},expando:G,noData:{embed:true,object:true,
+applet:true},data:function(a,b,d){if(!(a.nodeName&&c.noData[a.nodeName.toLowerCase()])){a=a==A?za:a;var f=a[G],e=c.cache;if(!f&&typeof b==="string"&&d===w)return null;f||(f=++Ya);if(typeof b==="object"){a[G]=f;e[f]=c.extend(true,{},b)}else if(!e[f]){a[G]=f;e[f]={}}a=e[f];if(d!==w)a[b]=d;return typeof b==="string"?a[b]:a}},removeData:function(a,b){if(!(a.nodeName&&c.noData[a.nodeName.toLowerCase()])){a=a==A?za:a;var d=a[G],f=c.cache,e=f[d];if(b){if(e){delete e[b];c.isEmptyObject(e)&&c.removeData(a)}}else{if(c.support.deleteExpando)delete a[c.expando];
+else a.removeAttribute&&a.removeAttribute(c.expando);delete f[d]}}}});c.fn.extend({data:function(a,b){if(typeof a==="undefined"&&this.length)return c.data(this[0]);else if(typeof a==="object")return this.each(function(){c.data(this,a)});var d=a.split(".");d[1]=d[1]?"."+d[1]:"";if(b===w){var f=this.triggerHandler("getData"+d[1]+"!",[d[0]]);if(f===w&&this.length)f=c.data(this[0],a);return f===w&&d[1]?this.data(d[0]):f}else return this.trigger("setData"+d[1]+"!",[d[0],b]).each(function(){c.data(this,
+a,b)})},removeData:function(a){return this.each(function(){c.removeData(this,a)})}});c.extend({queue:function(a,b,d){if(a){b=(b||"fx")+"queue";var f=c.data(a,b);if(!d)return f||[];if(!f||c.isArray(d))f=c.data(a,b,c.makeArray(d));else f.push(d);return f}},dequeue:function(a,b){b=b||"fx";var d=c.queue(a,b),f=d.shift();if(f==="inprogress")f=d.shift();if(f){b==="fx"&&d.unshift("inprogress");f.call(a,function(){c.dequeue(a,b)})}}});c.fn.extend({queue:function(a,b){if(typeof a!=="string"){b=a;a="fx"}if(b===
+w)return c.queue(this[0],a);return this.each(function(){var d=c.queue(this,a,b);a==="fx"&&d[0]!=="inprogress"&&c.dequeue(this,a)})},dequeue:function(a){return this.each(function(){c.dequeue(this,a)})},delay:function(a,b){a=c.fx?c.fx.speeds[a]||a:a;b=b||"fx";return this.queue(b,function(){var d=this;setTimeout(function(){c.dequeue(d,b)},a)})},clearQueue:function(a){return this.queue(a||"fx",[])}});var Aa=/[\n\t]/g,ca=/\s+/,Za=/\r/g,$a=/href|src|style/,ab=/(button|input)/i,bb=/(button|input|object|select|textarea)/i,
+cb=/^(a|area)$/i,Ba=/radio|checkbox/;c.fn.extend({attr:function(a,b){return X(this,a,b,true,c.attr)},removeAttr:function(a){return this.each(function(){c.attr(this,a,"");this.nodeType===1&&this.removeAttribute(a)})},addClass:function(a){if(c.isFunction(a))return this.each(function(n){var r=c(this);r.addClass(a.call(this,n,r.attr("class")))});if(a&&typeof a==="string")for(var b=(a||"").split(ca),d=0,f=this.length;d<f;d++){var e=this[d];if(e.nodeType===1)if(e.className){for(var j=" "+e.className+" ",
+i=e.className,o=0,k=b.length;o<k;o++)if(j.indexOf(" "+b[o]+" ")<0)i+=" "+b[o];e.className=c.trim(i)}else e.className=a}return this},removeClass:function(a){if(c.isFunction(a))return this.each(function(k){var n=c(this);n.removeClass(a.call(this,k,n.attr("class")))});if(a&&typeof a==="string"||a===w)for(var b=(a||"").split(ca),d=0,f=this.length;d<f;d++){var e=this[d];if(e.nodeType===1&&e.className)if(a){for(var j=(" "+e.className+" ").replace(Aa," "),i=0,o=b.length;i<o;i++)j=j.replace(" "+b[i]+" ",
+" ");e.className=c.trim(j)}else e.className=""}return this},toggleClass:function(a,b){var d=typeof a,f=typeof b==="boolean";if(c.isFunction(a))return this.each(function(e){var j=c(this);j.toggleClass(a.call(this,e,j.attr("class"),b),b)});return this.each(function(){if(d==="string")for(var e,j=0,i=c(this),o=b,k=a.split(ca);e=k[j++];){o=f?o:!i.hasClass(e);i[o?"addClass":"removeClass"](e)}else if(d==="undefined"||d==="boolean"){this.className&&c.data(this,"__className__",this.className);this.className=
+this.className||a===false?"":c.data(this,"__className__")||""}})},hasClass:function(a){a=" "+a+" ";for(var b=0,d=this.length;b<d;b++)if((" "+this[b].className+" ").replace(Aa," ").indexOf(a)>-1)return true;return false},val:function(a){if(a===w){var b=this[0];if(b){if(c.nodeName(b,"option"))return(b.attributes.value||{}).specified?b.value:b.text;if(c.nodeName(b,"select")){var d=b.selectedIndex,f=[],e=b.options;b=b.type==="select-one";if(d<0)return null;var j=b?d:0;for(d=b?d+1:e.length;j<d;j++){var i=
+e[j];if(i.selected){a=c(i).val();if(b)return a;f.push(a)}}return f}if(Ba.test(b.type)&&!c.support.checkOn)return b.getAttribute("value")===null?"on":b.value;return(b.value||"").replace(Za,"")}return w}var o=c.isFunction(a);return this.each(function(k){var n=c(this),r=a;if(this.nodeType===1){if(o)r=a.call(this,k,n.val());if(typeof r==="number")r+="";if(c.isArray(r)&&Ba.test(this.type))this.checked=c.inArray(n.val(),r)>=0;else if(c.nodeName(this,"select")){var u=c.makeArray(r);c("option",this).each(function(){this.selected=
+c.inArray(c(this).val(),u)>=0});if(!u.length)this.selectedIndex=-1}else this.value=r}})}});c.extend({attrFn:{val:true,css:true,html:true,text:true,data:true,width:true,height:true,offset:true},attr:function(a,b,d,f){if(!a||a.nodeType===3||a.nodeType===8)return w;if(f&&b in c.attrFn)return c(a)[b](d);f=a.nodeType!==1||!c.isXMLDoc(a);var e=d!==w;b=f&&c.props[b]||b;if(a.nodeType===1){var j=$a.test(b);if(b in a&&f&&!j){if(e){b==="type"&&ab.test(a.nodeName)&&a.parentNode&&c.error("type property can't be changed");
+a[b]=d}if(c.nodeName(a,"form")&&a.getAttributeNode(b))return a.getAttributeNode(b).nodeValue;if(b==="tabIndex")return(b=a.getAttributeNode("tabIndex"))&&b.specified?b.value:bb.test(a.nodeName)||cb.test(a.nodeName)&&a.href?0:w;return a[b]}if(!c.support.style&&f&&b==="style"){if(e)a.style.cssText=""+d;return a.style.cssText}e&&a.setAttribute(b,""+d);a=!c.support.hrefNormalized&&f&&j?a.getAttribute(b,2):a.getAttribute(b);return a===null?w:a}return c.style(a,b,d)}});var O=/\.(.*)$/,db=function(a){return a.replace(/[^\w\s\.\|`]/g,
+function(b){return"\\"+b})};c.event={add:function(a,b,d,f){if(!(a.nodeType===3||a.nodeType===8)){if(a.setInterval&&a!==A&&!a.frameElement)a=A;var e,j;if(d.handler){e=d;d=e.handler}if(!d.guid)d.guid=c.guid++;if(j=c.data(a)){var i=j.events=j.events||{},o=j.handle;if(!o)j.handle=o=function(){return typeof c!=="undefined"&&!c.event.triggered?c.event.handle.apply(o.elem,arguments):w};o.elem=a;b=b.split(" ");for(var k,n=0,r;k=b[n++];){j=e?c.extend({},e):{handler:d,data:f};if(k.indexOf(".")>-1){r=k.split(".");
+k=r.shift();j.namespace=r.slice(0).sort().join(".")}else{r=[];j.namespace=""}j.type=k;j.guid=d.guid;var u=i[k],z=c.event.special[k]||{};if(!u){u=i[k]=[];if(!z.setup||z.setup.call(a,f,r,o)===false)if(a.addEventListener)a.addEventListener(k,o,false);else a.attachEvent&&a.attachEvent("on"+k,o)}if(z.add){z.add.call(a,j);if(!j.handler.guid)j.handler.guid=d.guid}u.push(j);c.event.global[k]=true}a=null}}},global:{},remove:function(a,b,d,f){if(!(a.nodeType===3||a.nodeType===8)){var e,j=0,i,o,k,n,r,u,z=c.data(a),
+C=z&&z.events;if(z&&C){if(b&&b.type){d=b.handler;b=b.type}if(!b||typeof b==="string"&&b.charAt(0)==="."){b=b||"";for(e in C)c.event.remove(a,e+b)}else{for(b=b.split(" ");e=b[j++];){n=e;i=e.indexOf(".")<0;o=[];if(!i){o=e.split(".");e=o.shift();k=new RegExp("(^|\\.)"+c.map(o.slice(0).sort(),db).join("\\.(?:.*\\.)?")+"(\\.|$)")}if(r=C[e])if(d){n=c.event.special[e]||{};for(B=f||0;B<r.length;B++){u=r[B];if(d.guid===u.guid){if(i||k.test(u.namespace)){f==null&&r.splice(B--,1);n.remove&&n.remove.call(a,u)}if(f!=
+null)break}}if(r.length===0||f!=null&&r.length===1){if(!n.teardown||n.teardown.call(a,o)===false)Ca(a,e,z.handle);delete C[e]}}else for(var B=0;B<r.length;B++){u=r[B];if(i||k.test(u.namespace)){c.event.remove(a,n,u.handler,B);r.splice(B--,1)}}}if(c.isEmptyObject(C)){if(b=z.handle)b.elem=null;delete z.events;delete z.handle;c.isEmptyObject(z)&&c.removeData(a)}}}}},trigger:function(a,b,d,f){var e=a.type||a;if(!f){a=typeof a==="object"?a[G]?a:c.extend(c.Event(e),a):c.Event(e);if(e.indexOf("!")>=0){a.type=
+e=e.slice(0,-1);a.exclusive=true}if(!d){a.stopPropagation();c.event.global[e]&&c.each(c.cache,function(){this.events&&this.events[e]&&c.event.trigger(a,b,this.handle.elem)})}if(!d||d.nodeType===3||d.nodeType===8)return w;a.result=w;a.target=d;b=c.makeArray(b);b.unshift(a)}a.currentTarget=d;(f=c.data(d,"handle"))&&f.apply(d,b);f=d.parentNode||d.ownerDocument;try{if(!(d&&d.nodeName&&c.noData[d.nodeName.toLowerCase()]))if(d["on"+e]&&d["on"+e].apply(d,b)===false)a.result=false}catch(j){}if(!a.isPropagationStopped()&&
+f)c.event.trigger(a,b,f,true);else if(!a.isDefaultPrevented()){f=a.target;var i,o=c.nodeName(f,"a")&&e==="click",k=c.event.special[e]||{};if((!k._default||k._default.call(d,a)===false)&&!o&&!(f&&f.nodeName&&c.noData[f.nodeName.toLowerCase()])){try{if(f[e]){if(i=f["on"+e])f["on"+e]=null;c.event.triggered=true;f[e]()}}catch(n){}if(i)f["on"+e]=i;c.event.triggered=false}}},handle:function(a){var b,d,f,e;a=arguments[0]=c.event.fix(a||A.event);a.currentTarget=this;b=a.type.indexOf(".")<0&&!a.exclusive;
+if(!b){d=a.type.split(".");a.type=d.shift();f=new RegExp("(^|\\.)"+d.slice(0).sort().join("\\.(?:.*\\.)?")+"(\\.|$)")}e=c.data(this,"events");d=e[a.type];if(e&&d){d=d.slice(0);e=0;for(var j=d.length;e<j;e++){var i=d[e];if(b||f.test(i.namespace)){a.handler=i.handler;a.data=i.data;a.handleObj=i;i=i.handler.apply(this,arguments);if(i!==w){a.result=i;if(i===false){a.preventDefault();a.stopPropagation()}}if(a.isImmediatePropagationStopped())break}}}return a.result},props:"altKey attrChange attrName bubbles button cancelable charCode clientX clientY ctrlKey currentTarget data detail eventPhase fromElement handler keyCode layerX layerY metaKey newValue offsetX offsetY originalTarget pageX pageY prevValue relatedNode relatedTarget screenX screenY shiftKey srcElement target toElement view wheelDelta which".split(" "),
+fix:function(a){if(a[G])return a;var b=a;a=c.Event(b);for(var d=this.props.length,f;d;){f=this.props[--d];a[f]=b[f]}if(!a.target)a.target=a.srcElement||s;if(a.target.nodeType===3)a.target=a.target.parentNode;if(!a.relatedTarget&&a.fromElement)a.relatedTarget=a.fromElement===a.target?a.toElement:a.fromElement;if(a.pageX==null&&a.clientX!=null){b=s.documentElement;d=s.body;a.pageX=a.clientX+(b&&b.scrollLeft||d&&d.scrollLeft||0)-(b&&b.clientLeft||d&&d.clientLeft||0);a.pageY=a.clientY+(b&&b.scrollTop||
+d&&d.scrollTop||0)-(b&&b.clientTop||d&&d.clientTop||0)}if(!a.which&&(a.charCode||a.charCode===0?a.charCode:a.keyCode))a.which=a.charCode||a.keyCode;if(!a.metaKey&&a.ctrlKey)a.metaKey=a.ctrlKey;if(!a.which&&a.button!==w)a.which=a.button&1?1:a.button&2?3:a.button&4?2:0;return a},guid:1E8,proxy:c.proxy,special:{ready:{setup:c.bindReady,teardown:c.noop},live:{add:function(a){c.event.add(this,a.origType,c.extend({},a,{handler:oa}))},remove:function(a){var b=true,d=a.origType.replace(O,"");c.each(c.data(this,
+"events").live||[],function(){if(d===this.origType.replace(O,""))return b=false});b&&c.event.remove(this,a.origType,oa)}},beforeunload:{setup:function(a,b,d){if(this.setInterval)this.onbeforeunload=d;return false},teardown:function(a,b){if(this.onbeforeunload===b)this.onbeforeunload=null}}}};var Ca=s.removeEventListener?function(a,b,d){a.removeEventListener(b,d,false)}:function(a,b,d){a.detachEvent("on"+b,d)};c.Event=function(a){if(!this.preventDefault)return new c.Event(a);if(a&&a.type){this.originalEvent=
+a;this.type=a.type}else this.type=a;this.timeStamp=J();this[G]=true};c.Event.prototype={preventDefault:function(){this.isDefaultPrevented=Z;var a=this.originalEvent;if(a){a.preventDefault&&a.preventDefault();a.returnValue=false}},stopPropagation:function(){this.isPropagationStopped=Z;var a=this.originalEvent;if(a){a.stopPropagation&&a.stopPropagation();a.cancelBubble=true}},stopImmediatePropagation:function(){this.isImmediatePropagationStopped=Z;this.stopPropagation()},isDefaultPrevented:Y,isPropagationStopped:Y,
+isImmediatePropagationStopped:Y};var Da=function(a){var b=a.relatedTarget;try{for(;b&&b!==this;)b=b.parentNode;if(b!==this){a.type=a.data;c.event.handle.apply(this,arguments)}}catch(d){}},Ea=function(a){a.type=a.data;c.event.handle.apply(this,arguments)};c.each({mouseenter:"mouseover",mouseleave:"mouseout"},function(a,b){c.event.special[a]={setup:function(d){c.event.add(this,b,d&&d.selector?Ea:Da,a)},teardown:function(d){c.event.remove(this,b,d&&d.selector?Ea:Da)}}});if(!c.support.submitBubbles)c.event.special.submit=
+{setup:function(){if(this.nodeName.toLowerCase()!=="form"){c.event.add(this,"click.specialSubmit",function(a){var b=a.target,d=b.type;if((d==="submit"||d==="image")&&c(b).closest("form").length)return na("submit",this,arguments)});c.event.add(this,"keypress.specialSubmit",function(a){var b=a.target,d=b.type;if((d==="text"||d==="password")&&c(b).closest("form").length&&a.keyCode===13)return na("submit",this,arguments)})}else return false},teardown:function(){c.event.remove(this,".specialSubmit")}};
+if(!c.support.changeBubbles){var da=/textarea|input|select/i,ea,Fa=function(a){var b=a.type,d=a.value;if(b==="radio"||b==="checkbox")d=a.checked;else if(b==="select-multiple")d=a.selectedIndex>-1?c.map(a.options,function(f){return f.selected}).join("-"):"";else if(a.nodeName.toLowerCase()==="select")d=a.selectedIndex;return d},fa=function(a,b){var d=a.target,f,e;if(!(!da.test(d.nodeName)||d.readOnly)){f=c.data(d,"_change_data");e=Fa(d);if(a.type!=="focusout"||d.type!=="radio")c.data(d,"_change_data",
+e);if(!(f===w||e===f))if(f!=null||e){a.type="change";return c.event.trigger(a,b,d)}}};c.event.special.change={filters:{focusout:fa,click:function(a){var b=a.target,d=b.type;if(d==="radio"||d==="checkbox"||b.nodeName.toLowerCase()==="select")return fa.call(this,a)},keydown:function(a){var b=a.target,d=b.type;if(a.keyCode===13&&b.nodeName.toLowerCase()!=="textarea"||a.keyCode===32&&(d==="checkbox"||d==="radio")||d==="select-multiple")return fa.call(this,a)},beforeactivate:function(a){a=a.target;c.data(a,
+"_change_data",Fa(a))}},setup:function(){if(this.type==="file")return false;for(var a in ea)c.event.add(this,a+".specialChange",ea[a]);return da.test(this.nodeName)},teardown:function(){c.event.remove(this,".specialChange");return da.test(this.nodeName)}};ea=c.event.special.change.filters}s.addEventListener&&c.each({focus:"focusin",blur:"focusout"},function(a,b){function d(f){f=c.event.fix(f);f.type=b;return c.event.handle.call(this,f)}c.event.special[b]={setup:function(){this.addEventListener(a,
+d,true)},teardown:function(){this.removeEventListener(a,d,true)}}});c.each(["bind","one"],function(a,b){c.fn[b]=function(d,f,e){if(typeof d==="object"){for(var j in d)this[b](j,f,d[j],e);return this}if(c.isFunction(f)){e=f;f=w}var i=b==="one"?c.proxy(e,function(k){c(this).unbind(k,i);return e.apply(this,arguments)}):e;if(d==="unload"&&b!=="one")this.one(d,f,e);else{j=0;for(var o=this.length;j<o;j++)c.event.add(this[j],d,i,f)}return this}});c.fn.extend({unbind:function(a,b){if(typeof a==="object"&&
+!a.preventDefault)for(var d in a)this.unbind(d,a[d]);else{d=0;for(var f=this.length;d<f;d++)c.event.remove(this[d],a,b)}return this},delegate:function(a,b,d,f){return this.live(b,d,f,a)},undelegate:function(a,b,d){return arguments.length===0?this.unbind("live"):this.die(b,null,d,a)},trigger:function(a,b){return this.each(function(){c.event.trigger(a,b,this)})},triggerHandler:function(a,b){if(this[0]){a=c.Event(a);a.preventDefault();a.stopPropagation();c.event.trigger(a,b,this[0]);return a.result}},
+toggle:function(a){for(var b=arguments,d=1;d<b.length;)c.proxy(a,b[d++]);return this.click(c.proxy(a,function(f){var e=(c.data(this,"lastToggle"+a.guid)||0)%d;c.data(this,"lastToggle"+a.guid,e+1);f.preventDefault();return b[e].apply(this,arguments)||false}))},hover:function(a,b){return this.mouseenter(a).mouseleave(b||a)}});var Ga={focus:"focusin",blur:"focusout",mouseenter:"mouseover",mouseleave:"mouseout"};c.each(["live","die"],function(a,b){c.fn[b]=function(d,f,e,j){var i,o=0,k,n,r=j||this.selector,
+u=j?this:c(this.context);if(c.isFunction(f)){e=f;f=w}for(d=(d||"").split(" ");(i=d[o++])!=null;){j=O.exec(i);k="";if(j){k=j[0];i=i.replace(O,"")}if(i==="hover")d.push("mouseenter"+k,"mouseleave"+k);else{n=i;if(i==="focus"||i==="blur"){d.push(Ga[i]+k);i+=k}else i=(Ga[i]||i)+k;b==="live"?u.each(function(){c.event.add(this,pa(i,r),{data:f,selector:r,handler:e,origType:i,origHandler:e,preType:n})}):u.unbind(pa(i,r),e)}}return this}});c.each("blur focus focusin focusout load resize scroll unload click dblclick mousedown mouseup mousemove mouseover mouseout mouseenter mouseleave change select submit keydown keypress keyup error".split(" "),
+function(a,b){c.fn[b]=function(d){return d?this.bind(b,d):this.trigger(b)};if(c.attrFn)c.attrFn[b]=true});A.attachEvent&&!A.addEventListener&&A.attachEvent("onunload",function(){for(var a in c.cache)if(c.cache[a].handle)try{c.event.remove(c.cache[a].handle.elem)}catch(b){}});(function(){function a(g){for(var h="",l,m=0;g[m];m++){l=g[m];if(l.nodeType===3||l.nodeType===4)h+=l.nodeValue;else if(l.nodeType!==8)h+=a(l.childNodes)}return h}function b(g,h,l,m,q,p){q=0;for(var v=m.length;q<v;q++){var t=m[q];
+if(t){t=t[g];for(var y=false;t;){if(t.sizcache===l){y=m[t.sizset];break}if(t.nodeType===1&&!p){t.sizcache=l;t.sizset=q}if(t.nodeName.toLowerCase()===h){y=t;break}t=t[g]}m[q]=y}}}function d(g,h,l,m,q,p){q=0;for(var v=m.length;q<v;q++){var t=m[q];if(t){t=t[g];for(var y=false;t;){if(t.sizcache===l){y=m[t.sizset];break}if(t.nodeType===1){if(!p){t.sizcache=l;t.sizset=q}if(typeof h!=="string"){if(t===h){y=true;break}}else if(k.filter(h,[t]).length>0){y=t;break}}t=t[g]}m[q]=y}}}var f=/((?:\((?:\([^()]+\)|[^()]+)+\)|\[(?:\[[^[\]]*\]|['"][^'"]*['"]|[^[\]'"]+)+\]|\\.|[^ >+~,(\[\\]+)+|[>+~])(\s*,\s*)?((?:.|\r|\n)*)/g,
+e=0,j=Object.prototype.toString,i=false,o=true;[0,0].sort(function(){o=false;return 0});var k=function(g,h,l,m){l=l||[];var q=h=h||s;if(h.nodeType!==1&&h.nodeType!==9)return[];if(!g||typeof g!=="string")return l;for(var p=[],v,t,y,S,H=true,M=x(h),I=g;(f.exec(""),v=f.exec(I))!==null;){I=v[3];p.push(v[1]);if(v[2]){S=v[3];break}}if(p.length>1&&r.exec(g))if(p.length===2&&n.relative[p[0]])t=ga(p[0]+p[1],h);else for(t=n.relative[p[0]]?[h]:k(p.shift(),h);p.length;){g=p.shift();if(n.relative[g])g+=p.shift();
+t=ga(g,t)}else{if(!m&&p.length>1&&h.nodeType===9&&!M&&n.match.ID.test(p[0])&&!n.match.ID.test(p[p.length-1])){v=k.find(p.shift(),h,M);h=v.expr?k.filter(v.expr,v.set)[0]:v.set[0]}if(h){v=m?{expr:p.pop(),set:z(m)}:k.find(p.pop(),p.length===1&&(p[0]==="~"||p[0]==="+")&&h.parentNode?h.parentNode:h,M);t=v.expr?k.filter(v.expr,v.set):v.set;if(p.length>0)y=z(t);else H=false;for(;p.length;){var D=p.pop();v=D;if(n.relative[D])v=p.pop();else D="";if(v==null)v=h;n.relative[D](y,v,M)}}else y=[]}y||(y=t);y||k.error(D||
+g);if(j.call(y)==="[object Array]")if(H)if(h&&h.nodeType===1)for(g=0;y[g]!=null;g++){if(y[g]&&(y[g]===true||y[g].nodeType===1&&E(h,y[g])))l.push(t[g])}else for(g=0;y[g]!=null;g++)y[g]&&y[g].nodeType===1&&l.push(t[g]);else l.push.apply(l,y);else z(y,l);if(S){k(S,q,l,m);k.uniqueSort(l)}return l};k.uniqueSort=function(g){if(B){i=o;g.sort(B);if(i)for(var h=1;h<g.length;h++)g[h]===g[h-1]&&g.splice(h--,1)}return g};k.matches=function(g,h){return k(g,null,null,h)};k.find=function(g,h,l){var m,q;if(!g)return[];
+for(var p=0,v=n.order.length;p<v;p++){var t=n.order[p];if(q=n.leftMatch[t].exec(g)){var y=q[1];q.splice(1,1);if(y.substr(y.length-1)!=="\\"){q[1]=(q[1]||"").replace(/\\/g,"");m=n.find[t](q,h,l);if(m!=null){g=g.replace(n.match[t],"");break}}}}m||(m=h.getElementsByTagName("*"));return{set:m,expr:g}};k.filter=function(g,h,l,m){for(var q=g,p=[],v=h,t,y,S=h&&h[0]&&x(h[0]);g&&h.length;){for(var H in n.filter)if((t=n.leftMatch[H].exec(g))!=null&&t[2]){var M=n.filter[H],I,D;D=t[1];y=false;t.splice(1,1);if(D.substr(D.length-
+1)!=="\\"){if(v===p)p=[];if(n.preFilter[H])if(t=n.preFilter[H](t,v,l,p,m,S)){if(t===true)continue}else y=I=true;if(t)for(var U=0;(D=v[U])!=null;U++)if(D){I=M(D,t,U,v);var Ha=m^!!I;if(l&&I!=null)if(Ha)y=true;else v[U]=false;else if(Ha){p.push(D);y=true}}if(I!==w){l||(v=p);g=g.replace(n.match[H],"");if(!y)return[];break}}}if(g===q)if(y==null)k.error(g);else break;q=g}return v};k.error=function(g){throw"Syntax error, unrecognized expression: "+g;};var n=k.selectors={order:["ID","NAME","TAG"],match:{ID:/#((?:[\w\u00c0-\uFFFF-]|\\.)+)/,
+CLASS:/\.((?:[\w\u00c0-\uFFFF-]|\\.)+)/,NAME:/\[name=['"]*((?:[\w\u00c0-\uFFFF-]|\\.)+)['"]*\]/,ATTR:/\[\s*((?:[\w\u00c0-\uFFFF-]|\\.)+)\s*(?:(\S?=)\s*(['"]*)(.*?)\3|)\s*\]/,TAG:/^((?:[\w\u00c0-\uFFFF\*-]|\\.)+)/,CHILD:/:(only|nth|last|first)-child(?:\((even|odd|[\dn+-]*)\))?/,POS:/:(nth|eq|gt|lt|first|last|even|odd)(?:\((\d*)\))?(?=[^-]|$)/,PSEUDO:/:((?:[\w\u00c0-\uFFFF-]|\\.)+)(?:\((['"]?)((?:\([^\)]+\)|[^\(\)]*)+)\2\))?/},leftMatch:{},attrMap:{"class":"className","for":"htmlFor"},attrHandle:{href:function(g){return g.getAttribute("href")}},
+relative:{"+":function(g,h){var l=typeof h==="string",m=l&&!/\W/.test(h);l=l&&!m;if(m)h=h.toLowerCase();m=0;for(var q=g.length,p;m<q;m++)if(p=g[m]){for(;(p=p.previousSibling)&&p.nodeType!==1;);g[m]=l||p&&p.nodeName.toLowerCase()===h?p||false:p===h}l&&k.filter(h,g,true)},">":function(g,h){var l=typeof h==="string";if(l&&!/\W/.test(h)){h=h.toLowerCase();for(var m=0,q=g.length;m<q;m++){var p=g[m];if(p){l=p.parentNode;g[m]=l.nodeName.toLowerCase()===h?l:false}}}else{m=0;for(q=g.length;m<q;m++)if(p=g[m])g[m]=
+l?p.parentNode:p.parentNode===h;l&&k.filter(h,g,true)}},"":function(g,h,l){var m=e++,q=d;if(typeof h==="string"&&!/\W/.test(h)){var p=h=h.toLowerCase();q=b}q("parentNode",h,m,g,p,l)},"~":function(g,h,l){var m=e++,q=d;if(typeof h==="string"&&!/\W/.test(h)){var p=h=h.toLowerCase();q=b}q("previousSibling",h,m,g,p,l)}},find:{ID:function(g,h,l){if(typeof h.getElementById!=="undefined"&&!l)return(g=h.getElementById(g[1]))?[g]:[]},NAME:function(g,h){if(typeof h.getElementsByName!=="undefined"){var l=[];
+h=h.getElementsByName(g[1]);for(var m=0,q=h.length;m<q;m++)h[m].getAttribute("name")===g[1]&&l.push(h[m]);return l.length===0?null:l}},TAG:function(g,h){return h.getElementsByTagName(g[1])}},preFilter:{CLASS:function(g,h,l,m,q,p){g=" "+g[1].replace(/\\/g,"")+" ";if(p)return g;p=0;for(var v;(v=h[p])!=null;p++)if(v)if(q^(v.className&&(" "+v.className+" ").replace(/[\t\n]/g," ").indexOf(g)>=0))l||m.push(v);else if(l)h[p]=false;return false},ID:function(g){return g[1].replace(/\\/g,"")},TAG:function(g){return g[1].toLowerCase()},
+CHILD:function(g){if(g[1]==="nth"){var h=/(-?)(\d*)n((?:\+|-)?\d*)/.exec(g[2]==="even"&&"2n"||g[2]==="odd"&&"2n+1"||!/\D/.test(g[2])&&"0n+"+g[2]||g[2]);g[2]=h[1]+(h[2]||1)-0;g[3]=h[3]-0}g[0]=e++;return g},ATTR:function(g,h,l,m,q,p){h=g[1].replace(/\\/g,"");if(!p&&n.attrMap[h])g[1]=n.attrMap[h];if(g[2]==="~=")g[4]=" "+g[4]+" ";return g},PSEUDO:function(g,h,l,m,q){if(g[1]==="not")if((f.exec(g[3])||"").length>1||/^\w/.test(g[3]))g[3]=k(g[3],null,null,h);else{g=k.filter(g[3],h,l,true^q);l||m.push.apply(m,
+g);return false}else if(n.match.POS.test(g[0])||n.match.CHILD.test(g[0]))return true;return g},POS:function(g){g.unshift(true);return g}},filters:{enabled:function(g){return g.disabled===false&&g.type!=="hidden"},disabled:function(g){return g.disabled===true},checked:function(g){return g.checked===true},selected:function(g){return g.selected===true},parent:function(g){return!!g.firstChild},empty:function(g){return!g.firstChild},has:function(g,h,l){return!!k(l[3],g).length},header:function(g){return/h\d/i.test(g.nodeName)},
+text:function(g){return"text"===g.type},radio:function(g){return"radio"===g.type},checkbox:function(g){return"checkbox"===g.type},file:function(g){return"file"===g.type},password:function(g){return"password"===g.type},submit:function(g){return"submit"===g.type},image:function(g){return"image"===g.type},reset:function(g){return"reset"===g.type},button:function(g){return"button"===g.type||g.nodeName.toLowerCase()==="button"},input:function(g){return/input|select|textarea|button/i.test(g.nodeName)}},
+setFilters:{first:function(g,h){return h===0},last:function(g,h,l,m){return h===m.length-1},even:function(g,h){return h%2===0},odd:function(g,h){return h%2===1},lt:function(g,h,l){return h<l[3]-0},gt:function(g,h,l){return h>l[3]-0},nth:function(g,h,l){return l[3]-0===h},eq:function(g,h,l){return l[3]-0===h}},filter:{PSEUDO:function(g,h,l,m){var q=h[1],p=n.filters[q];if(p)return p(g,l,h,m);else if(q==="contains")return(g.textContent||g.innerText||a([g])||"").indexOf(h[3])>=0;else if(q==="not"){h=
+h[3];l=0;for(m=h.length;l<m;l++)if(h[l]===g)return false;return true}else k.error("Syntax error, unrecognized expression: "+q)},CHILD:function(g,h){var l=h[1],m=g;switch(l){case "only":case "first":for(;m=m.previousSibling;)if(m.nodeType===1)return false;if(l==="first")return true;m=g;case "last":for(;m=m.nextSibling;)if(m.nodeType===1)return false;return true;case "nth":l=h[2];var q=h[3];if(l===1&&q===0)return true;h=h[0];var p=g.parentNode;if(p&&(p.sizcache!==h||!g.nodeIndex)){var v=0;for(m=p.firstChild;m;m=
+m.nextSibling)if(m.nodeType===1)m.nodeIndex=++v;p.sizcache=h}g=g.nodeIndex-q;return l===0?g===0:g%l===0&&g/l>=0}},ID:function(g,h){return g.nodeType===1&&g.getAttribute("id")===h},TAG:function(g,h){return h==="*"&&g.nodeType===1||g.nodeName.toLowerCase()===h},CLASS:function(g,h){return(" "+(g.className||g.getAttribute("class"))+" ").indexOf(h)>-1},ATTR:function(g,h){var l=h[1];g=n.attrHandle[l]?n.attrHandle[l](g):g[l]!=null?g[l]:g.getAttribute(l);l=g+"";var m=h[2];h=h[4];return g==null?m==="!=":m===
+"="?l===h:m==="*="?l.indexOf(h)>=0:m==="~="?(" "+l+" ").indexOf(h)>=0:!h?l&&g!==false:m==="!="?l!==h:m==="^="?l.indexOf(h)===0:m==="$="?l.substr(l.length-h.length)===h:m==="|="?l===h||l.substr(0,h.length+1)===h+"-":false},POS:function(g,h,l,m){var q=n.setFilters[h[2]];if(q)return q(g,l,h,m)}}},r=n.match.POS;for(var u in n.match){n.match[u]=new RegExp(n.match[u].source+/(?![^\[]*\])(?![^\(]*\))/.source);n.leftMatch[u]=new RegExp(/(^(?:.|\r|\n)*?)/.source+n.match[u].source.replace(/\\(\d+)/g,function(g,
+h){return"\\"+(h-0+1)}))}var z=function(g,h){g=Array.prototype.slice.call(g,0);if(h){h.push.apply(h,g);return h}return g};try{Array.prototype.slice.call(s.documentElement.childNodes,0)}catch(C){z=function(g,h){h=h||[];if(j.call(g)==="[object Array]")Array.prototype.push.apply(h,g);else if(typeof g.length==="number")for(var l=0,m=g.length;l<m;l++)h.push(g[l]);else for(l=0;g[l];l++)h.push(g[l]);return h}}var B;if(s.documentElement.compareDocumentPosition)B=function(g,h){if(!g.compareDocumentPosition||
+!h.compareDocumentPosition){if(g==h)i=true;return g.compareDocumentPosition?-1:1}g=g.compareDocumentPosition(h)&4?-1:g===h?0:1;if(g===0)i=true;return g};else if("sourceIndex"in s.documentElement)B=function(g,h){if(!g.sourceIndex||!h.sourceIndex){if(g==h)i=true;return g.sourceIndex?-1:1}g=g.sourceIndex-h.sourceIndex;if(g===0)i=true;return g};else if(s.createRange)B=function(g,h){if(!g.ownerDocument||!h.ownerDocument){if(g==h)i=true;return g.ownerDocument?-1:1}var l=g.ownerDocument.createRange(),m=
+h.ownerDocument.createRange();l.setStart(g,0);l.setEnd(g,0);m.setStart(h,0);m.setEnd(h,0);g=l.compareBoundaryPoints(Range.START_TO_END,m);if(g===0)i=true;return g};(function(){var g=s.createElement("div"),h="script"+(new Date).getTime();g.innerHTML="<a name='"+h+"'/>";var l=s.documentElement;l.insertBefore(g,l.firstChild);if(s.getElementById(h)){n.find.ID=function(m,q,p){if(typeof q.getElementById!=="undefined"&&!p)return(q=q.getElementById(m[1]))?q.id===m[1]||typeof q.getAttributeNode!=="undefined"&&
+q.getAttributeNode("id").nodeValue===m[1]?[q]:w:[]};n.filter.ID=function(m,q){var p=typeof m.getAttributeNode!=="undefined"&&m.getAttributeNode("id");return m.nodeType===1&&p&&p.nodeValue===q}}l.removeChild(g);l=g=null})();(function(){var g=s.createElement("div");g.appendChild(s.createComment(""));if(g.getElementsByTagName("*").length>0)n.find.TAG=function(h,l){l=l.getElementsByTagName(h[1]);if(h[1]==="*"){h=[];for(var m=0;l[m];m++)l[m].nodeType===1&&h.push(l[m]);l=h}return l};g.innerHTML="<a href='#'></a>";
+if(g.firstChild&&typeof g.firstChild.getAttribute!=="undefined"&&g.firstChild.getAttribute("href")!=="#")n.attrHandle.href=function(h){return h.getAttribute("href",2)};g=null})();s.querySelectorAll&&function(){var g=k,h=s.createElement("div");h.innerHTML="<p class='TEST'></p>";if(!(h.querySelectorAll&&h.querySelectorAll(".TEST").length===0)){k=function(m,q,p,v){q=q||s;if(!v&&q.nodeType===9&&!x(q))try{return z(q.querySelectorAll(m),p)}catch(t){}return g(m,q,p,v)};for(var l in g)k[l]=g[l];h=null}}();
+(function(){var g=s.createElement("div");g.innerHTML="<div class='test e'></div><div class='test'></div>";if(!(!g.getElementsByClassName||g.getElementsByClassName("e").length===0)){g.lastChild.className="e";if(g.getElementsByClassName("e").length!==1){n.order.splice(1,0,"CLASS");n.find.CLASS=function(h,l,m){if(typeof l.getElementsByClassName!=="undefined"&&!m)return l.getElementsByClassName(h[1])};g=null}}})();var E=s.compareDocumentPosition?function(g,h){return!!(g.compareDocumentPosition(h)&16)}:
+function(g,h){return g!==h&&(g.contains?g.contains(h):true)},x=function(g){return(g=(g?g.ownerDocument||g:0).documentElement)?g.nodeName!=="HTML":false},ga=function(g,h){var l=[],m="",q;for(h=h.nodeType?[h]:h;q=n.match.PSEUDO.exec(g);){m+=q[0];g=g.replace(n.match.PSEUDO,"")}g=n.relative[g]?g+"*":g;q=0;for(var p=h.length;q<p;q++)k(g,h[q],l);return k.filter(m,l)};c.find=k;c.expr=k.selectors;c.expr[":"]=c.expr.filters;c.unique=k.uniqueSort;c.text=a;c.isXMLDoc=x;c.contains=E})();var eb=/Until$/,fb=/^(?:parents|prevUntil|prevAll)/,
+gb=/,/;R=Array.prototype.slice;var Ia=function(a,b,d){if(c.isFunction(b))return c.grep(a,function(e,j){return!!b.call(e,j,e)===d});else if(b.nodeType)return c.grep(a,function(e){return e===b===d});else if(typeof b==="string"){var f=c.grep(a,function(e){return e.nodeType===1});if(Ua.test(b))return c.filter(b,f,!d);else b=c.filter(b,f)}return c.grep(a,function(e){return c.inArray(e,b)>=0===d})};c.fn.extend({find:function(a){for(var b=this.pushStack("","find",a),d=0,f=0,e=this.length;f<e;f++){d=b.length;
+c.find(a,this[f],b);if(f>0)for(var j=d;j<b.length;j++)for(var i=0;i<d;i++)if(b[i]===b[j]){b.splice(j--,1);break}}return b},has:function(a){var b=c(a);return this.filter(function(){for(var d=0,f=b.length;d<f;d++)if(c.contains(this,b[d]))return true})},not:function(a){return this.pushStack(Ia(this,a,false),"not",a)},filter:function(a){return this.pushStack(Ia(this,a,true),"filter",a)},is:function(a){return!!a&&c.filter(a,this).length>0},closest:function(a,b){if(c.isArray(a)){var d=[],f=this[0],e,j=
+{},i;if(f&&a.length){e=0;for(var o=a.length;e<o;e++){i=a[e];j[i]||(j[i]=c.expr.match.POS.test(i)?c(i,b||this.context):i)}for(;f&&f.ownerDocument&&f!==b;){for(i in j){e=j[i];if(e.jquery?e.index(f)>-1:c(f).is(e)){d.push({selector:i,elem:f});delete j[i]}}f=f.parentNode}}return d}var k=c.expr.match.POS.test(a)?c(a,b||this.context):null;return this.map(function(n,r){for(;r&&r.ownerDocument&&r!==b;){if(k?k.index(r)>-1:c(r).is(a))return r;r=r.parentNode}return null})},index:function(a){if(!a||typeof a===
+"string")return c.inArray(this[0],a?c(a):this.parent().children());return c.inArray(a.jquery?a[0]:a,this)},add:function(a,b){a=typeof a==="string"?c(a,b||this.context):c.makeArray(a);b=c.merge(this.get(),a);return this.pushStack(qa(a[0])||qa(b[0])?b:c.unique(b))},andSelf:function(){return this.add(this.prevObject)}});c.each({parent:function(a){return(a=a.parentNode)&&a.nodeType!==11?a:null},parents:function(a){return c.dir(a,"parentNode")},parentsUntil:function(a,b,d){return c.dir(a,"parentNode",
+d)},next:function(a){return c.nth(a,2,"nextSibling")},prev:function(a){return c.nth(a,2,"previousSibling")},nextAll:function(a){return c.dir(a,"nextSibling")},prevAll:function(a){return c.dir(a,"previousSibling")},nextUntil:function(a,b,d){return c.dir(a,"nextSibling",d)},prevUntil:function(a,b,d){return c.dir(a,"previousSibling",d)},siblings:function(a){return c.sibling(a.parentNode.firstChild,a)},children:function(a){return c.sibling(a.firstChild)},contents:function(a){return c.nodeName(a,"iframe")?
+a.contentDocument||a.contentWindow.document:c.makeArray(a.childNodes)}},function(a,b){c.fn[a]=function(d,f){var e=c.map(this,b,d);eb.test(a)||(f=d);if(f&&typeof f==="string")e=c.filter(f,e);e=this.length>1?c.unique(e):e;if((this.length>1||gb.test(f))&&fb.test(a))e=e.reverse();return this.pushStack(e,a,R.call(arguments).join(","))}});c.extend({filter:function(a,b,d){if(d)a=":not("+a+")";return c.find.matches(a,b)},dir:function(a,b,d){var f=[];for(a=a[b];a&&a.nodeType!==9&&(d===w||a.nodeType!==1||!c(a).is(d));){a.nodeType===
+1&&f.push(a);a=a[b]}return f},nth:function(a,b,d){b=b||1;for(var f=0;a;a=a[d])if(a.nodeType===1&&++f===b)break;return a},sibling:function(a,b){for(var d=[];a;a=a.nextSibling)a.nodeType===1&&a!==b&&d.push(a);return d}});var Ja=/ jQuery\d+="(?:\d+|null)"/g,V=/^\s+/,Ka=/(<([\w:]+)[^>]*?)\/>/g,hb=/^(?:area|br|col|embed|hr|img|input|link|meta|param)$/i,La=/<([\w:]+)/,ib=/<tbody/i,jb=/<|&#?\w+;/,ta=/<script|<object|<embed|<option|<style/i,ua=/checked\s*(?:[^=]|=\s*.checked.)/i,Ma=function(a,b,d){return hb.test(d)?
+a:b+"></"+d+">"},F={option:[1,"<select multiple='multiple'>","</select>"],legend:[1,"<fieldset>","</fieldset>"],thead:[1,"<table>","</table>"],tr:[2,"<table><tbody>","</tbody></table>"],td:[3,"<table><tbody><tr>","</tr></tbody></table>"],col:[2,"<table><tbody></tbody><colgroup>","</colgroup></table>"],area:[1,"<map>","</map>"],_default:[0,"",""]};F.optgroup=F.option;F.tbody=F.tfoot=F.colgroup=F.caption=F.thead;F.th=F.td;if(!c.support.htmlSerialize)F._default=[1,"div<div>","</div>"];c.fn.extend({text:function(a){if(c.isFunction(a))return this.each(function(b){var d=
+c(this);d.text(a.call(this,b,d.text()))});if(typeof a!=="object"&&a!==w)return this.empty().append((this[0]&&this[0].ownerDocument||s).createTextNode(a));return c.text(this)},wrapAll:function(a){if(c.isFunction(a))return this.each(function(d){c(this).wrapAll(a.call(this,d))});if(this[0]){var b=c(a,this[0].ownerDocument).eq(0).clone(true);this[0].parentNode&&b.insertBefore(this[0]);b.map(function(){for(var d=this;d.firstChild&&d.firstChild.nodeType===1;)d=d.firstChild;return d}).append(this)}return this},
+wrapInner:function(a){if(c.isFunction(a))return this.each(function(b){c(this).wrapInner(a.call(this,b))});return this.each(function(){var b=c(this),d=b.contents();d.length?d.wrapAll(a):b.append(a)})},wrap:function(a){return this.each(function(){c(this).wrapAll(a)})},unwrap:function(){return this.parent().each(function(){c.nodeName(this,"body")||c(this).replaceWith(this.childNodes)}).end()},append:function(){return this.domManip(arguments,true,function(a){this.nodeType===1&&this.appendChild(a)})},
+prepend:function(){return this.domManip(arguments,true,function(a){this.nodeType===1&&this.insertBefore(a,this.firstChild)})},before:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,false,function(b){this.parentNode.insertBefore(b,this)});else if(arguments.length){var a=c(arguments[0]);a.push.apply(a,this.toArray());return this.pushStack(a,"before",arguments)}},after:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,false,function(b){this.parentNode.insertBefore(b,
+this.nextSibling)});else if(arguments.length){var a=this.pushStack(this,"after",arguments);a.push.apply(a,c(arguments[0]).toArray());return a}},remove:function(a,b){for(var d=0,f;(f=this[d])!=null;d++)if(!a||c.filter(a,[f]).length){if(!b&&f.nodeType===1){c.cleanData(f.getElementsByTagName("*"));c.cleanData([f])}f.parentNode&&f.parentNode.removeChild(f)}return this},empty:function(){for(var a=0,b;(b=this[a])!=null;a++)for(b.nodeType===1&&c.cleanData(b.getElementsByTagName("*"));b.firstChild;)b.removeChild(b.firstChild);
+return this},clone:function(a){var b=this.map(function(){if(!c.support.noCloneEvent&&!c.isXMLDoc(this)){var d=this.outerHTML,f=this.ownerDocument;if(!d){d=f.createElement("div");d.appendChild(this.cloneNode(true));d=d.innerHTML}return c.clean([d.replace(Ja,"").replace(/=([^="'>\s]+\/)>/g,'="$1">').replace(V,"")],f)[0]}else return this.cloneNode(true)});if(a===true){ra(this,b);ra(this.find("*"),b.find("*"))}return b},html:function(a){if(a===w)return this[0]&&this[0].nodeType===1?this[0].innerHTML.replace(Ja,
+""):null;else if(typeof a==="string"&&!ta.test(a)&&(c.support.leadingWhitespace||!V.test(a))&&!F[(La.exec(a)||["",""])[1].toLowerCase()]){a=a.replace(Ka,Ma);try{for(var b=0,d=this.length;b<d;b++)if(this[b].nodeType===1){c.cleanData(this[b].getElementsByTagName("*"));this[b].innerHTML=a}}catch(f){this.empty().append(a)}}else c.isFunction(a)?this.each(function(e){var j=c(this),i=j.html();j.empty().append(function(){return a.call(this,e,i)})}):this.empty().append(a);return this},replaceWith:function(a){if(this[0]&&
+this[0].parentNode){if(c.isFunction(a))return this.each(function(b){var d=c(this),f=d.html();d.replaceWith(a.call(this,b,f))});if(typeof a!=="string")a=c(a).detach();return this.each(function(){var b=this.nextSibling,d=this.parentNode;c(this).remove();b?c(b).before(a):c(d).append(a)})}else return this.pushStack(c(c.isFunction(a)?a():a),"replaceWith",a)},detach:function(a){return this.remove(a,true)},domManip:function(a,b,d){function f(u){return c.nodeName(u,"table")?u.getElementsByTagName("tbody")[0]||
+u.appendChild(u.ownerDocument.createElement("tbody")):u}var e,j,i=a[0],o=[],k;if(!c.support.checkClone&&arguments.length===3&&typeof i==="string"&&ua.test(i))return this.each(function(){c(this).domManip(a,b,d,true)});if(c.isFunction(i))return this.each(function(u){var z=c(this);a[0]=i.call(this,u,b?z.html():w);z.domManip(a,b,d)});if(this[0]){e=i&&i.parentNode;e=c.support.parentNode&&e&&e.nodeType===11&&e.childNodes.length===this.length?{fragment:e}:sa(a,this,o);k=e.fragment;if(j=k.childNodes.length===
+1?(k=k.firstChild):k.firstChild){b=b&&c.nodeName(j,"tr");for(var n=0,r=this.length;n<r;n++)d.call(b?f(this[n],j):this[n],n>0||e.cacheable||this.length>1?k.cloneNode(true):k)}o.length&&c.each(o,Qa)}return this}});c.fragments={};c.each({appendTo:"append",prependTo:"prepend",insertBefore:"before",insertAfter:"after",replaceAll:"replaceWith"},function(a,b){c.fn[a]=function(d){var f=[];d=c(d);var e=this.length===1&&this[0].parentNode;if(e&&e.nodeType===11&&e.childNodes.length===1&&d.length===1){d[b](this[0]);
+return this}else{e=0;for(var j=d.length;e<j;e++){var i=(e>0?this.clone(true):this).get();c.fn[b].apply(c(d[e]),i);f=f.concat(i)}return this.pushStack(f,a,d.selector)}}});c.extend({clean:function(a,b,d,f){b=b||s;if(typeof b.createElement==="undefined")b=b.ownerDocument||b[0]&&b[0].ownerDocument||s;for(var e=[],j=0,i;(i=a[j])!=null;j++){if(typeof i==="number")i+="";if(i){if(typeof i==="string"&&!jb.test(i))i=b.createTextNode(i);else if(typeof i==="string"){i=i.replace(Ka,Ma);var o=(La.exec(i)||["",
+""])[1].toLowerCase(),k=F[o]||F._default,n=k[0],r=b.createElement("div");for(r.innerHTML=k[1]+i+k[2];n--;)r=r.lastChild;if(!c.support.tbody){n=ib.test(i);o=o==="table"&&!n?r.firstChild&&r.firstChild.childNodes:k[1]==="<table>"&&!n?r.childNodes:[];for(k=o.length-1;k>=0;--k)c.nodeName(o[k],"tbody")&&!o[k].childNodes.length&&o[k].parentNode.removeChild(o[k])}!c.support.leadingWhitespace&&V.test(i)&&r.insertBefore(b.createTextNode(V.exec(i)[0]),r.firstChild);i=r.childNodes}if(i.nodeType)e.push(i);else e=
+c.merge(e,i)}}if(d)for(j=0;e[j];j++)if(f&&c.nodeName(e[j],"script")&&(!e[j].type||e[j].type.toLowerCase()==="text/javascript"))f.push(e[j].parentNode?e[j].parentNode.removeChild(e[j]):e[j]);else{e[j].nodeType===1&&e.splice.apply(e,[j+1,0].concat(c.makeArray(e[j].getElementsByTagName("script"))));d.appendChild(e[j])}return e},cleanData:function(a){for(var b,d,f=c.cache,e=c.event.special,j=c.support.deleteExpando,i=0,o;(o=a[i])!=null;i++)if(d=o[c.expando]){b=f[d];if(b.events)for(var k in b.events)e[k]?
+c.event.remove(o,k):Ca(o,k,b.handle);if(j)delete o[c.expando];else o.removeAttribute&&o.removeAttribute(c.expando);delete f[d]}}});var kb=/z-?index|font-?weight|opacity|zoom|line-?height/i,Na=/alpha\([^)]*\)/,Oa=/opacity=([^)]*)/,ha=/float/i,ia=/-([a-z])/ig,lb=/([A-Z])/g,mb=/^-?\d+(?:px)?$/i,nb=/^-?\d/,ob={position:"absolute",visibility:"hidden",display:"block"},pb=["Left","Right"],qb=["Top","Bottom"],rb=s.defaultView&&s.defaultView.getComputedStyle,Pa=c.support.cssFloat?"cssFloat":"styleFloat",ja=
+function(a,b){return b.toUpperCase()};c.fn.css=function(a,b){return X(this,a,b,true,function(d,f,e){if(e===w)return c.curCSS(d,f);if(typeof e==="number"&&!kb.test(f))e+="px";c.style(d,f,e)})};c.extend({style:function(a,b,d){if(!a||a.nodeType===3||a.nodeType===8)return w;if((b==="width"||b==="height")&&parseFloat(d)<0)d=w;var f=a.style||a,e=d!==w;if(!c.support.opacity&&b==="opacity"){if(e){f.zoom=1;b=parseInt(d,10)+""==="NaN"?"":"alpha(opacity="+d*100+")";a=f.filter||c.curCSS(a,"filter")||"";f.filter=
+Na.test(a)?a.replace(Na,b):b}return f.filter&&f.filter.indexOf("opacity=")>=0?parseFloat(Oa.exec(f.filter)[1])/100+"":""}if(ha.test(b))b=Pa;b=b.replace(ia,ja);if(e)f[b]=d;return f[b]},css:function(a,b,d,f){if(b==="width"||b==="height"){var e,j=b==="width"?pb:qb;function i(){e=b==="width"?a.offsetWidth:a.offsetHeight;f!=="border"&&c.each(j,function(){f||(e-=parseFloat(c.curCSS(a,"padding"+this,true))||0);if(f==="margin")e+=parseFloat(c.curCSS(a,"margin"+this,true))||0;else e-=parseFloat(c.curCSS(a,
+"border"+this+"Width",true))||0})}a.offsetWidth!==0?i():c.swap(a,ob,i);return Math.max(0,Math.round(e))}return c.curCSS(a,b,d)},curCSS:function(a,b,d){var f,e=a.style;if(!c.support.opacity&&b==="opacity"&&a.currentStyle){f=Oa.test(a.currentStyle.filter||"")?parseFloat(RegExp.$1)/100+"":"";return f===""?"1":f}if(ha.test(b))b=Pa;if(!d&&e&&e[b])f=e[b];else if(rb){if(ha.test(b))b="float";b=b.replace(lb,"-$1").toLowerCase();e=a.ownerDocument.defaultView;if(!e)return null;if(a=e.getComputedStyle(a,null))f=
+a.getPropertyValue(b);if(b==="opacity"&&f==="")f="1"}else if(a.currentStyle){d=b.replace(ia,ja);f=a.currentStyle[b]||a.currentStyle[d];if(!mb.test(f)&&nb.test(f)){b=e.left;var j=a.runtimeStyle.left;a.runtimeStyle.left=a.currentStyle.left;e.left=d==="fontSize"?"1em":f||0;f=e.pixelLeft+"px";e.left=b;a.runtimeStyle.left=j}}return f},swap:function(a,b,d){var f={};for(var e in b){f[e]=a.style[e];a.style[e]=b[e]}d.call(a);for(e in b)a.style[e]=f[e]}});if(c.expr&&c.expr.filters){c.expr.filters.hidden=function(a){var b=
+a.offsetWidth,d=a.offsetHeight,f=a.nodeName.toLowerCase()==="tr";return b===0&&d===0&&!f?true:b>0&&d>0&&!f?false:c.curCSS(a,"display")==="none"};c.expr.filters.visible=function(a){return!c.expr.filters.hidden(a)}}var sb=J(),tb=/<script(.|\s)*?\/script>/gi,ub=/select|textarea/i,vb=/color|date|datetime|email|hidden|month|number|password|range|search|tel|text|time|url|week/i,N=/=\?(&|$)/,ka=/\?/,wb=/(\?|&)_=.*?(&|$)/,xb=/^(\w+:)?\/\/([^\/?#]+)/,yb=/%20/g,zb=c.fn.load;c.fn.extend({load:function(a,b,d){if(typeof a!==
+"string")return zb.call(this,a);else if(!this.length)return this;var f=a.indexOf(" ");if(f>=0){var e=a.slice(f,a.length);a=a.slice(0,f)}f="GET";if(b)if(c.isFunction(b)){d=b;b=null}else if(typeof b==="object"){b=c.param(b,c.ajaxSettings.traditional);f="POST"}var j=this;c.ajax({url:a,type:f,dataType:"html",data:b,complete:function(i,o){if(o==="success"||o==="notmodified")j.html(e?c("<div />").append(i.responseText.replace(tb,"")).find(e):i.responseText);d&&j.each(d,[i.responseText,o,i])}});return this},
+serialize:function(){return c.param(this.serializeArray())},serializeArray:function(){return this.map(function(){return this.elements?c.makeArray(this.elements):this}).filter(function(){return this.name&&!this.disabled&&(this.checked||ub.test(this.nodeName)||vb.test(this.type))}).map(function(a,b){a=c(this).val();return a==null?null:c.isArray(a)?c.map(a,function(d){return{name:b.name,value:d}}):{name:b.name,value:a}}).get()}});c.each("ajaxStart ajaxStop ajaxComplete ajaxError ajaxSuccess ajaxSend".split(" "),
+function(a,b){c.fn[b]=function(d){return this.bind(b,d)}});c.extend({get:function(a,b,d,f){if(c.isFunction(b)){f=f||d;d=b;b=null}return c.ajax({type:"GET",url:a,data:b,success:d,dataType:f})},getScript:function(a,b){return c.get(a,null,b,"script")},getJSON:function(a,b,d){return c.get(a,b,d,"json")},post:function(a,b,d,f){if(c.isFunction(b)){f=f||d;d=b;b={}}return c.ajax({type:"POST",url:a,data:b,success:d,dataType:f})},ajaxSetup:function(a){c.extend(c.ajaxSettings,a)},ajaxSettings:{url:location.href,
+global:true,type:"GET",contentType:"application/x-www-form-urlencoded",processData:true,async:true,xhr:A.XMLHttpRequest&&(A.location.protocol!=="file:"||!A.ActiveXObject)?function(){return new A.XMLHttpRequest}:function(){try{return new A.ActiveXObject("Microsoft.XMLHTTP")}catch(a){}},accepts:{xml:"application/xml, text/xml",html:"text/html",script:"text/javascript, application/javascript",json:"application/json, text/javascript",text:"text/plain",_default:"*/*"}},lastModified:{},etag:{},ajax:function(a){function b(){e.success&&
+e.success.call(k,o,i,x);e.global&&f("ajaxSuccess",[x,e])}function d(){e.complete&&e.complete.call(k,x,i);e.global&&f("ajaxComplete",[x,e]);e.global&&!--c.active&&c.event.trigger("ajaxStop")}function f(q,p){(e.context?c(e.context):c.event).trigger(q,p)}var e=c.extend(true,{},c.ajaxSettings,a),j,i,o,k=a&&a.context||e,n=e.type.toUpperCase();if(e.data&&e.processData&&typeof e.data!=="string")e.data=c.param(e.data,e.traditional);if(e.dataType==="jsonp"){if(n==="GET")N.test(e.url)||(e.url+=(ka.test(e.url)?
+"&":"?")+(e.jsonp||"callback")+"=?");else if(!e.data||!N.test(e.data))e.data=(e.data?e.data+"&":"")+(e.jsonp||"callback")+"=?";e.dataType="json"}if(e.dataType==="json"&&(e.data&&N.test(e.data)||N.test(e.url))){j=e.jsonpCallback||"jsonp"+sb++;if(e.data)e.data=(e.data+"").replace(N,"="+j+"$1");e.url=e.url.replace(N,"="+j+"$1");e.dataType="script";A[j]=A[j]||function(q){o=q;b();d();A[j]=w;try{delete A[j]}catch(p){}z&&z.removeChild(C)}}if(e.dataType==="script"&&e.cache===null)e.cache=false;if(e.cache===
+false&&n==="GET"){var r=J(),u=e.url.replace(wb,"$1_="+r+"$2");e.url=u+(u===e.url?(ka.test(e.url)?"&":"?")+"_="+r:"")}if(e.data&&n==="GET")e.url+=(ka.test(e.url)?"&":"?")+e.data;e.global&&!c.active++&&c.event.trigger("ajaxStart");r=(r=xb.exec(e.url))&&(r[1]&&r[1]!==location.protocol||r[2]!==location.host);if(e.dataType==="script"&&n==="GET"&&r){var z=s.getElementsByTagName("head")[0]||s.documentElement,C=s.createElement("script");C.src=e.url;if(e.scriptCharset)C.charset=e.scriptCharset;if(!j){var B=
+false;C.onload=C.onreadystatechange=function(){if(!B&&(!this.readyState||this.readyState==="loaded"||this.readyState==="complete")){B=true;b();d();C.onload=C.onreadystatechange=null;z&&C.parentNode&&z.removeChild(C)}}}z.insertBefore(C,z.firstChild);return w}var E=false,x=e.xhr();if(x){e.username?x.open(n,e.url,e.async,e.username,e.password):x.open(n,e.url,e.async);try{if(e.data||a&&a.contentType)x.setRequestHeader("Content-Type",e.contentType);if(e.ifModified){c.lastModified[e.url]&&x.setRequestHeader("If-Modified-Since",
+c.lastModified[e.url]);c.etag[e.url]&&x.setRequestHeader("If-None-Match",c.etag[e.url])}r||x.setRequestHeader("X-Requested-With","XMLHttpRequest");x.setRequestHeader("Accept",e.dataType&&e.accepts[e.dataType]?e.accepts[e.dataType]+", */*":e.accepts._default)}catch(ga){}if(e.beforeSend&&e.beforeSend.call(k,x,e)===false){e.global&&!--c.active&&c.event.trigger("ajaxStop");x.abort();return false}e.global&&f("ajaxSend",[x,e]);var g=x.onreadystatechange=function(q){if(!x||x.readyState===0||q==="abort"){E||
+d();E=true;if(x)x.onreadystatechange=c.noop}else if(!E&&x&&(x.readyState===4||q==="timeout")){E=true;x.onreadystatechange=c.noop;i=q==="timeout"?"timeout":!c.httpSuccess(x)?"error":e.ifModified&&c.httpNotModified(x,e.url)?"notmodified":"success";var p;if(i==="success")try{o=c.httpData(x,e.dataType,e)}catch(v){i="parsererror";p=v}if(i==="success"||i==="notmodified")j||b();else c.handleError(e,x,i,p);d();q==="timeout"&&x.abort();if(e.async)x=null}};try{var h=x.abort;x.abort=function(){x&&h.call(x);
+g("abort")}}catch(l){}e.async&&e.timeout>0&&setTimeout(function(){x&&!E&&g("timeout")},e.timeout);try{x.send(n==="POST"||n==="PUT"||n==="DELETE"?e.data:null)}catch(m){c.handleError(e,x,null,m);d()}e.async||g();return x}},handleError:function(a,b,d,f){if(a.error)a.error.call(a.context||a,b,d,f);if(a.global)(a.context?c(a.context):c.event).trigger("ajaxError",[b,a,f])},active:0,httpSuccess:function(a){try{return!a.status&&location.protocol==="file:"||a.status>=200&&a.status<300||a.status===304||a.status===
+1223||a.status===0}catch(b){}return false},httpNotModified:function(a,b){var d=a.getResponseHeader("Last-Modified"),f=a.getResponseHeader("Etag");if(d)c.lastModified[b]=d;if(f)c.etag[b]=f;return a.status===304||a.status===0},httpData:function(a,b,d){var f=a.getResponseHeader("content-type")||"",e=b==="xml"||!b&&f.indexOf("xml")>=0;a=e?a.responseXML:a.responseText;e&&a.documentElement.nodeName==="parsererror"&&c.error("parsererror");if(d&&d.dataFilter)a=d.dataFilter(a,b);if(typeof a==="string")if(b===
+"json"||!b&&f.indexOf("json")>=0)a=c.parseJSON(a);else if(b==="script"||!b&&f.indexOf("javascript")>=0)c.globalEval(a);return a},param:function(a,b){function d(i,o){if(c.isArray(o))c.each(o,function(k,n){b||/\[\]$/.test(i)?f(i,n):d(i+"["+(typeof n==="object"||c.isArray(n)?k:"")+"]",n)});else!b&&o!=null&&typeof o==="object"?c.each(o,function(k,n){d(i+"["+k+"]",n)}):f(i,o)}function f(i,o){o=c.isFunction(o)?o():o;e[e.length]=encodeURIComponent(i)+"="+encodeURIComponent(o)}var e=[];if(b===w)b=c.ajaxSettings.traditional;
+if(c.isArray(a)||a.jquery)c.each(a,function(){f(this.name,this.value)});else for(var j in a)d(j,a[j]);return e.join("&").replace(yb,"+")}});var la={},Ab=/toggle|show|hide/,Bb=/^([+-]=)?([\d+-.]+)(.*)$/,W,va=[["height","marginTop","marginBottom","paddingTop","paddingBottom"],["width","marginLeft","marginRight","paddingLeft","paddingRight"],["opacity"]];c.fn.extend({show:function(a,b){if(a||a===0)return this.animate(K("show",3),a,b);else{a=0;for(b=this.length;a<b;a++){var d=c.data(this[a],"olddisplay");
+this[a].style.display=d||"";if(c.css(this[a],"display")==="none"){d=this[a].nodeName;var f;if(la[d])f=la[d];else{var e=c("<"+d+" />").appendTo("body");f=e.css("display");if(f==="none")f="block";e.remove();la[d]=f}c.data(this[a],"olddisplay",f)}}a=0;for(b=this.length;a<b;a++)this[a].style.display=c.data(this[a],"olddisplay")||"";return this}},hide:function(a,b){if(a||a===0)return this.animate(K("hide",3),a,b);else{a=0;for(b=this.length;a<b;a++){var d=c.data(this[a],"olddisplay");!d&&d!=="none"&&c.data(this[a],
+"olddisplay",c.css(this[a],"display"))}a=0;for(b=this.length;a<b;a++)this[a].style.display="none";return this}},_toggle:c.fn.toggle,toggle:function(a,b){var d=typeof a==="boolean";if(c.isFunction(a)&&c.isFunction(b))this._toggle.apply(this,arguments);else a==null||d?this.each(function(){var f=d?a:c(this).is(":hidden");c(this)[f?"show":"hide"]()}):this.animate(K("toggle",3),a,b);return this},fadeTo:function(a,b,d){return this.filter(":hidden").css("opacity",0).show().end().animate({opacity:b},a,d)},
+animate:function(a,b,d,f){var e=c.speed(b,d,f);if(c.isEmptyObject(a))return this.each(e.complete);return this[e.queue===false?"each":"queue"](function(){var j=c.extend({},e),i,o=this.nodeType===1&&c(this).is(":hidden"),k=this;for(i in a){var n=i.replace(ia,ja);if(i!==n){a[n]=a[i];delete a[i];i=n}if(a[i]==="hide"&&o||a[i]==="show"&&!o)return j.complete.call(this);if((i==="height"||i==="width")&&this.style){j.display=c.css(this,"display");j.overflow=this.style.overflow}if(c.isArray(a[i])){(j.specialEasing=
+j.specialEasing||{})[i]=a[i][1];a[i]=a[i][0]}}if(j.overflow!=null)this.style.overflow="hidden";j.curAnim=c.extend({},a);c.each(a,function(r,u){var z=new c.fx(k,j,r);if(Ab.test(u))z[u==="toggle"?o?"show":"hide":u](a);else{var C=Bb.exec(u),B=z.cur(true)||0;if(C){u=parseFloat(C[2]);var E=C[3]||"px";if(E!=="px"){k.style[r]=(u||1)+E;B=(u||1)/z.cur(true)*B;k.style[r]=B+E}if(C[1])u=(C[1]==="-="?-1:1)*u+B;z.custom(B,u,E)}else z.custom(B,u,"")}});return true})},stop:function(a,b){var d=c.timers;a&&this.queue([]);
+this.each(function(){for(var f=d.length-1;f>=0;f--)if(d[f].elem===this){b&&d[f](true);d.splice(f,1)}});b||this.dequeue();return this}});c.each({slideDown:K("show",1),slideUp:K("hide",1),slideToggle:K("toggle",1),fadeIn:{opacity:"show"},fadeOut:{opacity:"hide"}},function(a,b){c.fn[a]=function(d,f){return this.animate(b,d,f)}});c.extend({speed:function(a,b,d){var f=a&&typeof a==="object"?a:{complete:d||!d&&b||c.isFunction(a)&&a,duration:a,easing:d&&b||b&&!c.isFunction(b)&&b};f.duration=c.fx.off?0:typeof f.duration===
+"number"?f.duration:c.fx.speeds[f.duration]||c.fx.speeds._default;f.old=f.complete;f.complete=function(){f.queue!==false&&c(this).dequeue();c.isFunction(f.old)&&f.old.call(this)};return f},easing:{linear:function(a,b,d,f){return d+f*a},swing:function(a,b,d,f){return(-Math.cos(a*Math.PI)/2+0.5)*f+d}},timers:[],fx:function(a,b,d){this.options=b;this.elem=a;this.prop=d;if(!b.orig)b.orig={}}});c.fx.prototype={update:function(){this.options.step&&this.options.step.call(this.elem,this.now,this);(c.fx.step[this.prop]||
+c.fx.step._default)(this);if((this.prop==="height"||this.prop==="width")&&this.elem.style)this.elem.style.display="block"},cur:function(a){if(this.elem[this.prop]!=null&&(!this.elem.style||this.elem.style[this.prop]==null))return this.elem[this.prop];return(a=parseFloat(c.css(this.elem,this.prop,a)))&&a>-10000?a:parseFloat(c.curCSS(this.elem,this.prop))||0},custom:function(a,b,d){function f(j){return e.step(j)}this.startTime=J();this.start=a;this.end=b;this.unit=d||this.unit||"px";this.now=this.start;
+this.pos=this.state=0;var e=this;f.elem=this.elem;if(f()&&c.timers.push(f)&&!W)W=setInterval(c.fx.tick,13)},show:function(){this.options.orig[this.prop]=c.style(this.elem,this.prop);this.options.show=true;this.custom(this.prop==="width"||this.prop==="height"?1:0,this.cur());c(this.elem).show()},hide:function(){this.options.orig[this.prop]=c.style(this.elem,this.prop);this.options.hide=true;this.custom(this.cur(),0)},step:function(a){var b=J(),d=true;if(a||b>=this.options.duration+this.startTime){this.now=
+this.end;this.pos=this.state=1;this.update();this.options.curAnim[this.prop]=true;for(var f in this.options.curAnim)if(this.options.curAnim[f]!==true)d=false;if(d){if(this.options.display!=null){this.elem.style.overflow=this.options.overflow;a=c.data(this.elem,"olddisplay");this.elem.style.display=a?a:this.options.display;if(c.css(this.elem,"display")==="none")this.elem.style.display="block"}this.options.hide&&c(this.elem).hide();if(this.options.hide||this.options.show)for(var e in this.options.curAnim)c.style(this.elem,
+e,this.options.orig[e]);this.options.complete.call(this.elem)}return false}else{e=b-this.startTime;this.state=e/this.options.duration;a=this.options.easing||(c.easing.swing?"swing":"linear");this.pos=c.easing[this.options.specialEasing&&this.options.specialEasing[this.prop]||a](this.state,e,0,1,this.options.duration);this.now=this.start+(this.end-this.start)*this.pos;this.update()}return true}};c.extend(c.fx,{tick:function(){for(var a=c.timers,b=0;b<a.length;b++)a[b]()||a.splice(b--,1);a.length||
+c.fx.stop()},stop:function(){clearInterval(W);W=null},speeds:{slow:600,fast:200,_default:400},step:{opacity:function(a){c.style(a.elem,"opacity",a.now)},_default:function(a){if(a.elem.style&&a.elem.style[a.prop]!=null)a.elem.style[a.prop]=(a.prop==="width"||a.prop==="height"?Math.max(0,a.now):a.now)+a.unit;else a.elem[a.prop]=a.now}}});if(c.expr&&c.expr.filters)c.expr.filters.animated=function(a){return c.grep(c.timers,function(b){return a===b.elem}).length};c.fn.offset="getBoundingClientRect"in s.documentElement?
+function(a){var b=this[0];if(a)return this.each(function(e){c.offset.setOffset(this,a,e)});if(!b||!b.ownerDocument)return null;if(b===b.ownerDocument.body)return c.offset.bodyOffset(b);var d=b.getBoundingClientRect(),f=b.ownerDocument;b=f.body;f=f.documentElement;return{top:d.top+(self.pageYOffset||c.support.boxModel&&f.scrollTop||b.scrollTop)-(f.clientTop||b.clientTop||0),left:d.left+(self.pageXOffset||c.support.boxModel&&f.scrollLeft||b.scrollLeft)-(f.clientLeft||b.clientLeft||0)}}:function(a){var b=
+this[0];if(a)return this.each(function(r){c.offset.setOffset(this,a,r)});if(!b||!b.ownerDocument)return null;if(b===b.ownerDocument.body)return c.offset.bodyOffset(b);c.offset.initialize();var d=b.offsetParent,f=b,e=b.ownerDocument,j,i=e.documentElement,o=e.body;f=(e=e.defaultView)?e.getComputedStyle(b,null):b.currentStyle;for(var k=b.offsetTop,n=b.offsetLeft;(b=b.parentNode)&&b!==o&&b!==i;){if(c.offset.supportsFixedPosition&&f.position==="fixed")break;j=e?e.getComputedStyle(b,null):b.currentStyle;
+k-=b.scrollTop;n-=b.scrollLeft;if(b===d){k+=b.offsetTop;n+=b.offsetLeft;if(c.offset.doesNotAddBorder&&!(c.offset.doesAddBorderForTableAndCells&&/^t(able|d|h)$/i.test(b.nodeName))){k+=parseFloat(j.borderTopWidth)||0;n+=parseFloat(j.borderLeftWidth)||0}f=d;d=b.offsetParent}if(c.offset.subtractsBorderForOverflowNotVisible&&j.overflow!=="visible"){k+=parseFloat(j.borderTopWidth)||0;n+=parseFloat(j.borderLeftWidth)||0}f=j}if(f.position==="relative"||f.position==="static"){k+=o.offsetTop;n+=o.offsetLeft}if(c.offset.supportsFixedPosition&&
+f.position==="fixed"){k+=Math.max(i.scrollTop,o.scrollTop);n+=Math.max(i.scrollLeft,o.scrollLeft)}return{top:k,left:n}};c.offset={initialize:function(){var a=s.body,b=s.createElement("div"),d,f,e,j=parseFloat(c.curCSS(a,"marginTop",true))||0;c.extend(b.style,{position:"absolute",top:0,left:0,margin:0,border:0,width:"1px",height:"1px",visibility:"hidden"});b.innerHTML="<div style='position:absolute;top:0;left:0;margin:0;border:5px solid #000;padding:0;width:1px;height:1px;'><div></div></div><table style='position:absolute;top:0;left:0;margin:0;border:5px solid #000;padding:0;width:1px;height:1px;' cellpadding='0' cellspacing='0'><tr><td></td></tr></table>";
+a.insertBefore(b,a.firstChild);d=b.firstChild;f=d.firstChild;e=d.nextSibling.firstChild.firstChild;this.doesNotAddBorder=f.offsetTop!==5;this.doesAddBorderForTableAndCells=e.offsetTop===5;f.style.position="fixed";f.style.top="20px";this.supportsFixedPosition=f.offsetTop===20||f.offsetTop===15;f.style.position=f.style.top="";d.style.overflow="hidden";d.style.position="relative";this.subtractsBorderForOverflowNotVisible=f.offsetTop===-5;this.doesNotIncludeMarginInBodyOffset=a.offsetTop!==j;a.removeChild(b);
+c.offset.initialize=c.noop},bodyOffset:function(a){var b=a.offsetTop,d=a.offsetLeft;c.offset.initialize();if(c.offset.doesNotIncludeMarginInBodyOffset){b+=parseFloat(c.curCSS(a,"marginTop",true))||0;d+=parseFloat(c.curCSS(a,"marginLeft",true))||0}return{top:b,left:d}},setOffset:function(a,b,d){if(/static/.test(c.curCSS(a,"position")))a.style.position="relative";var f=c(a),e=f.offset(),j=parseInt(c.curCSS(a,"top",true),10)||0,i=parseInt(c.curCSS(a,"left",true),10)||0;if(c.isFunction(b))b=b.call(a,
+d,e);d={top:b.top-e.top+j,left:b.left-e.left+i};"using"in b?b.using.call(a,d):f.css(d)}};c.fn.extend({position:function(){if(!this[0])return null;var a=this[0],b=this.offsetParent(),d=this.offset(),f=/^body|html$/i.test(b[0].nodeName)?{top:0,left:0}:b.offset();d.top-=parseFloat(c.curCSS(a,"marginTop",true))||0;d.left-=parseFloat(c.curCSS(a,"marginLeft",true))||0;f.top+=parseFloat(c.curCSS(b[0],"borderTopWidth",true))||0;f.left+=parseFloat(c.curCSS(b[0],"borderLeftWidth",true))||0;return{top:d.top-
+f.top,left:d.left-f.left}},offsetParent:function(){return this.map(function(){for(var a=this.offsetParent||s.body;a&&!/^body|html$/i.test(a.nodeName)&&c.css(a,"position")==="static";)a=a.offsetParent;return a})}});c.each(["Left","Top"],function(a,b){var d="scroll"+b;c.fn[d]=function(f){var e=this[0],j;if(!e)return null;if(f!==w)return this.each(function(){if(j=wa(this))j.scrollTo(!a?f:c(j).scrollLeft(),a?f:c(j).scrollTop());else this[d]=f});else return(j=wa(e))?"pageXOffset"in j?j[a?"pageYOffset":
+"pageXOffset"]:c.support.boxModel&&j.document.documentElement[d]||j.document.body[d]:e[d]}});c.each(["Height","Width"],function(a,b){var d=b.toLowerCase();c.fn["inner"+b]=function(){return this[0]?c.css(this[0],d,false,"padding"):null};c.fn["outer"+b]=function(f){return this[0]?c.css(this[0],d,false,f?"margin":"border"):null};c.fn[d]=function(f){var e=this[0];if(!e)return f==null?null:this;if(c.isFunction(f))return this.each(function(j){var i=c(this);i[d](f.call(this,j,i[d]()))});return"scrollTo"in
+e&&e.document?e.document.compatMode==="CSS1Compat"&&e.document.documentElement["client"+b]||e.document.body["client"+b]:e.nodeType===9?Math.max(e.documentElement["client"+b],e.body["scroll"+b],e.documentElement["scroll"+b],e.body["offset"+b],e.documentElement["offset"+b]):f===w?c.css(e,d):this.css(d,typeof f==="string"?f:f+"px")}});A.jQuery=A.$=c})(window);
diff --git a/web/js/json2.js b/web/js/json2.js
new file mode 100644
index 0000000..8696583
--- /dev/null
+++ b/web/js/json2.js
@@ -0,0 +1 @@
+if(!this.JSON){JSON={};}(function(){function f(n){return n<10?'0'+n:n;}if(typeof Date.prototype.toJSON!=='function'){Date.prototype.toJSON=function(key){return this.getUTCFullYear()+'-'+f(this.getUTCMonth()+1)+'-'+f(this.getUTCDate())+'T'+f(this.getUTCHours())+':'+f(this.getUTCMinutes())+':'+f(this.getUTCSeconds())+'Z';};String.prototype.toJSON=Number.prototype.toJSON=Boolean.prototype.toJSON=function(key){return this.valueOf();};}var cx=/[\u0000\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g,escapable=/[\\\"\x00-\x1f\x7f-\x9f\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g,gap,indent,meta={'\b':'\\b','\t':'\\t','\n':'\\n','\f':'\\f','\r':'\\r','"':'\\"','\\':'\\\\'},rep;function quote(string){escapable.lastIndex=0;return escapable.test(string)?'"'+string.replace(escapable,function(a){var c=meta[a];return typeof c==='string'?c:'\\u'+('0000'+a.charCodeAt(0).toString(16)).slice(-4);})+'"':'"'+string+'"';}function str(key,holder){var i,k,v,length,mind=gap,partial,value=holder[key];if(value&&typeof value==='object'&&typeof value.toJSON==='function'){value=value.toJSON(key);}if(typeof rep==='function'){value=rep.call(holder,key,value);}switch(typeof value){case'string':return quote(value);case'number':return isFinite(value)?String(value):'null';case'boolean':case'null':return String(value);case'object':if(!value){return'null';}gap+=indent;partial=[];if(Object.prototype.toString.apply(value)==='[object Array]'){length=value.length;for(i=0;i<length;i+=1){partial[i]=str(i,value)||'null';}v=partial.length===0?'[]':gap?'[\n'+gap+partial.join(',\n'+gap)+'\n'+mind+']':'['+partial.join(',')+']';gap=mind;return v;}if(rep&&typeof rep==='object'){length=rep.length;for(i=0;i<length;i+=1){k=rep[i];if(typeof k==='string'){v=str(k,value);if(v){partial.push(quote(k)+(gap?': ':':')+v);}}}}else{for(k in value){if(Object.hasOwnProperty.call(value,k)){v=str(k,value);if(v){partial.push(quote(k)+(gap?': ':':')+v);}}}}v=partial.length===0?'{}':gap?'{\n'+gap+partial.join(',\n'+gap)+'\n'+mind+'}':'{'+partial.join(',')+'}';gap=mind;return v;}}if(typeof JSON.stringify!=='function'){JSON.stringify=function(value,replacer,space){var i;gap='';indent='';if(typeof space==='number'){for(i=0;i<space;i+=1){indent+=' ';}}else if(typeof space==='string'){indent=space;}rep=replacer;if(replacer&&typeof replacer!=='function'&&(typeof replacer!=='object'||typeof replacer.length!=='number')){throw new Error('JSON.stringify');}return str('',{'':value});};}if(typeof JSON.parse!=='function'){JSON.parse=function(text,reviver){var j;function walk(holder,key){var k,v,value=holder[key];if(value&&typeof value==='object'){for(k in value){if(Object.hasOwnProperty.call(value,k)){v=walk(value,k);if(v!==undefined){value[k]=v;}else{delete value[k];}}}}return reviver.call(holder,key,value);}cx.lastIndex=0;if(cx.test(text)){text=text.replace(cx,function(a){return'\\u'+('0000'+a.charCodeAt(0).toString(16)).slice(-4);});}if(/^[\],:{}\s]*$/.test(text.replace(/\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g,'@').replace(/"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g,']').replace(/(?:^|:|,)(?:\s*\[)+/g,''))){j=eval('('+text+')');return typeof reviver==='function'?walk({'':j},''):j;}throw new SyntaxError('JSON.parse');};}}());
diff --git a/web/js/tagcarousel/tagcarousel.js b/web/js/tagcarousel/tagcarousel.js
new file mode 100644
index 0000000..4fa635d
--- /dev/null
+++ b/web/js/tagcarousel/tagcarousel.js
@@ -0,0 +1,275 @@
+YUI.add('tag-carousel', function(Y) {
+
+	var Lang = Y.Lang,
+		Widget = Y.Widget,
+		Node = Y.Node;
+
+	var NS = Y.namespace('mazzle');	
+	NS.TagCarousel = TagCarousel;
+	
+	/* TagCarousel class constructor */
+	function TagCarousel(config) {
+		TagCarousel.superclass.constructor.apply(this, arguments);
+	}
+
+	/* 
+	 * Required NAME static field, to identify the Widget class and 
+	 * used as an event prefix, to generate class names etc. (set to the 
+	 * class name in camel case). 
+	 */
+	TagCarousel.NAME = "tag-carousel";
+
+	/*
+	 * The attribute configuration for the TagCarousel widget. Attributes can be
+	 * defined with default values, get/set functions and validator functions
+	 * as with any other class extending Base.
+	 */
+	TagCarousel.ATTRS = {
+		tags: {
+			value: []
+		},
+		active: {
+			value: true
+		},
+		topIndent: {
+			value: true
+		},
+		edit: {
+			value: false
+		},
+		remove: {
+			value: false
+		},
+		suggest: {
+			value: null
+		}
+	};
+
+	/* Static constants used to define the markup templates used to create TagCarousel DOM elements */
+	TagCarousel.LIST_CLASS = 'tag-list';
+	TagCarousel.LIST_TEMPLATE = '<ul class="'+TagCarousel.LIST_CLASS+'"></ul>';
+
+	/* TagCarousel extends the base Widget class */
+	Y.extend(TagCarousel, Widget, {
+
+		initializer: function() {
+		},
+
+		destructor : function() {
+		},
+
+		renderUI : function() {
+			var content = this.get("contentBox"),
+				height = this.get("height");
+				
+			content.setStyle("position", "relative");
+			if(this.get("topIndent")) {
+				content.setStyle("top", height/2+"px");
+			}
+			
+			this.listNode = content.appendChild(Node.create(TagCarousel.LIST_TEMPLATE));
+		},
+
+		bindUI : function() {
+			this.after("tagsChange", this.syncUI);
+			Y.delegate("click", this._itemSelect, this.listNode, "li .label", this);
+			Y.delegate("click", this._itemEdit, this.listNode, "li .edit", this);
+			Y.delegate("click", this._itemRemove, this.listNode, "li .remove", this);
+			
+			this._scrollAnim = new Y.Anim({
+			    node: this.get("boundingBox"),
+			    duration: 1,
+			    easing: Y.Easing.easeOut
+			});
+		},
+
+		syncUI : function() {
+			this._renderItems();
+		},
+
+		_renderItems : function() {
+			var tags = this.get("tags"),
+				timeIndex = {};
+			
+			this.listNode.setContent("");
+			
+			// format the items and store in the time index	
+			for(var i=0; i < tags.length; i++) {
+				this.listNode.append('<li>'+this.formatItem(tags[i])+'</li>');	
+				var time = Math.round(tags[i].startTime/1000); //TBD make this hookable
+				timeIndex[time] = i;
+			}
+			this._timeIndex = timeIndex;
+		},
+	
+		formatItem : function(item) { 
+			var tag = item.tag,
+				html;
+			console.log(tag,Lang.isArray(tag));	
+			if(Lang.isArray(tag)) {
+				html = '<div class="label">';
+				for (var i=0; i < tag.length; i++) {
+					html += tag[i].value+", ";
+				}
+				html += '</div>';
+			} else {
+				html = '<div class="label">'+tag.value+'</div>';				
+			}
+
+			if(item.count) {
+				html += '<div class="count">'+item.count+'</div>';
+			}
+			if(this.get("edit")) {
+				html += '<div class="edit"><a href="javascript:{}">e</a></div>';
+			}
+			if(this.get("remove")) {
+				html += '<div class="remove"><a href="javascript:{}">x</a></div>';
+			}
+			if(item.uri) {
+				return '<a href="javascript:{}">'+html+'</a>';
+			} else {
+				return html;
+			}
+			
+		},
+		
+		_itemSelect : function(e) {
+			// item click
+			var node = e.currentTarget.get("parentNode"),
+				index = e.container.all("li").indexOf(node),
+				item = this.get("tags")[index],
+				arg = {li:node, index:index, tag:item};
+			
+			if(!node.one('input')) {	
+				Y.log('clicked tag '+item.tag.value+' at index '+index);	
+				this._highlight(index);
+	        	this.fire("itemSelect", arg);
+			}
+		},
+		
+		_itemEdit : function(e) {
+			var node = e.currentTarget.get("parentNode"),
+				index = e.container.all("li").indexOf(node),
+				item = this.get("tags")[index],
+				labelNode = node.one('.label'),
+				label = labelNode.get("innerHTML"),
+				arg = {
+					type:'edit',
+					index:index,
+					annotation:item
+				};
+	
+			if(this.get("suggest")) {
+				var suggest = this.get("suggest");
+				if(suggest.hasClass("hidden")) {
+					suggest.align.to(labelNode, "tl","tl");
+					suggest.one('input').set("value", label);
+					suggest.removeClass("hidden");
+				} else {
+					suggest.addClass("hidden");
+					var newvalue = suggest.one('input').get("value");
+					labelNode.setContent(newvalue);
+				}
+			} else {
+				var inputNode = node.one('input');
+				if(inputNode) {	
+					var newvalue = inputNode.get("value");
+					arg.newvalue = newvalue;
+					this.fire("itemUpdate", arg);
+					labelNode.setContent(newvalue);
+				} else {
+					Y.log('edit tag '+item.tag.value+' at index '+index);
+					labelNode.setContent("<input value='"+label+"'>");
+					this.fire("itemStartEdit", arg);
+				}
+			}
+		},
+		
+		_itemRemove : function(e) {
+			var node = e.currentTarget.get("parentNode"),
+				index = e.container.all("li").indexOf(node),
+				item = this.get("tags")[index],
+				arg = {
+					type:'remove',
+					index:index,
+					annotation:item
+				};
+		
+			Y.log('remove tag '+item.tag.value+' at index '+index);
+			node.addClass("hidden");
+        	this.fire("itemUpdate", arg);
+		},
+
+		focusTag : function(tag) {			
+			this.focusIndex(this.tagIndex(tag));
+		},
+		
+		focusNode : function(node) {
+			var index = this.listNode.all("li").indexOf(node);
+			this.focusIndex(index);
+		},
+		
+		focusTime : function(time) {
+			var timeIndex = this._timeIndex,
+				index = timeIndex[time];
+
+			if(index>=0) {
+				Y.log('tagged '+this.get("tags")[index].tag);
+				this.focusIndex(index);
+			}
+		},
+		
+		focusIndex : function(index) {
+			if(this.get("active")) {
+				this._scrollTo(index);
+				this._highlight(index);
+			}
+		},
+		
+		tagIndex : function(tag) {
+			var tags = this.get("tags");
+			var i = 0;
+			for (i; i < tags.length; i++) {
+				if(tags[i].tag === tag) {
+					return i;
+				}
+			}
+		},
+		
+		_scrollTo : function(index) {
+			var node = this.get("boundingBox"),
+				items = this.listNode.all("li"),
+				anim = this._scrollAnim,
+				scrollTo = Math.abs(this.listNode.getY() - items.item(index).getY());
+			
+			Y.log('scroll from '+node.get('scrollTop')+' to '+scrollTo);
+			anim.set('to', { scroll: [node.get('scrollTop'), scrollTo] });
+        	anim.run();
+		},
+		
+		_highlight : function(index) {
+			var items = this.listNode.all("li");
+			// removeFocus from other items
+			items.removeClass('focus');
+			// add focus class to current item
+			items.item(index).addClass('focus');
+		},
+		
+		undo : function(e) {
+			var history = e.history,
+				items = this.listNode.all("li");
+			for (var i=0; i < history.length; i++) {
+				var action = history[i],
+					node = items.item(action.index);
+					 
+				if(action.type == "remove") {
+					node.removeClass("hidden");
+				} else if(action.type == "edit") {
+					node.one('.label').setContent(action.tag);
+				}
+			}
+		}
+				
+	});
+	  
+}, 'gallery-2010.03.02-18' ,{requires:['node','anim','widget']});
\ No newline at end of file
diff --git a/web/js/timeline/timeline.js b/web/js/timeline/timeline.js
new file mode 100644
index 0000000..cff7dcc
--- /dev/null
+++ b/web/js/timeline/timeline.js
@@ -0,0 +1,202 @@
+YUI.add('timeline', function(Y) {
+
+	var Lang = Y.Lang,
+		Widget = Y.Widget,
+		Node = Y.Node;
+
+	var NS = Y.namespace('mazzle');	
+	NS.Timeline = Timeline;
+	
+	function Timeline(config) {
+		Timeline.superclass.constructor.apply(this, arguments);
+	}
+
+	Timeline.NAME = "timeline";
+
+	Timeline.ATTRS = {
+		items: {
+			value: [],
+			validator: function(val) {
+            	return Y.Lang.isArray(val);
+			}
+        },
+		start: {
+			value: 0,
+			validator: function(val) {
+            	return Y.Lang.isNumber(val);
+        	}
+		},
+		duration: {
+			value: null,
+			validator: function(val) {
+            	return Y.Lang.isNumber(val);
+        	}
+		},
+		itemWidth: {
+			value: 1,
+			validator: function(val) {
+            	return Y.Lang.isNumber(val);
+        	}
+		}
+	};
+
+	/* Static constants used to define the markup templates used to create Timeline DOM elements */
+	Timeline.LIST_CLASS = 'timeline-list';
+	Timeline.LIST_TEMPLATE = '<ul class="'+Timeline.LIST_CLASS+'"></ul>';
+	
+	/* Timeline extends the base Widget class */
+	Y.extend(Timeline, Widget, {
+
+		initializer: function() {
+			this._timePoints = [];
+			this._timePointDuration = null;
+			this._listNode = null;
+		},
+
+		destructor : function() {
+		},
+
+		renderUI : function() {
+			this._listNode = this.get("contentBox")
+				.appendChild(Node.create(Timeline.LIST_TEMPLATE));
+		},
+
+		bindUI : function() {
+			this.after("durationChange", this.syncUI);
+			this.after("widthChange", this.syncUI);
+			this.after("itemWidthChange", this.syncUI);
+			this.after("itemsChange", this.syncUI);
+ 			this._bindItemEvents();
+		},
+
+		syncUI : function() {
+			this._updateTimePointDuration();
+			this._renderItems();
+		},
+
+		_updateTimePointDuration : function() {
+			var width = this.get("contentBox").get("offsetWidth"),
+				itemWidth = this.get("itemWidth"),
+				duration = this.get("duration");
+
+			if(duration) {
+				this._timePointDuration = (width/itemWidth)/duration;
+			}
+		},
+
+		_renderItems : function() {
+			var items = this.get("items"),
+				itemWidth = this.get("itemWidth"),
+				timePoints = {},
+				timePointDuration = this._timePointDuration;	
+			
+			this._listNode.setContent("");
+			
+			if(items&&timePointDuration) {
+				for(var i=0; i < items.length; i++) {
+					var item = items[i],
+						tag = item.tag,
+						time = item.time;
+					
+					// The timepoint to which an item is added 
+					// depends on the duration of individual time points.
+					// Depending on the scale multiple items can be shared on a time point.
+					var position = Math.round(timePointDuration*time);
+					if(timePoints[position]) {
+						var timePoint = timePoints[position];
+						item.node = timePoint.node;
+						timePoint.items.push(i);
+					} else {
+						item.node = this._listNode
+							.appendChild(Node.create('<li></li>'))
+							.setStyle('marginLeft', position)
+							.setStyle('width', itemWidth);
+						timePoints[position] = {
+							node: item.node,
+							items: [i]
+						};
+					}
+				}
+			}
+			this._timePoints = timePoints;
+		},
+	
+		_bindItemEvents : function() {	
+			// item mouse over
+			Y.delegate("mouseover", function(e) {
+				var index = e.container.all("li").indexOf(e.currentTarget),
+					items = this._timePoints[index];
+				this.fire("itemMouseOver", {
+					items:items, target:e.currentTarget, index:index});			
+		    }, this._listNode, "li", this);
+		
+			// item click
+			Y.delegate("click", function(e) {
+				var index = e.container.all("li").indexOf(e.currentTarget),
+					items = this._timePoints[index];
+				this.fire("itemSelect", {
+					items:items, target:e.currentTarget, index:index});			
+		    }, this._listNode, "li", this);
+		},
+
+		/* updateToInterval
+		 *
+		 * groups is an object with as a key the index
+		 * of the item that should be updated to an interval
+		 */
+		updateToInterval : function(groups, interval) {
+			var items = this.get("items"),
+				itemWidth = this.get("itemWidth");
+				
+			// First we reset everything	
+			this._listNode.all("li").each(function(node, index) {
+				node.setStyle("width", itemWidth)
+				.removeClass("hidden")
+				.removeClass("interval");
+			});
+
+			if(groups&&interval) {
+				itemWidth = itemWidth*(this._timePointDuration*interval);
+				for (var i=0; i < items.length; i++) {
+					var node = items[i].node;
+					if(groups[i]) {
+						node.setStyle("width", itemWidth)
+						.addClass("interval")
+						.removeClass("hidden");
+					} else if(!node.hasClass("interval")){
+						node.addClass("hidden");
+					}
+				}
+			}
+		},
+		
+		highlightTag : function(tag) {
+			var items = this.get("items");
+			for (var i=0; i < items.length; i++) {
+				var item = items[i];
+				if(item.tag == tag) {
+					this._highlight(item.node);
+				}
+			};
+		},
+				
+		highlightIndex : function(index) {
+			var item = this.get("items")[index];
+			if(item) {
+				this._highlight(item.node);
+			}	
+		},
+		
+		_highlight : function(node) {
+			// removeFocus from all items
+			this._listNode.all("li").removeClass('highlight');
+			// and highlight the node of the item at index
+			if(node) {
+				node.addClass('highlight');
+			}
+		}
+
+				
+	});
+	  
+}, 'gallery-2010.03.02-18', {requires:['node','anim','widget']});
\ No newline at end of file
diff --git a/web/js/videoframes/videoframes.js b/web/js/videoframes/videoframes.js
new file mode 100644
index 0000000..c5be26f
--- /dev/null
+++ b/web/js/videoframes/videoframes.js
@@ -0,0 +1,382 @@
+YUI.add('video-frames', function(Y) {
+
+	var Lang = Y.Lang,
+		Widget = Y.Widget,
+		Node = Y.Node;
+
+	var NS = Y.namespace('mazzle');	
+	NS.VideoFrames = VideoFrames;
+	
+	/* VideoFrames class constructor */
+	function VideoFrames(config) {
+		VideoFrames.superclass.constructor.apply(this, arguments);
+	}
+
+	/* 
+	 * Required NAME static field, to identify the Widget class and 
+	 * used as an event prefix, to generate class names etc. (set to the 
+	 * class name in camel case). 
+	 */
+	VideoFrames.NAME = "video-frames";
+
+	/*
+	 * The attribute configuration for the VideoFrames widget. Attributes can be
+	 * defined with default values, get/set functions and validator functions
+	 * as with any other class extending Base.
+	 */
+	VideoFrames.ATTRS = {
+		frameServer: {
+			value: null
+		},
+		dataServer: {
+			value: null
+		},
+		playerPath: {
+			value: '/js/videoplayer/'
+		},
+		maxFrames: {
+			value: 250
+		},
+		frames: {
+			value: []
+		},
+		video: {
+			value: null
+		},
+		duration: {
+			value: null
+		},
+		confirm: {
+			value: false
+		},
+		concept: {
+			value: null
+		},
+		interval: {
+			value: 0
+		},
+		users: {
+			value: 1
+		}
+	};
+
+	/* Static constants used to define the markup templates used to create VideoFrames DOM elements */
+	VideoFrames.LIST_CLASS = 'frames-list';
+	VideoFrames.LIST_TEMPLATE = '<ul class="'+VideoFrames.LIST_CLASS+'"></ul>';
+
+	/* VideoFrames extends the base Widget class */
+	Y.extend(VideoFrames, Widget, {
+
+		initializer: function() {
+			this.listNode = null;
+			this.player = null;
+			this.videoBufferReady = false;
+			this.timeline = null;
+		},
+
+		destructor : function() {
+		},
+
+		renderUI : function() {
+			var content = this.get("contentBox");
+			this._renderPlayer(content);
+			this._renderTimeline(content);
+			this._renderControls(content);
+			this._renderFrameList(content);
+			this.player.on("bufferReady", function() {
+				var duration = (this.get("duration") || this.player.getDuration())*1000
+				this.videoBufferReady = true;
+				Y.one('.yui3-videoplayer').setStyle("left", "-10000px");
+				this.timeline.set("duration", duration);
+			}, this);
+		},
+
+		bindUI : function() {
+			this.after("framesChange", this.syncUI);
+			
+			// frame click
+			Y.delegate("click", this._onFrameSelect, this.listNode, "li .image", this);
+			Y.delegate("mouseover", this._onFrameHover, this.listNode, "li", this);
+			Y.delegate("click", this._onConfirmSelect, this.listNode, "li div.frame-confirm", this);
+		},
+
+		syncUI : function() {
+			var frames = this.get("frames"),
+				interval = this.get("interval")*1000,
+				userLimit = this.get("users");
+			
+			// hide the video
+			if(this.videoBufferReady) {
+				this.player.pause();
+				Y.one('.yui3-videoplayer').setStyle("left", "-10000px");
+			}
+			// First we render all frames afterwards we hide frames according 
+			// to the settings of the interval and user limit.
+			this._renderFrames(frames);
+			this.timeline.set("items", frames);
+			if(frames.length>0&&interval>0) {
+				var groups = this._groupFrames(frames, interval, userLimit);
+				this.timeline.updateToInterval(groups, interval);
+			}		
+		},
+		
+		_renderPlayer : function(node) {
+			this.player = new Y.mazzle.VideoPlayer({
+				filepath:this.get("playerPath"),
+				src:this.get("video"),
+				width:175,
+				height:98,
+				autoplay:false,
+				controls:false
+				//visible:false
+			})
+			.render(node);
+			Y.one('.yui3-videoplayer').plug(Y.Plugin.Align);
+		},
+		
+		_renderTimeline : function(node) {
+			this.timeline = new Y.mazzle.Timeline({
+				height:20
+			})
+			.render(node);
+		},
+		
+		_renderControls : function(node) {
+			var controls = node.appendChild(Node.create('<div class="controls"></div>'));
+			// add controls for scene selection
+			var sceneNode = controls.appendChild(Node.create('<div class="sceneSelect"></div>'));
+			this._renderSlider(sceneNode, 'group frames by interval', 'interval', {
+				min:0,
+				max:60,
+				value:this.get("interval")
+			});
+			
+			var userNode = controls.appendChild(Node.create('<div class="userSelect"></div>'));
+			this._renderSlider(userNode, 'minimal users', 'users', {
+				min:1,
+				max:10,
+				value:this.get("users")
+			});
+		},
+		
+		_renderSlider : function(node, label, name, conf) {
+			var content = node.appendChild(Node.create('<div class="control"></div>'));
+			content.append('<label for='+name+'_value>'+label+'</label>');
+			var sliderNode = content.appendChild(Node.create('<span></span>'));
+			var input = content.appendChild(Node.create('<input id="'+name+'_value">'));
+			input.set("value", conf.value);
+			var slider = new Y.Slider(conf);
+			input.setData( { slider: slider } );
+			slider.after("valueChange", function(e) { 
+				input.set("value", e.newVal);
+			});
+			input.on( "keyup", function(e) { 
+				var data   = input.getData(),
+		        slider = data.slider,
+		        value  = parseInt( input.get( "value" ), 10 );
+				if ( data.wait ) {
+		        	data.wait.cancel();
+		    	}
+		    	// Update the Slider on a delay to allow time for typing
+				data.wait = Y.later( 200, this, function () {
+					data.wait = null;
+					if(Y.Lang.isNumber(value)) {
+						slider.set( "value", value );
+						this.set(name, value);
+						this._filterFrames();
+					}
+		    	});
+			}, this);
+			slider.render(sliderNode);
+			slider.on("slideEnd", function(e) {
+				this.set(name, slider.get("value"));
+				this._filterFrames();
+			}, this);
+		},
+		
+		_renderFrameList : function(node) {
+			list = node.appendChild(Node.create(VideoFrames.LIST_TEMPLATE))
+			// create list elements
+			var maxFrames = this.get("maxFrames");
+			for(var i=0; i < maxFrames; i++) {
+				list.append('<li class="frame hidden"></li>');
+			}
+			this.listNode = list;
+		},
+		
+		_renderFrames : function(frames) {
+			// update all list elements
+			this.listNode.all("li").each(function(node, i) {
+				if(frames[i]) {
+					node.setContent(this.formatFrame(frames[i]));
+					node.prepend('<div class="users hidden"></div>');
+					node.removeClass("hidden");
+				} else {
+					node.setContent("");
+					node.addClass("hidden");
+				}
+			}, this);
+		},
+	
+		formatFrame : function(frame) {
+			var frameServer = this.get("frameServer"),
+				video = frame.video||this.get("video"),
+				time = (frame.time/1000),
+				tag = frame.tag;
+
+			var html = '<div class="image">'
+				+'<img src="'+frameServer+'?url='+video+'&time='+time+'">'
+				+'</div>';
+			if(this.get("confirm")) {
+				//html += '<div class="frame-confirm">click to confirm</div>';
+				html += '<div class="frame-confirm">'+tag+'?</div>';
+			} else {
+				html += '<div class="tag">'+tag+'</div>';
+			}
+
+			return html;
+		},
+		
+		_onFrameSelect : function(e) {
+			var parent = e.currentTarget.get("parentNode"),
+				index = e.container.all("li").indexOf(parent),
+	            frame = this.get("frames")[index],
+				arg = {li:e.currentTarget, index:index, frame:frame};
+			
+			Y.log('clicked frame '+frame+' at index '+index);	
+			Y.one('.yui3-videoplayer').align.to(e.currentTarget, "tl","tl");
+			this.player.setTime(frame.time/1000, true);	
+				
+       		this.fire("frameSelect", arg);
+		},
+		
+		_onFrameHover : function(e) {
+			var index = e.container.all("li").indexOf(e.currentTarget);
+			this.timeline.highlightIndex(index);
+		},
+		
+		_onConfirmSelect : function(e) {
+			var target = e.currentTarget,
+				parent = e.currentTarget.get("parentNode"),
+				index = this.listNode.all("li").indexOf(parent),
+				frame = this.get("frames")[index];
+
+			Y.log('frame confirm selected at index '+index);
+			
+			var type = "depicted",
+				label = "depicts";
+			if(frame.confirm) {
+				if(frame.confirm=="depicted") {
+					type="associated"
+					label="associated with"
+				} else if(frame.confirm=="associated") {
+					type = "rejected";
+					label = "not";
+				}
+				target.replaceClass(frame.confirm, type);
+			} else {
+				target.addClass(type);
+			};
+			frame.confirm = type;
+			var concept = this.get("concept");
+			var tag = (concept&&concept.name) ? concept.name : frame.tag;
+			
+			e.target.setContent(label+" "+tag);
+			this.fire("confirmSelect", {type:type, index:index, frame:frame, concept:concept});
+		},
+		
+		fetchData: function(conf) {
+			// default request
+			var data = {
+				video:this.get("video"),
+				interval:this.get("interval"),
+				users:this.get("users")
+			}
+			// update with conf parameters
+			if(conf) {
+				for(var key in conf) {
+					if(key) {
+						data[key] = conf[key];
+					}
+				}
+			}
+			Y.io(this.get("dataServer"), {
+				data: data,
+				on: { success: this.dataResponse },
+				context:this
+			});
+		},
+		
+		dataResponse: function(id,o) {
+ 			this.set("frames", Y.JSON.parse(o.responseText).fragments);
+		},
+		
+		_filterFrames:  function() {
+			var frames = this.get("frames"),
+				interval = this.get("interval")*1000,
+				userLimit = this.get("users"),
+				groups = {};
+			
+			if(interval>0) {	
+				groups = this._groupFrames(frames, interval, userLimit);
+			} else {
+				this.listNode.all("li").each(function(node, i) {
+					if(frames[i]) {
+						node.removeClass("hidden");
+						node.one(".users").addClass("hidden");	
+					}
+				})
+			}
+			this.timeline.updateToInterval(groups, interval);
+		},
+		
+		/* _groupFrames
+		 *
+		 * group frames that are within the same interval
+		 * the groups are stored as an array of arrays with indices
+		*/
+		_groupFrames: function(frames, interval, userLimit) {
+			// groups of frames are 
+			
+			var groups = {}, group = 0, end = -1;
+			for (var i=0; i < frames.length; i++) {
+				var frame = frames[i];
+				if(frame.time < end) {
+					groups[group].push(frame);
+				} else {
+					group = i;
+					end = frame.time + interval;
+					groups[group] = [frame];
+				}
+			}
+			
+			// remove groups bellow user limit
+			for(var key in groups) {
+				var userCount = groups[key].length;
+				if(userCount<userLimit) {
+					delete groups[key];
+				}
+			}
+			
+			// The grouped frames are visualized by showing only the first frame
+			// of the group and hiding the next ones.
+			// In addition we show the number of unique users in the first frame.
+			// TBD use unique users instead of the number of tag entries, 
+			// which may contain the same user multiple times)
+			this.listNode.all("li").each(function(node, i) {
+				if(groups[i]) {
+					node.removeClass("hidden");
+					node.one(".users")
+						.setContent("<span>"+groups[i].length+"</span>")
+						.removeClass("hidden");
+				} else {
+					node.addClass("hidden");
+				}
+			})
+			
+			return groups;
+		}
+		
+	});
+	  
+}, 'gallery-2010.03.02-18' ,{requires:['node','widget','io-base','json-parse']});
\ No newline at end of file
diff --git a/web/js/videoplayer/jquery-videoplayer.js b/web/js/videoplayer/jquery-videoplayer.js
new file mode 100644
index 0000000..67e8f57
--- /dev/null
+++ b/web/js/videoplayer/jquery-videoplayer.js
@@ -0,0 +1,264 @@
+var later = function(when, o, fn, data) {
+	when = when || 0; 
+	o = o || {};
+	var f = setTimeout(function() {fn.apply(o, data)}, when);
+	return {
+		id: f,
+		cancel: function() {
+			clearTimeout(r);
+		}
+	};
+};
+
+function flashPlayerTimeListener(obj) { 
+	document.getElementById(obj.id).position = obj.position;
+}
+function flashPlayerStateListener(obj) {
+	document.getElementById(obj.id).state = obj.newstate;
+}
+	
+	
+(function($) {
+
+	$.widget("ui.videoplayer", {
+		state: 'init',
+		options: {
+			src: "",
+			height: 200,
+			width: 300,
+			duration: null,
+			autostart: false,
+			start: 0,
+			playerType: null,
+			extensions: {
+				flv:"flash",
+				asf:"silverlight",
+				wmv:"silverlight"
+			},
+			filepath: '/js/videoplayer/'
+		},
+	
+		_create: function() {
+			var o = this.options;
+			if(!o.playerType) {
+				this._setPlayerType();
+			}
+			this.element
+				.addClass("ui-videoplayer ui-widget ui-corner-all");
+			
+			this._renderContent();
+		},
+
+		_setPlayerType : function() {
+			// guess required playerType based on extension
+			var o = this.options;
+			if(o.src) {
+				var pt,
+					src = o.src,
+					extensions = o.extensions,
+					videoType = src.substr(src.length-3, 3);
+
+				if(extensions[videoType]) {
+					pt = extensions[videoType];
+				} else {
+					pt = "html";
+				}
+			}
+			o.playerType = pt;
+			return pt;
+		},
+	
+		_renderContent : function() {
+			switch(this.options.playerType) {
+				case "flash":
+					this._renderFlashPlayer()
+					break;	
+				case "silverlight":
+					this._renderSilverlightPlayer()
+					break;
+				default:
+					this._renderHTMLPlayer()
+			}
+		},	
+		_renderHTMLPlayer : function() {
+			var o = this.options;
+			this.player = $('<video></video>')
+				.attr({
+					src: o.src,
+					height: o.height,
+					width: o.width
+				})
+			.appendTo(this.element);
+		},
+	
+		_renderFlashPlayer : function() {
+			//$.log('create flash player');
+			var o = this.options,
+				id = this.element[0].id+'1',
+				playerId = id+"_player",
+				swf = o.filepath+'player.swf',
+				width = o.width,
+				height = o.height;
+				
+			var flashvars = {
+				file: o.src,
+				'autostart': 'true'				
+			};
+			var attributes = {
+				'id': playerId,
+				'name': playerId
+			};
+			var params = {
+				'allowscriptaccess': 'always'
+			};
+		
+			this.element.append('<div id="'+id+'"></div>');
+			swfobject.embedSWF(swf,id,width,height,'9','false',flashvars,params,attributes);
+			this._flashPlayerInit(playerId);
+		},
+		
+		_flashPlayerInit : function(playerId) {
+			try {
+				var p = document.getElementById(playerId),
+					o = this.options;
+
+				// as we can't refer directly to the object we first store the data in the player object
+				// our own listeners than reads out this data.
+				// Do you have a more elegant solution?
+				p.addModelListener("Time", "flashPlayerTimeListener");
+				p.addModelListener("State", "flashPlayerStateListener");
+				this.player = p;
+				this._flashTimeCheck();
+				this._flashStateCheck();
+				
+				// we made the player autostart by default to load the file
+				// now we first seek to the start time and pause if we didn't
+				// want it to autoplay
+				if(o.start) {
+					p.sendEvent('SEEK', o.start);
+				}
+				if(!o.autostart) { 
+					p.sendEvent('PLAY');
+				}
+			} catch(e) {
+				later(100, this, this._flashPlayerInit, [playerId]);
+			}
+		},
+		getDuration : function() {
+			var p = this.player;
+			
+			switch(this.options.playerType) {
+				case "flash":
+					return p.getConfig().duration
+					break;	
+				case "silverlight":		
+					return p.configuration.duration
+					break;
+				default:
+					return p.duration // is this correct?
+			} 
+		},	
+		getTime : function() {
+			var p = this.player;
+			if(p.currentTime) {
+				return p.currentTime;
+			} else {
+				return 0;
+			}
+		},
+		setTime : function(time, play) {
+			//$.log('seek to '+time);
+			var p = this.player;
+				//oldtime = this.getTime();
+			switch(this.options.playerType) {
+				case "flash":
+					p.sendEvent('SEEK', time);
+					if(!play) { later(100, this, this.pause); }
+					break;	
+				case "silverlight":
+					p.sendEvent('SCRUB', time);
+					if(play) { this.play() };
+					break;
+				default:
+					p.currentTime(time);
+					if(play) { this.play() };
+			}
+			//this.fire("timeSet", {oldtime:oldtime, newtime:time});
+		},
+		play : function() {
+			var p = this.player,
+				state = this.state;
+
+			if(!(state=='BUFFERING'||state=='PLAYING')) {
+				if(this.options.playerType=="html") {
+					p.play();
+					this._changeState("PLAYING");
+				} else {
+					p.sendEvent('PLAY');
+				}
+			}
+		},
+		pause : function() {
+			var p = this.player,
+				state = this.state;
+
+			if(state=='PLAYING'||state=='BUFFERING') {
+				if(this.options.playerType=="html") {
+					p.pause();
+					this._changeState("PAUSED");
+				} else {
+					p.sendEvent('PLAY');
+				}
+			}
+		},
+		stop : function() {
+			var p = this.player;
+			
+			if(this.options.playerType=="html") {
+				p.stop();
+				this._changeState("STOPPED");
+			} else {
+				p.sendEvent('STOP');
+			}
+		},
+		
+		_flashStateCheck : function() {
+			this._changeState(this.player.state);
+			later(100, this, this._flashStateCheck);
+		},		
+		_changeState : function(newState) {
+			if(newState) {
+				newState = newState.toUpperCase();
+				var oldState = this.state;
+				if(oldState!==newState) {
+					this.state = newState;
+					//this.fire("stateChanged", {oldstate:oldState, newstate:newState});
+				}
+			}
+		},
+		
+		_flashTimeCheck : function() {
+			this._changeCurrentTime(this.player.position);
+			later(100, this, this._flashTimeCheck);
+		},
+		_changeCurrentTime : function(time) {
+			if(time) {
+				var player = this.player;
+				
+				if(player.currentTime!==time) {
+					player.currentTime = time;
+					//this.fire("timeChange", {time:time});
+				}
+			}
+		},
+					
+		destroy : function() {
+		}
+
+	});
+
+	$.extend($.ui.videoplayer, {});
+
+})(jQuery);
+
+	
diff --git a/web/js/videoplayer/player.swf b/web/js/videoplayer/player.swf
new file mode 100644
index 0000000..2922419
Binary files /dev/null and b/web/js/videoplayer/player.swf differ
diff --git a/web/js/videoplayer/silverlight.js b/web/js/videoplayer/silverlight.js
new file mode 100644
index 0000000..dd5309a
--- /dev/null
+++ b/web/js/videoplayer/silverlight.js
@@ -0,0 +1,576 @@
+///////////////////////////////////////////////////////////////////////////////
+//
+//  Silverlight.js   			version 2.0.30523.6
+//
+//  This file is provided by Microsoft as a helper file for websites that
+//  incorporate Silverlight Objects. This file is provided under the Microsoft
+//  Public License available at 
+//  http://code.msdn.microsoft.com/silverlightjs/Project/License.aspx.  
+//  You may not use or distribute this file or the code in this file except as 
+//  expressly permitted under that license.
+// 
+//  Copyright (c) Microsoft Corporation. All rights reserved.
+//
+///////////////////////////////////////////////////////////////////////////////
+
+if (!window.Silverlight)
+{
+    window.Silverlight = { };
+}
+
+//////////////////////////////////////////////////////////////////
+//
+// _silverlightCount:
+//
+// Counter of globalized event handlers
+//
+//////////////////////////////////////////////////////////////////
+Silverlight._silverlightCount = 0;
+
+//////////////////////////////////////////////////////////////////
+//
+// fwlinkRoot:
+//
+// Prefix for fwlink URL's
+//
+//////////////////////////////////////////////////////////////////
+Silverlight.fwlinkRoot='http://go2.microsoft.com/fwlink/?LinkID=';
+
+//////////////////////////////////////////////////////////////////
+//  
+// onGetSilverlight:
+//
+// Called by Silverlight.GetSilverlight to notify the page that a user
+// has requested the Silverlight installer
+//
+//////////////////////////////////////////////////////////////////
+Silverlight.onGetSilverlight = null;
+
+//////////////////////////////////////////////////////////////////
+//
+// onSilverlightInstalled:
+//
+// Called by Silverlight.WaitForInstallCompletion when the page detects
+// that Silverlight has been installed. The event handler is not called
+// in upgrade scenarios.
+//
+//////////////////////////////////////////////////////////////////
+Silverlight.onSilverlightInstalled = function () {window.location.reload(false);};
+
+//////////////////////////////////////////////////////////////////
+//
+// isInstalled:
+//
+// Checks to see if the correct version is installed
+//
+//////////////////////////////////////////////////////////////////
+Silverlight.isInstalled = function(version)
+{
+    var isVersionSupported=false;
+    var container = null;
+    
+    try 
+    {
+        var control = null;
+        
+        try
+        {
+            control = new ActiveXObject('AgControl.AgControl');
+            if ( version == null )
+            {
+                isVersionSupported = true;
+            }
+            else if ( control.IsVersionSupported(version) )
+            {
+                isVersionSupported = true;
+            }
+            control = null;
+        }
+        catch (e)
+        {
+            var plugin = navigator.plugins["Silverlight Plug-In"] ;
+            if ( plugin )
+            {
+                if ( version === null )
+                {
+                    isVersionSupported = true;
+                }
+                else
+                {
+                    var actualVer = plugin.description;
+                    if ( actualVer === "1.0.30226.2")
+                        actualVer = "2.0.30226.2";
+                    var actualVerArray =actualVer.split(".");
+                    while ( actualVerArray.length > 3)
+                    {
+                        actualVerArray.pop();
+                    }
+                    while ( actualVerArray.length < 4)
+                    {
+                        actualVerArray.push(0);
+                    }
+                    var reqVerArray = version.split(".");
+                    while ( reqVerArray.length > 4)
+                    {
+                        reqVerArray.pop();
+                    }
+                    
+                    var requiredVersionPart ;
+                    var actualVersionPart
+                    var index = 0;
+                    
+                    
+                    do
+                    {
+                        requiredVersionPart = parseInt(reqVerArray[index]);
+                        actualVersionPart = parseInt(actualVerArray[index]);
+                        index++;
+                    }
+                    while (index < reqVerArray.length && requiredVersionPart === actualVersionPart);
+                    
+                    if ( requiredVersionPart <= actualVersionPart && !isNaN(requiredVersionPart) )
+                    {
+                        isVersionSupported = true;
+                    }
+                }
+            }
+        }
+    }
+    catch (e) 
+    {
+        isVersionSupported = false;
+    }
+    if (container) 
+    {
+        document.body.removeChild(container);
+    }
+    
+    return isVersionSupported;
+}
+//////////////////////////////////////////////////////////////////
+//
+// WaitForInstallCompletion:
+//
+// Occasionally checks for Silverlight installation status. If it
+// detects that Silverlight has been installed then it calls
+// Silverlight.onSilverlightInstalled();. This is only supported
+// if Silverlight was not previously installed on this computer.
+//
+//////////////////////////////////////////////////////////////////
+Silverlight.WaitForInstallCompletion = function()
+{
+    if ( ! Silverlight.isBrowserRestartRequired && Silverlight.onSilverlightInstalled )
+    {
+        try
+        {
+            navigator.plugins.refresh();
+        }
+        catch(e)
+        {
+        }
+        if ( Silverlight.isInstalled(null) )
+        {
+            Silverlight.onSilverlightInstalled();
+        }
+        else
+        {
+              setTimeout(Silverlight.WaitForInstallCompletion, 3000);
+        }    
+    }
+}
+//////////////////////////////////////////////////////////////////
+//
+// __startup:
+//
+// Performs startup tasks
+//////////////////////////////////////////////////////////////////
+Silverlight.__startup = function()
+{
+    Silverlight.isBrowserRestartRequired = Silverlight.isInstalled(null);
+    if ( !Silverlight.isBrowserRestartRequired)
+    {
+        Silverlight.WaitForInstallCompletion();
+    }
+    if (window.removeEventListener) { 
+       window.removeEventListener('load', Silverlight.__startup , false);
+    }
+    else { 
+        window.detachEvent('onload', Silverlight.__startup );
+    }
+}
+
+if (window.addEventListener) 
+{
+    window.addEventListener('load', Silverlight.__startup , false);
+}
+else 
+{
+    window.attachEvent('onload', Silverlight.__startup );
+}
+
+///////////////////////////////////////////////////////////////////////////////
+// createObject:
+//
+// Inserts a Silverlight <object> tag or installation experience into the HTML
+// DOM based on the current installed state of Silverlight. 
+//
+/////////////////////////////////////////////////////////////////////////////////
+
+Silverlight.createObject = function(source, parentElement, id, properties, events, initParams, userContext)
+{
+    var slPluginHelper = new Object();
+    var slProperties = properties;
+    var slEvents = events;
+    
+    slPluginHelper.version = slProperties.version;
+    slProperties.source = source;    
+    slPluginHelper.alt = slProperties.alt;
+    
+    //rename properties to their tag property names. For bacwards compatibility
+    //with Silverlight.js version 1.0
+    if ( initParams )
+        slProperties.initParams = initParams;
+    if ( slProperties.isWindowless && !slProperties.windowless)
+        slProperties.windowless = slProperties.isWindowless;
+    if ( slProperties.framerate && !slProperties.maxFramerate)
+        slProperties.maxFramerate = slProperties.framerate;
+    if ( id && !slProperties.id)
+        slProperties.id = id;
+    
+    // remove elements which are not to be added to the instantiation tag
+    delete slProperties.ignoreBrowserVer;
+    delete slProperties.inplaceInstallPrompt;
+    delete slProperties.version;
+    delete slProperties.isWindowless;
+    delete slProperties.framerate;
+    delete slProperties.data;
+    delete slProperties.src;
+    delete slProperties.alt;
+
+
+    // detect that the correct version of Silverlight is installed, else display install
+
+    if (Silverlight.isInstalled(slPluginHelper.version))
+    {
+        //move unknown events to the slProperties array
+        for (var name in slEvents)
+        {
+            if ( slEvents[name])
+            {
+                if ( name == "onLoad" && typeof slEvents[name] == "function" && slEvents[name].length != 1 )
+                {
+                    var onLoadHandler = slEvents[name];
+                    slEvents[name]=function (sender){ return onLoadHandler(document.getElementById(id), userContext, sender)};
+                }
+                var handlerName = Silverlight.__getHandlerName(slEvents[name]);
+                if ( handlerName != null )
+                {
+                    slProperties[name] = handlerName;
+                    slEvents[name] = null;
+                }
+                else
+                {
+                    throw "typeof events."+name+" must be 'function' or 'string'";
+                }
+            }
+        }
+        slPluginHTML = Silverlight.buildHTML(slProperties);
+    }
+    //The control could not be instantiated. Show the installation prompt
+    else 
+    {
+        slPluginHTML = Silverlight.buildPromptHTML(slPluginHelper);
+    }
+
+    // insert or return the HTML
+    if(parentElement)
+    {
+        parentElement.innerHTML = slPluginHTML;
+    }
+    else
+    {
+        return slPluginHTML;
+    }
+
+}
+
+///////////////////////////////////////////////////////////////////////////////
+//
+//  buildHTML:
+//
+//  create HTML that instantiates the control
+//
+///////////////////////////////////////////////////////////////////////////////
+Silverlight.buildHTML = function( slProperties)
+{
+    var htmlBuilder = [];
+
+    htmlBuilder.push('<object type=\"application/x-silverlight\" data="data:application/x-silverlight,"');
+    if ( slProperties.id != null )
+    {
+        htmlBuilder.push(' id="' + slProperties.id + '"');
+    }
+    if ( slProperties.width != null )
+    {
+        htmlBuilder.push(' width="' + slProperties.width+ '"');
+    }
+    if ( slProperties.height != null )
+    {
+        htmlBuilder.push(' height="' + slProperties.height + '"');
+    }
+    htmlBuilder.push(' >');
+    
+    delete slProperties.id;
+    delete slProperties.width;
+    delete slProperties.height;
+    
+    for (var name in slProperties)
+    {
+        if (slProperties[name])
+        {
+            htmlBuilder.push('<param name="'+Silverlight.HtmlAttributeEncode(name)+'" value="'+Silverlight.HtmlAttributeEncode(slProperties[name])+'" />');
+        }
+    }
+    htmlBuilder.push('<\/object>');
+    return htmlBuilder.join('');
+}
+
+
+
+//////////////////////////////////////////////////////////////////
+//
+// createObjectEx:
+//
+// takes a single parameter of all createObject 
+// parameters enclosed in {}
+//
+//////////////////////////////////////////////////////////////////
+
+Silverlight.createObjectEx = function(params)
+{
+    var parameters = params;
+    var html = Silverlight.createObject(parameters.source, parameters.parentElement, parameters.id, parameters.properties, parameters.events, parameters.initParams, parameters.context);
+    if (parameters.parentElement == null)
+    {
+        return html;
+    }
+}
+
+///////////////////////////////////////////////////////////////////////////////////////////////
+//
+// buildPromptHTML
+//
+// Builds the HTML to prompt the user to download and install Silverlight
+//
+///////////////////////////////////////////////////////////////////////////////////////////////
+Silverlight.buildPromptHTML = function(slPluginHelper)
+{
+    var slPluginHTML = "";
+    var urlRoot = Silverlight.fwlinkRoot;
+    var shortVer = slPluginHelper.version ;
+    if ( slPluginHelper.alt )
+    {
+        slPluginHTML = slPluginHelper.alt;
+    }
+    else
+    {
+        if (! shortVer )
+        {
+            shortVer="";
+        }
+        slPluginHTML = "<a href='javascript:Silverlight.getSilverlight(\"{1}\");' style='text-decoration: none;'><img src='{2}' alt='Get Microsoft Silverlight' style='border-style: none'/></a>";
+        slPluginHTML = slPluginHTML.replace('{1}', shortVer );
+        slPluginHTML = slPluginHTML.replace('{2}', urlRoot + '108181');
+    }
+    
+    return slPluginHTML;
+}
+
+///////////////////////////////////////////////////////////////////////////////////////////////
+//
+// getSilverlight:
+//
+// Navigates the browser to the appropriate Silverlight installer
+//
+///////////////////////////////////////////////////////////////////////////////////////////////
+Silverlight.getSilverlight = function(version)
+{
+    if (Silverlight.onGetSilverlight )
+    {
+        Silverlight.onGetSilverlight();
+    }
+    
+    var shortVer = "";
+    var reqVerArray = String(version).split(".");
+    if (reqVerArray.length > 1)
+    {
+        var majorNum = parseInt(reqVerArray[0] );
+        if ( isNaN(majorNum) || majorNum < 2 )
+        {
+            shortVer = "1.0";
+        }
+        else
+        {
+            shortVer = reqVerArray[0]+'.'+reqVerArray[1];
+        }
+    }
+    
+    var verArg = "";
+    
+    if (shortVer.match(/^\d+\056\d+$/) )
+    {
+        verArg = "&v="+shortVer;
+    }
+    
+    Silverlight.followFWLink("114576" + verArg);
+}
+
+
+///////////////////////////////////////////////////////////////////////////////////////////////
+//
+// followFWLink:
+//
+// Navigates to a url based on fwlinkid
+//
+///////////////////////////////////////////////////////////////////////////////////////////////
+Silverlight.followFWLink = function(linkid)
+{
+    top.location=Silverlight.fwlinkRoot+String(linkid);
+}
+
+///////////////////////////////////////////////////////////////////////////////////////////////
+//
+// HtmlAttributeEncode:
+//
+// Encodes special characters in input strings as charcodes
+//
+///////////////////////////////////////////////////////////////////////////////////////////////
+Silverlight.HtmlAttributeEncode = function( strInput )
+{
+      var c;
+      var retVal = '';
+
+    if(strInput == null)
+      {
+          return null;
+    }
+      
+      for(var cnt = 0; cnt < strInput.length; cnt++)
+      {
+            c = strInput.charCodeAt(cnt);
+
+            if (( ( c > 96 ) && ( c < 123 ) ) ||
+                  ( ( c > 64 ) && ( c < 91 ) ) ||
+                  ( ( c > 43 ) && ( c < 58 ) && (c!=47)) ||
+                  ( c == 95 ))
+            {
+                  retVal = retVal + String.fromCharCode(c);
+            }
+            else
+            {
+                  retVal = retVal + '&#' + c + ';';
+            }
+      }
+      
+      return retVal;
+}
+///////////////////////////////////////////////////////////////////////////////
+//
+//  default_error_handler:
+//
+//  Default error handling function 
+//
+///////////////////////////////////////////////////////////////////////////////
+
+Silverlight.default_error_handler = function (sender, args)
+{
+    var iErrorCode;
+    var errorType = args.ErrorType;
+
+    iErrorCode = args.ErrorCode;
+
+    var errMsg = "\nSilverlight error message     \n" ;
+
+    errMsg += "ErrorCode: "+ iErrorCode + "\n";
+
+
+    errMsg += "ErrorType: " + errorType + "       \n";
+    errMsg += "Message: " + args.ErrorMessage + "     \n";
+
+    if (errorType == "ParserError")
+    {
+        errMsg += "XamlFile: " + args.xamlFile + "     \n";
+        errMsg += "Line: " + args.lineNumber + "     \n";
+        errMsg += "Position: " + args.charPosition + "     \n";
+    }
+    else if (errorType == "RuntimeError")
+    {
+        if (args.lineNumber != 0)
+        {
+            errMsg += "Line: " + args.lineNumber + "     \n";
+            errMsg += "Position: " +  args.charPosition + "     \n";
+        }
+        errMsg += "MethodName: " + args.methodName + "     \n";
+    }
+    alert (errMsg);
+}
+
+///////////////////////////////////////////////////////////////////////////////////////////////
+//
+// __cleanup:
+//
+// Releases event handler resources when the page is unloaded
+//
+///////////////////////////////////////////////////////////////////////////////////////////////
+Silverlight.__cleanup = function ()
+{
+    for (var i = Silverlight._silverlightCount - 1; i >= 0; i--) {
+        window['__slEvent' + i] = null;
+    }
+    Silverlight._silverlightCount = 0;
+    if (window.removeEventListener) { 
+       window.removeEventListener('unload', Silverlight.__cleanup , false);
+    }
+    else { 
+        window.detachEvent('onunload', Silverlight.__cleanup );
+    }
+}
+
+///////////////////////////////////////////////////////////////////////////////////////////////
+//
+// __getHandlerName:
+//
+// Generates named event handlers for delegates.
+//
+///////////////////////////////////////////////////////////////////////////////////////////////
+Silverlight.__getHandlerName = function (handler)
+{
+    var handlerName = "";
+    if ( typeof handler == "string")
+    {
+        handlerName = handler;
+    }
+    else if ( typeof handler == "function" )
+    {
+        if (Silverlight._silverlightCount == 0)
+        {
+            if (window.addEventListener) 
+            {
+                window.addEventListener('onunload', Silverlight.__cleanup , false);
+            }
+            else 
+            {
+                window.attachEvent('onunload', Silverlight.__cleanup );
+            }
+        }
+        var count = Silverlight._silverlightCount++;
+        handlerName = "__slEvent"+count;
+        
+        window[handlerName]=handler;
+    }
+    else
+    {
+        handlerName = null;
+    }
+    return handlerName;
+}
\ No newline at end of file
diff --git a/web/js/videoplayer/swfobject.js b/web/js/videoplayer/swfobject.js
new file mode 100755
index 0000000..08fb270
--- /dev/null
+++ b/web/js/videoplayer/swfobject.js
@@ -0,0 +1,5 @@
+/* SWFObject v2.1 <http://code.google.com/p/swfobject/>
+	Copyright (c) 2007-2008 Geoff Stearns, Michael Williams, and Bobby van der Sluis
+	This software is released under the MIT License <http://www.opensource.org/licenses/mit-license.php>
+*/
+var swfobject=function(){var b="undefined",Q="object",n="Shockwave Flash",p="ShockwaveFlash.ShockwaveFlash",P="application/x-shockwave-flash",m="SWFObjectExprInst",j=window,K=document,T=navigator,o=[],N=[],i=[],d=[],J,Z=null,M=null,l=null,e=false,A=false;var h=function(){var v=typeof K.getElementById!=b&&typeof K.getElementsByTagName!=b&&typeof K.createElement!=b,AC=[0,0,0],x=null;if(typeof T.plugins!=b&&typeof T.plugins[n]==Q){x=T.plugins[n].description;if(x&&!(typeof T.mimeTypes!=b&&T.mimeTypes[P]&&!T.mimeTypes[P].enabledPlugin)){x=x.replace(/^.*\s+(\S+\s+\S+$)/,"$1");AC[0]=parseInt(x.replace(/^(.*)\..*$/,"$1"),10);AC[1]=parseInt(x.replace(/^.*\.(.*)\s.*$/,"$1"),10);AC[2]=/r/.test(x)?parseInt(x.replace(/^.*r(.*)$/,"$1"),10):0}}else{if(typeof j.ActiveXObject!=b){var y=null,AB=false;try{y=new ActiveXObject(p+".7")}catch(t){try{y=new ActiveXObject(p+".6");AC=[6,0,21];y.AllowScriptAccess="always"}catch(t){if(AC[0]==6){AB=true}}if(!AB){try{y=new ActiveXObject(p)}catch(t){}}}if(!AB&&y){try{x=y.GetVariable("$version");if(x){x=x.split(" ")[1].split(",");AC=[parseInt(x[0],10),parseInt(x[1],10),parseInt(x[2],10)]}}catch(t){}}}}var AD=T.userAgent.toLowerCase(),r=T.platform.toLowerCase(),AA=/webkit/.test(AD)?parseFloat(AD.replace(/^.*webkit\/(\d+(\.\d+)?).*$/,"$1")):false,q=false,z=r?/win/.test(r):/win/.test(AD),w=r?/mac/.test(r):/mac/.test(AD);/*@cc_on q=true;@if(@_win32)z=true;@elif(@_mac)w=true;@end@*/return{w3cdom:v,pv:AC,webkit:AA,ie:q,win:z,mac:w}}();var L=function(){if(!h.w3cdom){return }f(H);if(h.ie&&h.win){try{K.write("<script id=__ie_ondomload defer=true src=//:><\/script>");J=C("__ie_ondomload");if(J){I(J,"onreadystatechange",S)}}catch(q){}}if(h.webkit&&typeof K.readyState!=b){Z=setInterval(function(){if(/loaded|complete/.test(K.readyState)){E()}},10)}if(typeof K.addEventListener!=b){K.addEventListener("DOMContentLoaded",E,null)}R(E)}();function S(){if(J.readyState=="complete"){J.parentNode.removeChild(J);E()}}function E(){if(e){return }if(h.ie&&h.win){var v=a("span");try{var u=K.getElementsByTagName("body")[0].appendChild(v);u.parentNode.removeChild(u)}catch(w){return }}e=true;if(Z){clearInterval(Z);Z=null}var q=o.length;for(var r=0;r<q;r++){o[r]()}}function f(q){if(e){q()}else{o[o.length]=q}}function R(r){if(typeof j.addEventListener!=b){j.addEventListener("load",r,false)}else{if(typeof K.addEventListener!=b){K.addEventListener("load",r,false)}else{if(typeof j.attachEvent!=b){I(j,"onload",r)}else{if(typeof j.onload=="function"){var q=j.onload;j.onload=function(){q();r()}}else{j.onload=r}}}}}function H(){var t=N.length;for(var q=0;q<t;q++){var u=N[q].id;if(h.pv[0]>0){var r=C(u);if(r){N[q].width=r.getAttribute("width")?r.getAttribute("width"):"0";N[q].height=r.getAttribute("height")?r.getAttribute("height"):"0";if(c(N[q].swfVersion)){if(h.webkit&&h.webkit<312){Y(r)}W(u,true)}else{if(N[q].expressInstall&&!A&&c("6.0.65")&&(h.win||h.mac)){k(N[q])}else{O(r)}}}}else{W(u,true)}}}function Y(t){var q=t.getElementsByTagName(Q)[0];if(q){var w=a("embed"),y=q.attributes;if(y){var v=y.length;for(var u=0;u<v;u++){if(y[u].nodeName=="DATA"){w.setAttribute("src",y[u].nodeValue)}else{w.setAttribute(y[u].nodeName,y[u].nodeValue)}}}var x=q.childNodes;if(x){var z=x.length;for(var r=0;r<z;r++){if(x[r].nodeType==1&&x[r].nodeName=="PARAM"){w.setAttribute(x[r].getAttribute("name"),x[r].getAttribute("value"))}}}t.parentNode.replaceChild(w,t)}}function k(w){A=true;var u=C(w.id);if(u){if(w.altContentId){var y=C(w.altContentId);if(y){M=y;l=w.altContentId}}else{M=G(u)}if(!(/%$/.test(w.width))&&parseInt(w.width,10)<310){w.width="310"}if(!(/%$/.test(w.height))&&parseInt(w.height,10)<137){w.height="137"}K.title=K.title.slice(0,47)+" - Flash Player Installation";var z=h.ie&&h.win?"ActiveX":"PlugIn",q=K.title,r="MMredirectURL="+j.location+"&MMplayerType="+z+"&MMdoctitle="+q,x=w.id;if(h.ie&&h.win&&u.readyState!=4){var t=a("div");x+="SWFObjectNew";t.setAttribute("id",x);u.parentNode.insertBefore(t,u);u.style.display="none";var v=function(){u.parentNode.removeChild(u)};I(j,"onload",v)}U({data:w.expressInstall,id:m,width:w.width,height:w.height},{flashvars:r},x)}}function O(t){if(h.ie&&h.win&&t.readyState!=4){var r=a("div");t.parentNode.insertBefore(r,t);r.parentNode.replaceChild(G(t),r);t.style.display="none";var q=function(){t.parentNode.removeChild(t)};I(j,"onload",q)}else{t.parentNode.replaceChild(G(t),t)}}function G(v){var u=a("div");if(h.win&&h.ie){u.innerHTML=v.innerHTML}else{var r=v.getElementsByTagName(Q)[0];if(r){var w=r.childNodes;if(w){var q=w.length;for(var t=0;t<q;t++){if(!(w[t].nodeType==1&&w[t].nodeName=="PARAM")&&!(w[t].nodeType==8)){u.appendChild(w[t].cloneNode(true))}}}}}return u}function U(AG,AE,t){var q,v=C(t);if(v){if(typeof AG.id==b){AG.id=t}if(h.ie&&h.win){var AF="";for(var AB in AG){if(AG[AB]!=Object.prototype[AB]){if(AB.toLowerCase()=="data"){AE.movie=AG[AB]}else{if(AB.toLowerCase()=="styleclass"){AF+=' class="'+AG[AB]+'"'}else{if(AB.toLowerCase()!="classid"){AF+=" "+AB+'="'+AG[AB]+'"'}}}}}var AD="";for(var AA in AE){if(AE[AA]!=Object.prototype[AA]){AD+='<param name="'+AA+'" value="'+AE[AA]+'" />'}}v.outerHTML='<object classid="clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"'+AF+">"+AD+"</object>";i[i.length]=AG.id;q=C(AG.id)}else{if(h.webkit&&h.webkit<312){var AC=a("embed");AC.setAttribute("type",P);for(var z in AG){if(AG[z]!=Object.prototype[z]){if(z.toLowerCase()=="data"){AC.setAttribute("src",AG[z])}else{if(z.toLowerCase()=="styleclass"){AC.setAttribute("class",AG[z])}else{if(z.toLowerCase()!="classid"){AC.setAttribute(z,AG[z])}}}}}for(var y in AE){if(AE[y]!=Object.prototype[y]){if(y.toLowerCase()!="movie"){AC.setAttribute(y,AE[y])}}}v.parentNode.replaceChild(AC,v);q=AC}else{var u=a(Q);u.setAttribute("type",P);for(var x in AG){if(AG[x]!=Object.prototype[x]){if(x.toLowerCase()=="styleclass"){u.setAttribute("class",AG[x])}else{if(x.toLowerCase()!="classid"){u.setAttribute(x,AG[x])}}}}for(var w in AE){if(AE[w]!=Object.prototype[w]&&w.toLowerCase()!="movie"){F(u,w,AE[w])}}v.parentNode.replaceChild(u,v);q=u}}}return q}function F(t,q,r){var u=a("param");u.setAttribute("name",q);u.setAttribute("value",r);t.appendChild(u)}function X(r){var q=C(r);if(q&&(q.nodeName=="OBJECT"||q.nodeName=="EMBED")){if(h.ie&&h.win){if(q.readyState==4){B(r)}else{j.attachEvent("onload",function(){B(r)})}}else{q.parentNode.removeChild(q)}}}function B(t){var r=C(t);if(r){for(var q in r){if(typeof r[q]=="function"){r[q]=null}}r.parentNode.removeChild(r)}}function C(t){var q=null;try{q=K.getElementById(t)}catch(r){}return q}function a(q){return K.createElement(q)}function I(t,q,r){t.attachEvent(q,r);d[d.length]=[t,q,r]}function c(t){var r=h.pv,q=t.split(".");q[0]=parseInt(q[0],10);q[1]=parseInt(q[1],10)||0;q[2]=parseInt(q[2],10)||0;return(r[0]>q[0]||(r[0]==q[0]&&r[1]>q[1])||(r[0]==q[0]&&r[1]==q[1]&&r[2]>=q[2]))?true:false}function V(v,r){if(h.ie&&h.mac){return }var u=K.getElementsByTagName("head")[0],t=a("style");t.setAttribute("type","text/css");t.setAttribute("media","screen");if(!(h.ie&&h.win)&&typeof K.createTextNode!=b){t.appendChild(K.createTextNode(v+" {"+r+"}"))}u.appendChild(t);if(h.ie&&h.win&&typeof K.styleSheets!=b&&K.styleSheets.length>0){var q=K.styleSheets[K.styleSheets.length-1];if(typeof q.addRule==Q){q.addRule(v,r)}}}function W(t,q){var r=q?"visible":"hidden";if(e&&C(t)){C(t).style.visibility=r}else{V("#"+t,"visibility:"+r)}}function g(s){var r=/[\\\"<>\.;]/;var q=r.exec(s)!=null;return q?encodeURIComponent(s):s}var D=function(){if(h.ie&&h.win){window.attachEvent("onunload",function(){var w=d.length;for(var v=0;v<w;v++){d[v][0].detachEvent(d[v][1],d[v][2])}var t=i.length;for(var u=0;u<t;u++){X(i[u])}for(var r in h){h[r]=null}h=null;for(var q in swfobject){swfobject[q]=null}swfobject=null})}}();return{registerObject:function(u,q,t){if(!h.w3cdom||!u||!q){return }var r={};r.id=u;r.swfVersion=q;r.expressInstall=t?t:false;N[N.length]=r;W(u,false)},getObjectById:function(v){var q=null;if(h.w3cdom){var t=C(v);if(t){var u=t.getElementsByTagName(Q)[0];if(!u||(u&&typeof t.SetVariable!=b)){q=t}else{if(typeof u.SetVariable!=b){q=u}}}}return q},embedSWF:function(x,AE,AB,AD,q,w,r,z,AC){if(!h.w3cdom||!x||!AE||!AB||!AD||!q){return }AB+="";AD+="";if(c(q)){W(AE,false);var AA={};if(AC&&typeof AC===Q){for(var v in AC){if(AC[v]!=Object.prototype[v]){AA[v]=AC[v]}}}AA.data=x;AA.width=AB;AA.height=AD;var y={};if(z&&typeof z===Q){for(var u in z){if(z[u]!=Object.prototype[u]){y[u]=z[u]}}}if(r&&typeof r===Q){for(var t in r){if(r[t]!=Object.prototype[t]){if(typeof y.flashvars!=b){y.flashvars+="&"+t+"="+r[t]}else{y.flashvars=t+"="+r[t]}}}}f(function(){U(AA,y,AE);if(AA.id==AE){W(AE,true)}})}else{if(w&&!A&&c("6.0.65")&&(h.win||h.mac)){A=true;W(AE,false);f(function(){var AF={};AF.id=AF.altContentId=AE;AF.width=AB;AF.height=AD;AF.expressInstall=w;k(AF)})}}},getFlashPlayerVersion:function(){return{major:h.pv[0],minor:h.pv[1],release:h.pv[2]}},hasFlashPlayerVersion:c,createSWF:function(t,r,q){if(h.w3cdom){return U(t,r,q)}else{return undefined}},removeSWF:function(q){if(h.w3cdom){X(q)}},createCSS:function(r,q){if(h.w3cdom){V(r,q)}},addDomLoadEvent:f,addLoadEvent:R,getQueryParamValue:function(v){var u=K.location.search||K.location.hash;if(v==null){return g(u)}if(u){var t=u.substring(1).split("&");for(var r=0;r<t.length;r++){if(t[r].substring(0,t[r].indexOf("="))==v){return g(t[r].substring((t[r].indexOf("=")+1)))}}}return""},expressInstallCallback:function(){if(A&&M){var q=C(m);if(q){q.parentNode.replaceChild(M,q);if(l){W(l,true);if(h.ie&&h.win){M.style.display="block"}}M=null;l=null;A=false}}}}}();
\ No newline at end of file
diff --git a/web/js/videoplayer/tagbar.js b/web/js/videoplayer/tagbar.js
new file mode 100644
index 0000000..85fb0f1
--- /dev/null
+++ b/web/js/videoplayer/tagbar.js
@@ -0,0 +1,51 @@
+(function($) {
+
+	$.widget("ui.tagbar", {
+		options: {
+			max: 400,
+			label: "",
+			start: 0,
+			end: 0
+		},
+	
+		_create: function() {
+			var o = this.options;
+			this.element
+				.addClass("ui-tagbar ui-widget");
+			
+			var inputHTML = '<input class="ui-corner-all" type="text" id="start" size="3">';
+			var startNode = $(inputHTML).attr('value', o.start);
+			var endNode   = $(inputHTML).attr('value', o.end);
+		    var sliderNode = $('<div style="width:450px; float:left" class="tag-slider"></div>')
+                .slider({
+    			    range: true,
+        			min: 0,
+        			max: o.max,
+        			values: [o.start, o.end],
+        			slide: function(event, ui) {
+        			    //$('#video').videoplayer('setTime', ui.value);
+        				startNode.val(ui.values[0]);
+        				endNode.val(ui.values[1]);
+        			}
+        		});
+		
+			this.element
+			.append('<div class="tag-label">'+o.label+'</div>')
+			.append($('<div class="tag-play"></div>')
+            	.click(function() {}))
+        	.append(sliderNode)
+			.append($('<div class="tag-times"></div>')
+		    	.append(startNode)
+            	.append(endNode))
+		},
+
+		destroy : function() {
+		}
+
+	});
+
+	$.extend($.ui.tagbar, {});
+
+})(jQuery);
+
+	
diff --git a/web/js/videoplayer/test.html b/web/js/videoplayer/test.html
new file mode 100644
index 0000000..aeb2d8d
--- /dev/null
+++ b/web/js/videoplayer/test.html
@@ -0,0 +1,99 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
+   "http://www.w3.org/TR/html4/loose.dtd">
+
+<html lang="en">
+<head>
+	<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+	<title>Video test</title>
+    <script type="text/javascript" src="http://yui.yahooapis.com/3.1.1/build/yui/yui-min.js"></script>
+    <script type="text/javascript" src="/js/videoplayer/swfobject.js"></script>
+</head>
+
+<body>
+<div id="videoplayer"></div>
+ 
+<div id="controls">
+    <input type="button" id="play" value="play">
+    <input type="button" id="pause" value="pause">
+    <input type="button" id="stop" value="stop">
+</div>
+ 
+<div id="properties">
+    get: <input type="button" id="getduration" value="duration">
+    <input type="button" id="gettime" value="time">
+    <div id="info"></div>
+</div>
+
+<div id="set">
+    set: <input type="button" id="settime" value="time">
+    <input type="button" id="setplaytime" value="time and play">
+    <input type="button" id="load" value="load">
+</div>
+
+<div id="listeners" style="height:300px; overflow:auto">
+    listeners: <ul id="state"></ul>
+</div>    
+
+<script type="text/javascript">
+YUI({
+    modules: {
+        "video-player": {
+            fullpath:"/js/videoplayer/videoplayer.js"
+        }
+    }
+}).use("node","event","widget","video-player",function(Y) {
+    
+var video = {
+    flash: [
+        "http://content3f.omroep.nl/255fe3abbaea31fe9f92e491287ded08/4c6e44a8/nos/content/broadcast/2010/08/20/laatstejournaalflash_2010-08-20_10_00_02.flv",
+        "http://content1c.omroep.nl/2f359eea10d174263cc2979239f26ce7/4baa173c/nos/content/broadcast/2010/03/24/laatstejournaalflash_2010-03-24_14_00_01.flv"
+    ],
+    silverlight: [
+        "http://cgi.omroep.nl/cgi-bin/streams?/tv/kro/boerzoektvrouw/bb.20061112.asf",
+        "http://cgi.omroep.nl/cgi-bin/streams?/tv/kro/boerzoektvrouw/bb.20061008.asf"
+    ]
+};    
+  
+src = video.flash;
+    
+    var videoPlayer = new Y.mazzle.VideoPlayer({
+        src:src[0],
+        filepath:"/js/videoplayer/",
+	    width:320,
+	    height:240
+	});
+    videoPlayer.render('#videoplayer');
+    
+    Y.one('#play').on("click", function(e) {
+	    videoPlayer.play();
+    });
+    Y.one('#pause').on("click", function(e) {
+	    videoPlayer.pause();
+    });
+    Y.one('#stop').on("click", function(e) {
+	    videoPlayer.stop();
+    });    
+    Y.one('#gettime').on("click", function(e) {
+	    Y.one("#info").set("innerHTML", videoPlayer.getTime());
+    });
+    Y.one('#getduration').on("click", function(e) {
+	    Y.one("#info").set("innerHTML", videoPlayer.getDuration());
+    });    
+    Y.one('#settime').on("click", function(e) {
+        videoPlayer.setTime(10);
+    });
+    Y.one('#setplaytime').on("click", function(e) {
+        videoPlayer.setTime(10, true);
+    });
+    Y.one('#load').on("click", function(e) {
+        videoPlayer.loadVideo(src[1]);
+    });
+
+
+    videoPlayer.on("stateChanged", function(e) {
+        Y.one('#state').prepend('<li>state:'+e.newstate+'</li>');
+    });
+});
+</script>
+</body>
+</html>
diff --git a/web/js/videoplayer/videoplayer.js b/web/js/videoplayer/videoplayer.js
new file mode 100644
index 0000000..19fffa7
--- /dev/null
+++ b/web/js/videoplayer/videoplayer.js
@@ -0,0 +1,436 @@
+function flashPlayerTimeListener(obj) { 
+	var player = document.getElementById(obj.id);
+	player.position = obj.position;
+}
+function flashPlayerStateListener(obj) { 
+	var player = document.getElementById(obj.id);
+	player.state = obj.newstate;
+}
+
+YUI.add('video-player', function(Y) {
+
+	var Lang = Y.Lang,
+		Widget = Y.Widget,
+		Node = Y.Node;
+
+	var NS = Y.namespace('mazzle');	
+	NS.VideoPlayer = VideoPlayer;
+	
+	/* VideoPlayer class constructor */
+	function VideoPlayer(config) {
+		VideoPlayer.superclass.constructor.apply(this, arguments);
+	}
+
+	/* 
+	 * Required NAME static field, to identify the Widget class and 
+	 * used as an event prefix, to generate class names etc. (set to the 
+	 * class name in camel case). 
+	 */
+	VideoPlayer.NAME = "videoplayer";
+
+	/*
+	 * The attribute configuration for the VideoPlayer widget. Attributes can be
+	 * defined with default values, get/set functions and validator functions
+	 * as with any other class extending Base.
+	 */
+	VideoPlayer.ATTRS = {
+		src: {
+			value: ""
+		},
+		height: {
+			value: 200
+		},
+		width: {
+			value: 300
+		},
+		state: { // "BUFFERING", "PAUSED", "PLAYING", "FINISHED"
+			value: "STOPPED"
+		},
+		duration: { // in ms
+			value: null
+		},
+		autoplay: {
+			value: false
+		},
+		start: {
+			value: 0
+		},
+		controls: {
+			value: true
+		},
+		playerType : {
+			value: null
+		},
+		extensions : {
+			value: {
+				flv:"flash",
+				asf:"silverlight",
+				wmv:"silverlight"
+			}
+		},
+		filepath : {
+			value: '/js/videoplayer/'
+		}
+	};
+
+	/* VideoPlayer extends the base Widget class */
+	Y.extend(VideoPlayer, Widget, {
+
+		initializer: function() {
+			if(!this.get("playerType")) {
+				this._setPlayerType();
+			}
+		},
+
+		destructor : function() {
+		},
+
+		renderUI : function() {
+			this._renderContent();
+		},
+
+		bindUI : function() {
+		},
+
+		syncUI : function() {
+		},
+
+		_renderContent : function() {
+			var playerType = this.get("playerType");
+			if(playerType=="html") {
+				this._renderHTMLPlayer();
+			} else if(playerType=="flash") {
+				this._renderFlashPlayer();
+			} else if(playerType=="silverlight") {
+				this._renderSilverlightPlayer();
+			}
+		},
+		
+		_renderHTMLPlayer : function() {
+			var content = this.get("contentBox"),
+				src = this.get("src"),
+				height = this.get("height"),
+				width = this.get("width"),
+				id = Y.guid();
+
+			var video = '<video'
+				+' id='+id
+				+' src='+src
+				+' height='+height+'px'
+				+' width='+width+'px'
+				+' currentTime='+this.get("start")
+				+ 'preload';
+			if(this.get("autoplay")) {video += ' autoplay'}
+			if(this.get("controls")) {video += ' controls' }
+			video +='></video>';
+
+			content.appendChild(Node.create(video));
+			this.player = document.getElementById(id);//video._node;
+		},
+		
+		_renderSilverlightPlayer : function() {			
+			// make sure we have the required scripts loaded
+			if(typeof jeroenwijering == "undefined") {
+				var filepath = this.get('filepath'),
+					urls = [
+						filepath+'silverlight.js',
+						filepath+'wmvplayer.js'
+					];
+					
+				Y.Get.script(urls, {
+		    		onSuccess: this._embedSilverlightPlayer,
+					context: this
+				});
+			}
+			else {
+				this._embedSilverlightPlayer();
+			}				
+		},
+		
+		_embedSilverlightPlayer : function() {
+			var src = this.get("src");
+			
+			Y.log('create silverlight player');
+
+			var content = this.get("contentBox"),
+				height = this.get("height"),
+				width = this.get("width"),
+				start = this.get("start"),
+				id = Y.guid(),
+				xaml = this.get('filepath')+'wmvplayer.xaml';
+		
+			var video = content.appendChild(Node.create('<div id="'+id+'"></div>'));
+		    var cfg = {
+			    file:src,
+			    width:width,
+			    height:height,
+				//linkfromdisplay:'true',
+				autostart:'true'
+		    };
+ 			if(!this.get("controls")) {cfg.shownavigation='false'}
+			this.player = new jeroenwijering.Player(video._node,xaml,cfg);
+			this._addSilverlightListeners();
+			this._silverlightJumpStart();
+		},
+		
+		_addSilverlightListeners : function() {
+			if(this.player.view) {
+				var oSelf = this,
+					player = this.player;
+					
+				player.addListener('TIME', function(time) {
+					oSelf._changeCurrentTime(time);
+				});
+				player.addListener('STATE', function(oldState, newState) {
+					oSelf._changeState(newState);
+				}); 
+			} else {
+				Y.later(100, this, this._addSilverlightListeners);
+			}
+		},
+			
+		_renderFlashPlayer : function() {
+ 			var url = this.get('filepath')+'swfobject.js';
+			if(typeof swfobject == "undefined") {
+ 				Y.Get.script(url, {
+		    		onSuccess: this._embedFlashPlayer,
+					context: this
+				});
+			} 
+			else {
+				this._embedFlashPlayer();
+			}
+		},
+		
+		_embedFlashPlayer : function() {
+			Y.log('create flash player');
+			
+			var content = this.get("contentBox"),
+ 				height = this.get("height"),
+				width = this.get("width"),
+				id = Y.guid(),
+				playerId = id+"_player",
+				swf = this.get('filepath')+'player.swf';
+			
+			var flashvars = {
+				file: this.get("src"),
+				autostart: 'true'
+			};
+			if(!this.get("controls")) {flashvars.controlbar='none'}
+			var attributes = {
+				'id': playerId,
+				'name': playerId
+			};
+			var params = {
+				'allowscriptaccess': 'always'
+			};
+			
+			content.appendChild(Node.create('<div id="'+id+'"></div>'));
+			swfobject.embedSWF(swf,id,width,height,'9','false',flashvars,params,attributes);
+			this.playerId = playerId;
+			this._flashJumpStart();
+			this._addFlashListeners();
+		},
+		
+		_addFlashListeners : function() {
+			try {
+				var player = document.getElementById(this.playerId);
+				// add listeners
+				player.addModelListener("Time", "flashPlayerTimeListener");
+				player.addModelListener("State", "flashPlayerStateListener");
+				this.player = player;
+				this._flashTimeCheck();
+				this._flashStateCheck();
+			} catch(e) {
+				Y.later(100, this, this._addFlashListeners);
+			}
+		},
+			
+		getDuration : function() {
+			var pt = this.get("playerType"),
+				p = this.player;
+			if(this.duration) {
+				return this.duration;
+			} else {
+				if(pt=="silverlight") {
+					return p.configuration.duration;
+				} else if(pt=="flash") {
+					return p.getConfig().duration;
+				}
+			}
+		},	
+		// returns current playHead in ms
+		getTime : function() {
+			var p = this.player;
+			if(p.currentTime) {
+				return p.currentTime;
+			} else {
+				return 0;
+			}
+		},
+		// sets current playHead in ms
+		setTime : function(time, play) {
+			Y.log('seek to '+time);
+			var pt = this.get("playerType"),
+				p = this.player,
+				oldtime = this.getTime();
+				
+			if(pt=="silverlight") {
+				p.sendEvent('SCRUB', time);
+				if(play) { this.play(); }
+			} else if(pt=="flash"){
+				p.sendEvent('SEEK', time);
+				if(!play) { Y.later(100, this, this.pause); }
+			} else {
+				p.currentTime = time;
+				if(play) {this.play();}
+			}
+			this.fire("timeSet", {oldtime:oldtime, newtime:time});
+		},
+		loadVideo : function(src) {
+			Y.log('load '+src);	
+			var oldPt = this.get("playerType"),
+				p = this.player;
+			
+			this.set("src", src);
+ 			var pt = this._setPlayerType();
+			if(pt==oldPt) {
+				if(pt=="silverlight"||pt=="flash") {
+					// TBD something fails here
+					p.sendEvent("LOAD", src);
+				}
+			} else {
+				this._renderContent();
+			}
+			this.fire("videoLoad", {src:src, playerType:pt});
+		},
+		play : function() {
+			var pt = this.get("playerType"),
+				p = this.player,
+				state = this.get("state");
+
+			if(!(state=='BUFFERING'||state=='PLAYING')) {
+				if(pt=="html") {
+					p.play();
+					this._changeState("PLAYING");
+				} else {
+					p.sendEvent('PLAY');
+				}
+			}
+		},
+		pause : function() {
+			var pt = this.get("playerType"),
+				p = this.player,
+				state = this.get("state");
+
+			if(state=='PLAYING'||state=='BUFFERING') {
+				if(pt=="html") {
+					p.pause();
+					this._changeState("PAUSED");
+				} else {
+					p.sendEvent('PLAY');
+				}
+			}
+		},
+		stop : function() {
+			var pt = this.get("playerType"),
+				p = this.player;
+			
+			if(pt=="html") {
+				p.stop();
+				this._changeState("STOPPED");
+			} else {
+				p.sendEvent('STOP');
+			}
+		},
+
+		_setPlayerType : function() {
+			// guess required playerType based on extension
+			if(this.get("src")) {
+				var pt = null,
+					src = this.get("src"),
+					extensions = this.get("extensions"),
+					videoType = src.substr(src.length-3, 3);
+
+				if(extensions[videoType]) {
+					pt = extensions[videoType];
+				} else {
+					pt = "html";
+				}
+			}
+			this.set("playerType", pt);
+			return pt;
+		},
+		
+		_silverlightJumpStart : function() {
+			var p = this.player,
+				state = this.get("state");
+			// we made the silverlight player autoplay by default
+			// (to load the file)
+			// and now we pause it when we did not want that.
+			if(p.controller&&state=='PLAYING') {
+				this.fire("bufferReady");
+				var start = this.get("start");				
+				if(!this.get("autoplay")) {
+					p.sendEvent('PLAY');
+				}
+				if(start) {
+					p.sendEvent('SCRUB', start);
+				}
+			} else {
+				Y.later(100, this, this._silverlightJumpStart);
+			}
+		},
+		
+		_flashJumpStart : function() {
+			var p = this.player,
+				state = this.get("state"),
+				start = this.get("start");
+			
+			// we made the player autoplay by default
+			// (to load the file)
+			// and now we pause it when we did not want that.
+			if(p) {
+				this.fire("bufferReady");
+				var start = this.get("start");				
+				if(!this.get("autoplay")) {
+					p.sendEvent('PLAY');
+				}
+				if(start) {
+					p.sendEvent('SEEK', start);
+				}
+			} else {
+				Y.later(100, this, this._flashJumpStart);
+			}
+		},	
+		
+		_flashStateCheck : function() {
+			this._changeState(this.player.state);
+			Y.later(100, this, this._flashStateCheck);
+		},		
+		_changeState : function(newState) {
+			newState = newState.toUpperCase();
+			var oldState = this.get("state");
+			
+			if(newState&&oldState!==newState) {
+				this.set("state", newState);
+				Y.log('state: '+newState);
+				this.fire("stateChanged", {oldstate:oldState, newstate:newState});
+			}
+		},
+		
+		_flashTimeCheck : function() {
+			this._changeCurrentTime(this.player.position);
+			Y.later(100, this, this._flashTimeCheck);
+		},
+		_changeCurrentTime : function(time) {
+			var player = this.player;
+				
+			if(player.currentTime!==time) {
+				player.currentTime = time;
+				this.fire("timeChange", {time:time});
+			}
+		}
+	});
+	
+}, 'gallery-2010.03.02-18' ,{requires:['node','event','widget']});
\ No newline at end of file
diff --git a/web/js/videoplayer/wmvplayer.js b/web/js/videoplayer/wmvplayer.js
new file mode 100644
index 0000000..8b826f6
--- /dev/null
+++ b/web/js/videoplayer/wmvplayer.js
@@ -0,0 +1,794 @@
+/****************************************************************************
+* JW WMV Player version 1.1, created with M$ Silverlight 1.0
+*
+* This file contains all logic for the JW WMV Player. For a functional setup,
+* the following two files are also needed:
+* - silverlight.js (for instantiating the silverlight plugin)
+* - wmvplayer.xaml (or another XAML skin describing the player graphics)
+*
+* More info: http://www.jeroenwijering.com/?item=JW_WMV_Player
+****************************************************************************/
+if(typeof jeroenwijering == "undefined") {
+	var jeroenwijering = new Object();
+	jeroenwijering.utils = new Object();
+}
+
+
+
+
+
+
+
+
+
+
+/****************************************************************************
+* The player wrapper; loads config variables and starts MVC cycle.
+****************************************************************************/
+jeroenwijering.Player = function(cnt,src,cfg) {
+	this.controller;
+	this.model;
+	this.view;
+	this.configuration = {
+		backgroundcolor:'FFFFFF',
+		windowless:'false',
+		file:'',
+		height:'260',
+		image:'',
+		backcolor:'FFFFFF',
+		frontcolor:'000000',
+		lightcolor:'000000',
+		screencolor:'000000',
+		width:'320',
+		logo:'',
+		overstretch:'false',
+		shownavigation:'true',
+		showstop:'false',
+		showdigits:'true',
+		usefullscreen:'true',
+		usemute:'false',
+		autostart:'false',
+		bufferlength:'3',
+		duration:'0',
+		repeat:'false',
+		sender:'',
+		start:'0',
+		volume:'90',
+		link:'',
+		linkfromdisplay:'false',
+		linktarget:'_self'
+	};
+	for(itm in this.configuration) {
+		if(cfg[itm] != undefined) {
+			if (itm.indexOf('color') > 0) { 
+				this.configuration[itm] = cfg[itm].substr(cfg[itm].length-6);
+			} else {
+				this.configuration[itm] = cfg[itm];
+			}
+		}
+	}
+	Silverlight.createObjectEx({
+		source:src,
+		parentElement:cnt,
+		properties:{
+			width:this.configuration['width'],
+			height:this.configuration['height'],
+			version:'1.0',
+			inplaceInstallPrompt:true,
+			isWindowless:this.configuration['windowless'],
+			background:'#'+this.configuration['backgroundcolor']
+		},
+		events:{
+			onLoad:this.onLoadHandler,
+			onError:null
+		},
+		context:this
+	});
+}
+
+jeroenwijering.Player.prototype = {
+	addListener: function(typ,fcn) {
+		this.view.listeners.push({type:typ,func:fcn});
+	},
+
+	getConfig: function() { 
+		return this.configuration;
+	},
+
+	onLoadHandler: function(pid,tgt,sdr) {
+		tgt.configuration['sender'] = sdr;
+		tgt.controller = new jeroenwijering.Controller(tgt.configuration);
+		tgt.view = new jeroenwijering.View(tgt.configuration,tgt.controller);
+		tgt.model = new jeroenwijering.Model(tgt.configuration,tgt.controller,tgt.view);
+		tgt.controller.startMVC(tgt.view,tgt.model);
+	},
+
+	sendEvent: function(typ,prm) {
+		switch(typ.toUpperCase()) {
+			case 'LINK':
+				this.controller.setLink();
+				break;
+			case 'LOAD':
+				this.controller.setLoad(prm);
+				break;
+			case 'MUTE':
+				this.controller.setMute();
+				break;
+			case 'PLAY':
+				this.controller.setPlay();
+				break;
+			case 'SCRUB':
+				this.controller.setScrub(prm);
+				break;
+			case 'STOP':
+				this.controller.setStop();
+				break;
+			case 'VOLUME':
+				this.controller.setVolume(prm);
+				break;
+		}
+	}
+}
+
+
+
+
+
+
+
+
+
+
+/****************************************************************************
+* The controller of the player MVC triad, which processes all user input.
+****************************************************************************/
+jeroenwijering.Controller = function(cfg) {
+	this.configuration = cfg;
+}
+
+jeroenwijering.Controller.prototype = {
+	startMVC: function(vie,mdl) {
+		this.view = vie;
+		this.model = mdl;
+		if(this.configuration['usemute'] == 'true') {
+			this.view.onVolume(0);
+			this.view.onMute(true);
+			this.model.goVolume(0);
+		} else {
+			this.view.onVolume(this.configuration['volume']);
+			this.model.goVolume(this.configuration['volume']);
+		}
+		if(this.configuration['autostart'] == 'true') {
+			this.model.goStart();
+		} else { 
+			this.model.goPause();
+		}
+	},
+
+	setState: function(old,stt) {
+		this.state = stt;
+		var pos = this.configuration['start'];
+		if(old == 'Closed' && pos > 0) {
+			setTimeout(jeroenwijering.utils.delegate(this,this.setScrub),200,pos);
+		} 
+	},
+
+	setLink: function() {
+		if (this.configuration['linktarget'].indexOf('javascript:') == 0) {
+			return Function(this.configuration['linktarget']).apply();
+		} else if (this.configuration['linktarget'] == '_blank') {
+			window.open(this.configuration['link']);
+		} else if (this.configuration['linktarget'] != '') {
+			window.location = this.configuration['link'];
+		}
+	},
+
+	setLoad: function(fil) {
+		if(this.model.state != "Closed") {
+			this.model.goStop(); 
+		}
+		this.configuration['file'] = fil;
+		if(this.configuration['autostart'] == 'true') {
+			setTimeout(jeroenwijering.utils.delegate(this.model,this.model.goStart),100);
+		}
+	},
+
+	setMute: function() {
+		if(this.configuration['usemute'] == 'true') {
+			this.configuration['usemute'] = 'false';
+			this.model.goVolume(this.configuration['volume']);
+			this.view.onMute(false);
+		} else {
+			this.configuration['usemute'] = 'true';
+			this.model.goVolume(0);
+			this.view.onMute(true);
+		}
+	},
+
+	setPlay: function() {
+		if(this.state == 'Buffering' || this.state == 'Playing') {
+			if(this.configuration['duration'] == 0) { 
+				this.model.goStop();
+			} else { 
+				this.model.goPause();
+			}
+		} else {
+			this.model.goStart();
+		}
+	},
+
+	setScrub: function(sec) {
+		if(sec < 2) {
+			sec = 0;
+		} else if (sec > this.configuration['duration']-4) {
+			sec = this.configuration['duration']-4;
+		}
+		if(this.state == 'Buffering' || this.state == 'Playing') {
+			this.model.goStart(sec);
+		} else {
+			this.model.goPause(sec);
+		}
+	},
+
+	setStop: function() {
+		this.model.goStop();
+	},
+
+	setVolume: function(pct) {
+		if(pct < 0) { pct = 0; } else if(pct > 100) { pct = 100; }
+		this.configuration['volume'] = Math.round(pct);
+		this.model.goVolume(pct);
+		this.view.onVolume(pct);
+		if(this.configuration['usemute'] == 'true') {
+			this.configuration['usemute'] = 'false';
+			this.view.onMute(false);
+		} 
+	},
+
+	setFullscreen: function() {
+		var fss = !this.configuration['sender'].getHost().content.FullScreen;
+		this.configuration['sender'].getHost().content.FullScreen = fss;
+		jeroenwijering.utils.delegate(this.view,this.view.onFullscreen);
+	}
+}
+
+
+
+
+
+
+
+
+
+
+/****************************************************************************
+* The view of the player MVC triad, which manages the graphics.
+****************************************************************************/
+jeroenwijering.View = function(cfg,ctr) {
+	this.configuration = cfg;
+	this.listeners = Array();
+	this.controller = ctr;
+	this.fstimeout;
+	this.fslistener;
+	this.display = this.configuration['sender'].findName("PlayerDisplay");
+	this.controlbar = this.configuration['sender'].findName("PlayerControls");
+	this.configuration['sender'].getHost().content.onResize = 
+		jeroenwijering.utils.delegate(this,this.resizePlayer);
+	this.configuration['sender'].getHost().content.onFullScreenChange = 
+		jeroenwijering.utils.delegate(this,this.onFullscreen);
+	this.assignColorsClicks();
+	this.resizePlayer();
+}
+
+jeroenwijering.View.prototype = {
+	onBuffer: function(pct) {
+		var snd = this.configuration['sender'];
+		if(pct == 0) { 
+			snd.findName("BufferText").Text = null;
+		} else { 
+			pct < 10 ? pct = "0"+pct: pct = ""+pct;
+			snd.findName("BufferText").Text = pct;
+		}
+		this.delegate('BUFFER',[pct]);
+	},
+
+	onFullscreen: function(fss) {
+		var snd = this.configuration['sender'];
+		var fst = snd.getHost().content.FullScreen;
+		if(fst) { 
+			this.fstimeout = setTimeout(jeroenwijering.utils.delegate(this,
+				this.hideFSControls),2000);
+			this.fslistener = this.display.addEventListener('MouseMove',
+				jeroenwijering.utils.delegate(this,this.showFSControls));
+			snd.findName("FullscreenSymbol").Visibility = "Collapsed";
+			snd.findName("FullscreenOffSymbol").Visibility = "Visible";
+		} else {
+			clearTimeout(this.fstimeout);
+			this.display.removeEventListener("MouseMove",this.fslistener);
+			this.controlbar.Visibility = "Visible";
+			this.display.Cursor = "Hand";
+			snd.findName("FullscreenSymbol").Visibility = "Visible";
+			snd.findName("FullscreenOffSymbol").Visibility = "Collapsed";
+		}
+		this.resizePlayer();
+		this.delegate('FULLSCREEN');
+	},
+
+	showFSControls: function(sdr,arg) {
+		var vbt = sdr.findName('PlayerControls');
+		var yps = arg.GetPosition(vbt).Y;
+		clearTimeout(this.fstimeout);
+		this.controlbar.Visibility = "Visible";
+		this.display.Cursor = "Hand";
+		if(yps < 0) { 
+			this.fstimeout = setTimeout(jeroenwijering.utils.delegate(this,
+				this.hideFSControls),2000);
+		}
+	},
+
+	hideFSControls: function() {
+		this.controlbar.Visibility = "Collapsed";
+		this.display.Cursor = "None";
+	},
+
+	onLoad: function(pct) {
+		var snd = this.configuration['sender'];
+		var max = snd.findName("TimeSlider").Width;
+		snd.findName("DownloadProgress").Width = Math.round(max*pct/100);
+		this.delegate('LOAD',[pct]);
+	},
+
+	onMute: function(mut) {
+		var snd = this.configuration['sender'];
+		this.configuration['usemute'] = ''+mut;
+		if(mut) {
+			snd.findName("VolumeHighlight").Visibility = "Collapsed";
+			snd.findName("MuteSymbol").Visibility = "Visible";
+			snd.findName("MuteOffSymbol").Visibility = "Collapsed";
+			if(this.state == 'Playing') {
+				snd.findName("MuteIcon").Visibility = "Visible";
+			}
+		} else {
+			snd.findName("VolumeHighlight").Visibility = "Visible";
+			snd.findName("MuteSymbol").Visibility = "Collapsed";
+			snd.findName("MuteOffSymbol").Visibility = "Visible";
+			snd.findName("MuteIcon").Visibility = "Collapsed";
+		}
+		this.delegate('MUTE');
+	},
+
+	onState: function(old,stt) {
+		var snd = this.configuration['sender'];
+		this.state = stt;
+		if(stt == 'Buffering' || stt == 'Playing' || stt == 'Opening') {
+			snd.findName("PlayIcon").Visibility = "Collapsed";
+			snd.findName("PlaySymbol").Visibility = "Collapsed";
+			snd.findName("PlayOffSymbol").Visibility = "Visible";
+			if (stt=='Playing') {
+				snd.findName("BufferIcon").Visibility = "Collapsed";
+				snd.findName("BufferText").Visibility = "Collapsed";
+				if(this.configuration['usemute'] == 'true') {
+					snd.findName("MuteIcon").Visibility = "Visible";
+				}
+			} else{
+				snd.findName("BufferIcon").Visibility = "Visible";
+				snd.findName("BufferText").Visibility = "Visible";
+			}
+		} else { 
+			snd.findName("MuteIcon").Visibility = "Collapsed";
+			snd.findName("BufferIcon").Visibility = "Collapsed";
+			snd.findName("BufferText").Visibility = "Collapsed";
+			snd.findName("PlayOffSymbol").Visibility = "Collapsed";
+			snd.findName("PlaySymbol").Visibility = "Visible";
+			if(this.configuration['linkfromdisplay'] == 'true') {
+				snd.findName("PlayIcon").Visibility = "Collapsed";
+			} else { 
+				snd.findName("PlayIcon").Visibility = "Visible";
+			}
+		}
+		try {
+			if(!(old == 'Completed' && stt == 'Buffering') &&
+				!(old == 'Buffering' && stt == 'Paused')) {
+				playerStatusChange(old.toUpperCase(),stt.toUpperCase());
+			}
+		} catch (err) {}
+		this.delegate('STATE',[old,stt]);
+	},
+
+	onTime: function(elp,dur) {
+		var snd = this.configuration['sender'];
+		var snd = this.configuration['sender'];
+		var max = snd.findName("TimeSlider").Width;
+		if(dur > 0) {
+			var pos = Math.round(max*elp/dur);
+			this.configuration['duration'] = dur;
+			snd.findName("ElapsedText").Text = jeroenwijering.utils.timestring(elp);
+			snd.findName("RemainingText").Text = jeroenwijering.utils.timestring(dur-elp);
+			snd.findName("TimeSymbol").Visibility = "Visible";
+			snd.findName("TimeSymbol")['Canvas.Left'] = pos+4;
+			snd.findName("TimeHighlight").Width = pos-2;
+		} else  { 
+			snd.findName("TimeSymbol").Visibility = "Collapsed";
+		}
+		this.delegate('TIME',[elp,dur]);
+	},
+
+	onVolume: function(pct) {
+		var snd = this.configuration['sender'];
+		snd.findName("VolumeHighlight").Width = Math.round(pct/5);
+		this.delegate('VOLUME',[pct]);
+	},
+
+	assignColorsClicks: function() {
+		this.display.Cursor = "Hand";
+		this.display.Background = "#FF"+this.configuration['screencolor'];
+		if(this.configuration['linkfromdisplay'] == 'false') { 
+			this.display.addEventListener('MouseLeftButtonUp',
+				jeroenwijering.utils.delegate(this.controller,
+				this.controller.setPlay));
+		} else { 
+			this.display.addEventListener('MouseLeftButtonUp',
+				jeroenwijering.utils.delegate(this.controller,
+				this.controller.setLink));
+			this.display.findName("PlayIcon").Visibility = "Collapsed";
+		}
+		if(this.configuration['logo'] != '') {
+			this.display.findName('OverlayCanvas').Visibility = "Visible";
+			this.display.findName('OverlayLogo').ImageSource = 
+				this.configuration['logo'];
+		}
+		this.controlbar.findName("ControlbarBack").Fill = 
+			"#FF"+this.configuration['backcolor'];
+		this.assignButton('Play',this.controller.setPlay);
+		this.assignButton('Stop',this.controller.setStop);
+		this.configuration['sender'].findName('ElapsedText').Foreground = 
+			"#FF"+this.configuration['frontcolor'];
+		this.assignSlider('Time',this.changeTime);
+		this.configuration['sender'].findName('DownloadProgress').Fill = 
+			"#FF"+this.configuration['frontcolor'];
+		this.configuration['sender'].findName('RemainingText').Foreground = 
+			"#FF"+this.configuration['frontcolor'];
+		this.assignButton('Link',this.controller.setLink);
+		this.assignButton('Fullscreen',this.controller.setFullscreen);
+		this.assignButton('Mute',this.controller.setMute);
+		this.assignSlider('Volume',this.changeVolume);
+	},
+
+	assignButton: function(btn,act) {
+		var el1 = this.configuration['sender'].findName(btn+'Button');
+		el1.Cursor = "Hand";
+		el1.addEventListener('MouseLeftButtonUp',
+			jeroenwijering.utils.delegate(this.controller,act));
+		el1.addEventListener('MouseEnter',
+			jeroenwijering.utils.delegate(this,this.rollOver));
+		el1.addEventListener('MouseLeave',
+			jeroenwijering.utils.delegate(this,this.rollOut));
+		this.configuration['sender'].findName(btn+'Symbol').Fill = 
+			"#FF"+this.configuration['frontcolor'];
+		try {
+			this.configuration['sender'].findName(btn+'OffSymbol').Fill = 
+				"#FF"+this.configuration['frontcolor'];
+		} catch(e) {}
+	},
+
+	assignSlider: function(sld,act) {
+		var el1 = this.configuration['sender'].findName(sld+'Button');
+		el1.Cursor = "Hand";
+		el1.addEventListener('MouseLeftButtonUp',
+			jeroenwijering.utils.delegate(this,act));
+		el1.addEventListener('MouseEnter',
+			jeroenwijering.utils.delegate(this,this.rollOver));
+		el1.addEventListener('MouseLeave',
+			jeroenwijering.utils.delegate(this,this.rollOut));
+		this.configuration['sender'].findName(sld+'Slider').Fill = 
+			"#FF"+this.configuration['frontcolor'];
+		this.configuration['sender'].findName(sld+'Highlight').Fill = 
+			"#FF"+this.configuration['frontcolor'];
+		this.configuration['sender'].findName(sld+'Symbol').Fill = 
+			"#FF"+this.configuration['frontcolor'];
+	},
+
+	delegate: function(typ,arg) {
+		for(var i=0; i<this.listeners.length; i++) {
+			if(this.listeners[i]['type'].toUpperCase() == typ) {
+				this.listeners[i]['func'].apply(null,arg);
+			}
+		}
+	},
+
+	rollOver: function(sdr) {
+		var str = sdr.Name.substr(0,sdr.Name.length-6);
+		this.configuration['sender'].findName(str+'Symbol').Fill = 
+			"#FF"+this.configuration['lightcolor'];
+		try {
+			this.configuration['sender'].findName(str+'OffSymbol').Fill = 
+				"#FF"+this.configuration['lightcolor'];
+		} catch(e) {}
+	},
+
+	rollOut: function(sdr) {
+		var str = sdr.Name.substr(0,sdr.Name.length-6);
+		this.configuration['sender'].findName(str+'Symbol').Fill = 
+			"#FF"+this.configuration['frontcolor'];
+		try {
+			this.configuration['sender'].findName(str+'OffSymbol').Fill = 
+				"#FF"+this.configuration['frontcolor'];
+		} catch(e) {}
+	},
+
+	changeTime: function(sdr,arg) {
+		var tbt = sdr.findName('TimeSlider');
+		var xps = arg.GetPosition(tbt).X;
+		var sec = Math.floor(xps/tbt.Width*this.configuration['duration']);
+		this.controller.setScrub(sec);
+	},
+
+	changeVolume: function(sdr,arg) {
+		var vbt = sdr.findName('VolumeButton');
+		var xps = arg.GetPosition(vbt).X;
+		this.controller.setVolume(xps*5);
+	},
+
+	resizePlayer: function() {
+		var wid = this.configuration['sender'].getHost().content.actualWidth;
+		var hei = this.configuration['sender'].getHost().content.actualHeight;
+		var fss = this.configuration['sender'].getHost().content.FullScreen;
+		if(this.configuration['shownavigation'] == 'true') {
+			if(fss == true) {
+				this.resizeDisplay(wid,hei);
+				this.controlbar['Canvas.Left'] = Math.round(wid/2-250);
+				this.resizeControlbar(500,hei-this.controlbar.Height-16);
+				this.controlbar.findName('ControlbarBack')['Opacity'] = 0.5;
+			} else { 
+				this.resizeDisplay(wid,hei-20);
+				this.controlbar['Canvas.Left'] = 0;
+				this.resizeControlbar(wid,hei-this.controlbar.Height);
+				this.controlbar.findName('ControlbarBack')['Opacity'] = 1;
+			}
+		} else {
+			this.resizeDisplay(wid,hei);
+		}
+	},
+
+	resizeDisplay: function(wid,hei) {
+		this.stretchElement('PlayerDisplay',wid,hei);
+		this.stretchElement('VideoWindow',wid,hei);
+		this.stretchElement('PlaceholderImage',wid,hei);
+		this.centerElement('PlayIcon',wid,hei);
+		this.centerElement('MuteIcon',wid,hei);
+		this.centerElement('BufferIcon',wid,hei);
+		this.centerElement('BufferText',wid,hei);
+		this.display.findName('OverlayCanvas')['Canvas.Left'] = wid -
+			this.display.findName('OverlayCanvas').Width - 10;
+		this.display.Visibility = "Visible";
+	},
+
+	resizeControlbar: function(wid,yps,alp) {
+		this.controlbar['Canvas.Top'] = yps;
+		this.stretchElement('PlayerControls',wid);
+		this.stretchElement('ControlbarBack',wid);
+		this.placeElement('PlayButton',0);
+		var lft = 17;
+		this.placeElement('VolumeButton',wid-24);
+		this.placeElement('MuteButton',wid-37);
+		var rgt = 37;
+		if(this.configuration['showstop'] == 'true') {
+			this.placeElement('StopButton',lft);
+			lft += 17;
+		} else {
+			this.controlbar.findName('StopButton').Visibility="Collapsed";
+		}
+		if(this.configuration['usefullscreen'] == 'true') {
+			rgt += 18;
+			this.placeElement('FullscreenButton',wid-rgt);
+		} else {
+			this.controlbar.findName('FullscreenButton').Visibility = 
+				"Collapsed";
+		}
+		if(this.configuration['link'] != '') {
+			rgt += 18;
+			this.placeElement('LinkButton',wid-rgt);
+		} else {
+			this.controlbar.findName('LinkButton').Visibility="Collapsed";
+		}
+		if(this.configuration['showdigits'] == 'true' && wid-rgt-lft> 160) {
+			rgt += 35;
+			this.controlbar.findName('RemainingButton').Visibility="Visible";
+			this.controlbar.findName('ElapsedButton').Visibility="Visible";
+			this.placeElement('RemainingButton',wid-rgt);
+			this.placeElement('ElapsedButton',lft);
+			lft +=35;
+		} else {
+			this.controlbar.findName('RemainingButton').Visibility = 
+				"Collapsed";
+			this.controlbar.findName('ElapsedButton').Visibility="Collapsed";
+		}
+		this.placeElement('TimeButton',lft);
+		this.stretchElement('TimeButton',wid-lft-rgt);
+		this.stretchElement('TimeShadow',wid-lft-rgt);
+		this.stretchElement('TimeStroke',wid-lft-rgt);
+		this.stretchElement('TimeFill',wid-lft-rgt);
+		this.stretchElement('TimeSlider',wid-lft-rgt-10);
+		this.stretchElement('DownloadProgress',wid-lft-rgt-10);
+		var tsb = this.configuration['sender'].findName('TimeSymbol');
+		this.stretchElement('TimeHighlight',tsb['Canvas.Left']-5);
+		this.controlbar.Visibility = "Visible";
+	},
+
+	centerElement: function(nam,wid,hei) {
+		var elm = this.configuration['sender'].findName(nam);
+		elm['Canvas.Left'] = Math.round(wid/2 - elm.Width/2);
+		elm['Canvas.Top'] = Math.round(hei/2 - elm.Height/2);
+	},
+
+	stretchElement: function(nam,wid,hei) {
+		var elm = this.configuration['sender'].findName(nam);
+		elm.Width = wid;
+		if (hei != undefined) { elm.Height = hei; }
+	},
+
+	placeElement: function(nam,xps,yps) {
+		var elm = this.configuration['sender'].findName(nam);
+		elm['Canvas.Left'] = xps;
+		if(yps) { elm['Canvas.Top'] = yps; }
+	}
+}
+
+
+
+
+
+
+
+
+
+
+/****************************************************************************
+* The model of the player MVC triad, which stores all playback logic.
+****************************************************************************/
+jeroenwijering.Model = function(cfg,ctr,vie) {
+	this.configuration = cfg;
+	this.controller = ctr;
+	this.view = vie;
+	this.video = this.configuration['sender'].findName("VideoWindow");
+	this.preview = this.configuration['sender'].findName("PlaceholderImage");
+	var str = {
+		'true':'UniformToFill',
+		'false':'Uniform',
+		'fit':'Fill',
+		'none':'None'
+	}
+	this.state = this.video.CurrentState;
+	this.timeint;
+	this.video.Stretch = str[this.configuration['overstretch']];
+	this.preview.Stretch = str[this.configuration['overstretch']];
+	this.video.BufferingTime = 
+		jeroenwijering.utils.spanstring(this.configuration['bufferlength']);
+	this.video.AutoPlay = true;
+	this.video.AddEventListener("CurrentStateChanged",
+		jeroenwijering.utils.delegate(this,this.stateChanged));
+	this.video.AddEventListener("MediaEnded",
+		jeroenwijering.utils.delegate(this,this.mediaEnded));
+	this.video.AddEventListener("BufferingProgressChanged",
+		jeroenwijering.utils.delegate(this,this.bufferChanged));
+	this.video.AddEventListener("DownloadProgressChanged",
+		jeroenwijering.utils.delegate(this,this.downloadChanged));
+	if(this.configuration['image'] != '') {
+		this.preview.Source = this.configuration['image'];
+	}
+}
+
+jeroenwijering.Model.prototype = {
+	goPause: function(sec) {
+		this.video.pause();
+		if(!isNaN(sec)) {
+			this.video.Position = jeroenwijering.utils.spanstring(sec);
+		}
+		this.timeChanged();
+	},
+
+	goStart: function(sec) {
+		this.video.Visibility = 'Visible';
+		this.preview.Visibility = 'Collapsed';
+		if(this.state == "Closed") {
+			this.video.Source = this.configuration['file'];
+		} else {
+			this.video.play();
+		}
+		if(!isNaN(sec)) {
+			this.video.Position = jeroenwijering.utils.spanstring(sec);
+		}
+	},
+
+	goStop: function() {
+		this.video.Visibility = 'Collapsed';
+		this.preview.Visibility = 'Visible';
+		this.goPause(0);
+		this.video.Source = 'null';
+		this.view.onBuffer(0);
+		clearInterval(this.timeint);
+	},
+
+	goVolume: function(pct) {
+		this.video.Volume = pct/100;
+	},
+
+	stateChanged: function() {
+		var stt = this.video.CurrentState;
+		if(stt != this.state) {
+			this.controller.setState(this.state,stt);
+			this.view.onState(this.state,stt);
+			this.state = stt;
+			this.configuration['duration'] = 
+				Math.round(this.video.NaturalDuration.Seconds*10)/10;
+			if(stt != "Playing" && stt != "Buffering" && stt != "Opening") {
+				clearInterval(this.timeint);
+			} else {
+				this.timeint = setInterval(jeroenwijering.utils.delegate(
+					this,this.timeChanged),100);
+			}
+		}
+	},
+
+	mediaEnded: function() {
+		if(this.configuration['repeat'] == 'true') {
+			this.goStart(0);
+		} else {
+			this.state = 'Completed';
+			this.view.onState(this.state,'Completed');
+			this.video.Visibility = 'Collapsed';
+			this.preview.Visibility = 'Visible';
+			this.goPause(0);
+		}
+	},
+
+	bufferChanged: function() {
+		var bfr = Math.round(this.video.BufferingProgress*100);
+		this.view.onBuffer(bfr);
+	},
+
+	downloadChanged: function() {
+		var dld = Math.round(this.video.DownloadProgress*100);
+		this.view.onLoad(dld);
+	},
+
+	timeChanged: function() {
+		var pos = Math.round(this.video.Position.Seconds*10)/10;
+		this.view.onTime(pos,this.configuration['duration']);
+	}
+}
+
+
+
+
+
+
+
+
+
+
+/****************************************************************************
+* Some utility functions.
+****************************************************************************/
+jeroenwijering.utils.delegate = function(obj,fcn) {
+	return function() {
+		return fcn.apply(obj,arguments);
+	}
+}
+jeroenwijering.utils.timestring = function(stp) {
+	var hrs = Math.floor(stp/3600);
+	var min = Math.floor(stp%3600/60);
+	var sec = Math.round(stp%60);
+	var str = "";
+	sec > 9 ? str += sec: str +='0'+sec;
+	min > 9 ? str = min+":"+str: str='0'+min+":"+str;
+	hrs > 0 ? str = hrs+":"+str: null;
+	return str;
+}
+jeroenwijering.utils.spanstring = function(stp) {
+	var hrs = Math.floor(stp/3600);
+	var min = Math.floor(stp%3600/60);
+	var sec = Math.round(stp%60*10)/10;
+	var str = hrs+':'+min+':'+sec;
+	return str;
+}
\ No newline at end of file
diff --git a/web/js/videoplayer/wmvplayer.xaml b/web/js/videoplayer/wmvplayer.xaml
new file mode 100644
index 0000000..c53244e
--- /dev/null
+++ b/web/js/videoplayer/wmvplayer.xaml
@@ -0,0 +1,330 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!--
+JW WMV Player version 1.1, created with M$ Silverlight 1.0.
+
+This file contains all logic for the JW WMV Player. For a functional setup,
+the following two files are also needed:
+- silverlight.js (for instantiating the silverlight plugin)
+- wmvplayer.js (this file contains all the scripting logic)
+
+More info: http://www.jeroenwijering.com/?item=JW_WMV_Player
+-->
+
+<Canvas xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" Width="320" Height="260">
+
+
+
+
+	<Canvas x:Name="PlayerDisplay" Width="320" Height="240" Background="#FF000000" Visibility="Collapsed">
+		<Image x:Name="PlaceholderImage" Width="320" Height="240" />
+		<MediaElement x:Name="VideoWindow" Width="320" Height="240" />
+		<Canvas x:Name="PlayIcon" Width="40" Height="40" Canvas.Left="140" Canvas.Top="100">
+			<Path x:Name="PlayIconBack" Width="40" Height="40" Fill="#77000000" Data="F1 M4,0 L36,0 C38,0 40,2 40,4 L40,36 C40,38 38,40 36,40 L4,40 C2,40 0,38 0,36 L0,4 C0,2 2,0 4,0 Z"/>
+			<Path x:Name="PlayIconFront" Width="18" Height="18" Canvas.Left="12" Canvas.Top="11" Fill="#FFFFFFFF" Data="F1 M0,0 L18,9 L0,18 L0,0 Z"/>
+		</Canvas>
+    	<Canvas x:Name="MuteIcon" Width="40" Height="40" Canvas.Left="140" Canvas.Top="100" Visibility="Collapsed">
+			<Path x:Name="MuteIconBack" Width="40" Height="40" Fill="#77000000" Data="F1 M4,0 L36,0 C38,0 40,2 40,4 L40,36 C40,38 38,40 36,40 L4,40 C2,40 0,38 0,36 L0,4 C0,2 2,0 4,0 Z"/>
+			<Path x:Name="MuteIconFront" Width="18" Height="18" Canvas.Left="13" Canvas.Top="11" Fill="#FFFFFFFF" Data="F1 M0,4 L4,4 L4,14 L0,14 L0,4 M6,4 L11,0 L11,18 L6,14 L6,4 M14,8 L18,8 L18,10 L14,10 L14,8 Z"/>
+		</Canvas>
+		<Canvas x:Name="BufferIcon" Width="32" Height="32" Canvas.Left="148" Canvas.Top="98" Visibility="Collapsed">
+	    	<Canvas.RenderTransform>
+				<RotateTransform x:Name="BufferRotation" Angle="0" CenterX="16" CenterY="16" />
+			</Canvas.RenderTransform>
+			<Canvas.Triggers>
+				<EventTrigger RoutedEvent="Canvas.Loaded">
+					<BeginStoryboard>
+						<Storyboard>
+							<DoubleAnimationUsingKeyFrames Storyboard.TargetName="BufferRotation" Storyboard.TargetProperty="Angle" Duration="0:0:1.2" RepeatBehavior="Forever">
+								<DiscreteDoubleKeyFrame Value="30" KeyTime="0:0:0.1" />
+								<DiscreteDoubleKeyFrame Value="60" KeyTime="0:0:0.2" />
+								<DiscreteDoubleKeyFrame Value="90" KeyTime="0:0:0.3" />
+								<DiscreteDoubleKeyFrame Value="120" KeyTime="0:0:0.4" />
+								<DiscreteDoubleKeyFrame Value="150" KeyTime="0:0:0.5" />
+								<DiscreteDoubleKeyFrame Value="180" KeyTime="0:0:0.6" />
+								<DiscreteDoubleKeyFrame Value="210" KeyTime="0:0:0.7" />
+								<DiscreteDoubleKeyFrame Value="240" KeyTime="0:0:0.8" />
+								<DiscreteDoubleKeyFrame Value="270" KeyTime="0:0:0.9" />
+								<DiscreteDoubleKeyFrame Value="300" KeyTime="0:0:1" />
+								<DiscreteDoubleKeyFrame Value="330" KeyTime="0:0:1.1" />
+								<DiscreteDoubleKeyFrame Value="360" KeyTime="0:0:1.2" />
+							</DoubleAnimationUsingKeyFrames>
+						</Storyboard>
+					</BeginStoryboard>
+				</EventTrigger>
+			</Canvas.Triggers> 
+			<Path x:Name="BufferPath1" Width="2" Height="8" Canvas.Left="15" Canvas.Top="0" Stretch="Fill" Fill="#FFFFFFFF" Data="F1 M16,0 L16,0 C16.55,0 17,0.45 17,1 L17,7 C17,7.55 16.55,8 16,8 L16,8C 15.45,8 15,7.55 15,7 L15,1 C15,0.45 15.45,0 16,0 Z "/>
+			<Path x:Name="BufferPath2" Width="5" Height="7.2" Canvas.Left="7.5" Canvas.Top="2" Stretch="Fill" Fill="#EEFFFFFF" Data="F1 M8,2.14 L8,2.14 C8.48,1.87 9.09,2.03 9.37,2.51 L12.366,7.71 C12.64,8.18 12.48,8.80 12,9.07 L12,9.07 C11.52,9.35 10.91,9.18 10.63,8.71 L7.63,3.51 C7.36,3.03 7.52,2.42 8,2.14 Z "/>
+			<Path x:Name="BufferPath3" Width="7.2" Height="5" Canvas.Left="2" Canvas.Top="7.5" Stretch="Fill" Fill="#DDFFFFFF" Data="F1 M2.14,8. L2.14,8 C2.42,7.52 3.03,7.36 3.51,7.63 L8.71,10.63 C9.18,10.91 9.35,11.52 9.07,12 L9.07,12 C8.80,12.48 8.18,12.64 7.71,12.36 L2.51,9.37 C2.03,9.09 1.87,8.48 2.14,8 Z "/>
+			<Path x:Name="BufferPath4" Width="8" Height="2" Canvas.Left="0" Canvas.Top="15" Stretch="Fill" Fill="#BBFFFFFF" Data="F1 M0,16 L0,16 C0,15.45 0.45,15 1,15 L7,15 C7.55,15 8,15.45 8,16 L8,16 C8,16.55 7.55,17 7,17 L1,17 C0.45,17 0,16.55 0,16 Z "/>
+			<Path x:Name="BufferPath5" Width="7.2" Height="5" Canvas.Left="2" Canvas.Top="19.5" Stretch="Fill" Fill="#AAFFFFFF" Data="F1 M2.14,24 L2.14,24 C1.87,23.52 2.03,22.91 2.51,22.63 L7.71,19.63 C8.18,19.35 8.80,19.52 9.08,20 L9.07,20 C9.35,20.48 9.18,21.09 8.71,21.36 L3.51,24.37 C3.03,24.64 2.42,24.48 2.14,24 Z "/>
+			<Path x:Name="BufferPath6" Width="5" Height="7.2" Canvas.Left="7.5" Canvas.Top="22.8" Stretch="Fill" Fill="#99FFFFFF" Data="F1 M8,29.86 L8,29.86 C7.52,29.58 7.36,28.97 7.63,28.49 L10.63,23.29 C10.91,22.82 11.52,22.65 12,22.93 L12,22.93 C12.48,23.20 12.64,23.82 12.37,24.29 L9.37,29.49 C9.09,29.97 8.48,30.13 8,29.86 Z "/>
+			<Path x:Name="BufferPath7" Width="2" Height="8" Canvas.Left="15" Canvas.Top="24" Stretch="Fill" Fill="#77FFFFFF" Data="F1 M16,24 L16,24 C16.55,24 17,24.45 17,25 L17,31 C17,31.55 16.55,32 16,32 L16,32 C15.45,32 15,31.55 15,31 L15,25 C15,24.45 15.45,24 16,24 Z "/>
+			<Path x:Name="BufferPath8" Width="5" Height="7.2" Canvas.Left="19.5" Canvas.Top="22.8" Stretch="Fill" Fill="#66FFFFFF" Data="F1 M20,22.93 L20,22.93 C20.48,22.65 21.09,22.82 21.36,23.29 L24.37,28.49 C24.64,28.97 24.48,29.58 24,29.86 L24,29.86 C23.52,30.13 22.91,29.97 22.63,29.49 L19.63,24.29 C19.36,23.82 19.52,23.20 20,22.93 Z "/>
+			<Path x:Name="BufferPath9" Width="7.2" Height="5" Canvas.Left="22.8" Canvas.Top="19.5" Stretch="Fill" Fill="#55FFFFFF" Data="F1 M22.93,20 L22.93,20 C23.20,19.52 23.82,19.36 24.29,19.63 L29.49,22.63 C29.97,22.91 30.13,23.52 29.86,24 L29.86,24 C29.58,24.48 28.97,24.64 28.49,24.37 L23.29,21.37 C22.82,21.09 22.65,20.48 22.93,20 Z "/>
+			<Path x:Name="BufferPath10" Width="8" Height="2" Canvas.Left="24" Canvas.Top="15" Stretch="Fill" Fill="#33FFFFFF" Data="F1 M24,16 L24,16 C24,15.45 24.45,15 25,15 L31,15 C31.55,15 32,15.45 32,16 L32,16 C32,16.55 31.55,17 31,17 L25,17 C24.45,17 24,16.55 24,16 Z "/>
+			<Path x:Name="BufferPath11" Width="7.2" Height="5" Canvas.Left="22.8" Canvas.Top="7.5" Stretch="Fill" Fill="#22FFFFFF" Data="F1 M 22.93,12 L22.93,12 C22.65,11.52 22.82,10.91 23.29,10.63 L28.49,7.63 C28.97,7.36 29.58,7.52 29.86,8 L29.86,8 C30.13,8.48 29.97,9.09 29.49,9.37 L24.29,12.36 C23.82,12.64 23.20,12.48 22.93,12 Z "/>
+			<Path x:Name="BufferPath12" Width="5" Height="7.2" Canvas.Left="19.5" Canvas.Top="2" Stretch="Fill" Fill="#11FFFFFF" Data="F1 M 20,9.07 L20,9.07 C19.52,8.80 19.36,8.18 19.63,7.71 L22.63,2.51 C22.91,2.03 23.52,1.87 24,2.14 L24,2.14 C24.48,2.42 24.64,3.03 24.37,3.51 L21.37,8.71 C21.09,9.18 20.48,9.35 20,9.07 Z "/>
+		</Canvas>
+		<TextBlock x:Name="BufferText" Canvas.Left="158" Canvas.Top="108" FontFamily="Verdana" FontSize="9" FontWeight="Bold" Foreground="#FFFFFFFF" Width="12" Height="10"/>
+		<Canvas x:Name="OverlayCanvas" Width="300" Height="200" Canvas.Left="220" Canvas.Top="10" Visibility="Collapsed">
+			<Canvas.Background>
+				<ImageBrush x:Name="OverlayLogo" AlignmentX="Right" AlignmentY="Top" Stretch="None" />
+			</Canvas.Background>
+		</Canvas>
+	</Canvas>
+
+
+
+
+	<Canvas x:Name="PlayerControls" Width="320" Height="20" Canvas.Top="240" Visibility="Collapsed">
+		<Rectangle x:Name="ControlbarBack" Width="320" Height="19" Fill="#FFFFFFFF" />
+
+
+		<Canvas x:Name="VolumeButton" Width="24" Height="20" Canvas.Left="296">
+			<Rectangle x:Name="VolumeShadow" Width="24" Height="1" Canvas.Top="19" Stretch="Fill" Fill="#55000000"/>
+			<Path x:Name="VolumeStroke" Width="24" Height="19" Data="F1 M 0,0 L 24,0 L 24,19 L 0,19 L 0,18 L 23,18 L 23,1 L 0,1 0,0 Z ">
+				<Path.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#C0000000" Offset="0"/>
+							<GradientStop Color="#C0FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Path.Fill>
+			</Path>
+			<Rectangle x:Name="VolumeFill" Width="23" Height="17" Canvas.Top="1">
+				<Rectangle.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#40000000" Offset="0"/>
+							<GradientStop Color="#40FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Rectangle.Fill>
+			</Rectangle>
+			<Canvas x:Name="VolumeMask" Width="18" Height="19" Clip="F1 M1,9 L2,9 L2,10 L1,10 L1,9 M3,8.5 L4,8.5 L4,10.5 L3,10.5 L3,8.5 M5,8 L6,8 L6,11 L5,11 L5,8 M7,7.5 L8,7.5 L8,11.5 L7,11.5 L7,7.5 M9,7 L10,7 L10,12 L9,12 L9,7 M11,6.5 L12,6.5 L12,12.5 L11,12.5 L11,6.5 M13,6 L14,6 L14,13 L13,13 L13,6 M15,5.5 L16,5.5 L16,13.5 L15,13.5 L15,5.5 M17,5 L18,5 L18,14 L17,14 L17,5 Z">
+				<Rectangle x:Name="VolumeSlider" Width="18" Height="15" Canvas.Top="2" Opacity="0.3" Fill="#FF000000"/>
+				<Rectangle x:Name="VolumeHighlight" Width="18" Height="15" Canvas.Top="2" Fill="#FF000000"/>
+				<Rectangle x:Name="VolumeSymbol" Width="1" Canvas.Top="6" Height="7" Fill="#00000000"/>
+			</Canvas>
+		</Canvas>
+
+
+		<Canvas x:Name="MuteButton" Width="13" Height="20" Canvas.Left="283">
+			<Rectangle x:Name="MuteShadow" Width="13" Height="1" Canvas.Top="19" Fill="#55000000"/>
+			<Path x:Name="MuteStroke" Width="13" Height="19" Data="F 1 M 0,0 L 13,0 L 13,1 L 1,1 L 1,18 L 13,18 L 13,19 L 0,19 0,0 Z ">
+				<Path.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#C0000000" Offset="0"/>
+							<GradientStop Color="#C0FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Path.Fill>
+			</Path>
+			<Rectangle x:Name="MuteFill" Width="12" Height="17" Canvas.Left="1" Canvas.Top="1">
+				<Rectangle.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#40000000" Offset="0"/>
+							<GradientStop Color="#40FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Rectangle.Fill>
+			</Rectangle>
+			<Path x:Name="MuteOffSymbol" Width="5" Height="7" Canvas.Left="6" Canvas.Top="6" Fill="#FF000000" Data="F 1 M 0,2 L2,2 L 2,5 L0,5 L0,0 M3,1 L4,1 L4,0 L5,0 L5,7 L4,7 L4,6 L3,6 L3,1 Z "/>
+			<Path x:Name="MuteSymbol" Width="5" Height="7" Canvas.Left="6" Canvas.Top="6" Opacity="0.3" Fill="#FF000000" Data="F 1 M 0,2 L2,2 L 2,5 L0,5 L0,0 M3,1 L4,1 L4,0 L5,0 L5,7 L4,7 L4,6 L3,6 L3,1 Z "/>
+		</Canvas>
+
+
+		<Canvas x:Name="FullscreenButton" Width="18" Height="20" Canvas.Left="265">
+			<Rectangle x:Name="FullscreenShadow" Width="18" Height="1" Canvas.Top="19" Fill="#55000000"/>
+			<Path x:Name="FullscreenStroke" Width="18" Height="19" Canvas.Left="0" Canvas.Top="0" Data="F1 M0,0 L18,0 L18,1 L1,1 L1,18 L18,18 L 18,19 L0,19 L0,0 Z ">
+				<Path.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#C0000000" Offset="0"/>
+							<GradientStop Color="#C0FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Path.Fill>
+			</Path>
+			<Rectangle x:Name="FullscreenFill" Width="17" Height="17" Canvas.Left="1" Canvas.Top="1">
+				<Rectangle.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#40000000" Offset="0"/>
+							<GradientStop Color="#40FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Rectangle.Fill>
+			</Rectangle>
+			<Path x:Name="FullscreenSymbol" Width="9" Height="9" Canvas.Left="5" Fill="#FF000000" Canvas.Top="5" Data="F1 M0,0 L2,0 L2,1 L1,1 L1,2 L0,2 L0,0 M0,7 L1,7 L1,8 L2,8 L2,9 L0,9 L0,7 M7,0 L9,0 L9,2 L8,2 L8,1 L7,1 L7,0 M8,7 L9,7 L9,9 L7,9 L7,8 L8,8 L8,7 M2,2 L7,2 L7,7 L2,7 L2,2 Z" />
+			<Path x:Name="FullscreenOffSymbol" Width="9" Height="9" Canvas.Left="5" Fill="#00000000" Canvas.Top="5" Visibility="Collapsed" Data="F1 M1,0 L2,0 L2,2 L0,2 L0,1 L1,1 L1,0 M0,7 L2,7 L2,9 L1,9 L1,8 L0,8 L0,7 M7,0 L8,0 L8,1 L9,1 L9,2 L7,2 L7,0 M7,7 L9,7 L9,8 L8,8 L8,9 L7,9 L7,7 M2,2 L7,2 L7,7 L2,7 L2,2 Z" />
+		</Canvas>
+
+
+		<Canvas x:Name="LinkButton" Width="18" Height="20" Canvas.Left="247">
+			<Rectangle x:Name="LinkShadow" Width="18" Height="1" Canvas.Top="19" Fill="#55000000"/>
+			<Path x:Name="LinkStroke" Width="18" Height="19" Canvas.Left="0" Canvas.Top="0" Data="F1 M0,0 L18,0 L18,1 L1,1 L1,18 L18,18 L 18,19 L0,19 L0,0 Z ">
+				<Path.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#C0000000" Offset="0"/>
+							<GradientStop Color="#C0FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Path.Fill>
+			</Path>
+			<Rectangle x:Name="LinkFill" Width="17" Height="17" Canvas.Left="1" Canvas.Top="1">
+				<Rectangle.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#40000000" Offset="0"/>
+							<GradientStop Color="#40FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Rectangle.Fill>
+			</Rectangle>
+			<Path x:Name="LinkSymbol" Width="9" Height="9" Canvas.Left="5" Fill="#FF000000" Canvas.Top="5" Data="F1 M2,0 L7,0 L7,4 L9,4 L5,9 L4,9 L0,4 L2,4 L2,0 Z" />
+		</Canvas>
+
+
+		<Canvas x:Name="RemainingButton" Width="35" Height="20" Canvas.Left="207">
+			<Rectangle x:Name="RemainingShadow" Width="35" Height="1" Canvas.Top="19" Fill="#55000000" />
+			<Path x:Name="RemainingStroke" Width="35" Height="19" Stretch="Fill" Data="F1 M0,0 L35,0 L35,01 L0,1 L0,0 M 0,18 L35,18 L35,19 L0,19 L0,18 Z ">
+				<Path.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#C0000000" Offset="0"/>
+							<GradientStop Color="#C0FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Path.Fill>
+			</Path>
+			<Rectangle x:Name="RemainingFill" Width="35" Height="17" Canvas.Left="0" Canvas.Top="1">
+				<Rectangle.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0.0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#40000000" Offset="0"/>
+							<GradientStop Color="#40FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Rectangle.Fill>
+			</Rectangle>
+			<TextBlock x:Name="RemainingText" Text="00:00" Canvas.Left="1" Canvas.Top="4" FontFamily="Verdana" FontSize="9" FontWeight="Bold" />
+		</Canvas>
+
+
+		<Canvas x:Name="TimeButton" Width="133" Height="20" Canvas.Left="74" Canvas.Top="0">
+			<Rectangle x:Name="TimeShadow" Width="133" Height="1" Canvas.Top="19" Fill="#55000000"/>
+			<Path x:Name="TimeStroke" Width="133" Height="19" Stretch="Fill" Data="F1 M0,0 L168,0 L168,01 L0,1 L0,0 M0,18 L168,18 L168,19 L0,19 L0,18 Z ">
+				<Path.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#C0000000" Offset="0"/>
+							<GradientStop Color="#C0FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Path.Fill>
+			</Path>
+			<Rectangle x:Name="TimeFill" Width="133" Height="17" Canvas.Top="1" Stretch="Fill" >
+				<Rectangle.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#40000000" Offset="0"/>
+							<GradientStop Color="#40FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Rectangle.Fill>
+			</Rectangle>
+			<Rectangle x:Name="TimeSlider" Width="123" Height="5" Canvas.Top="7" Canvas.Left="5" Fill="#00000000" Opacity="0" />
+			<Rectangle x:Name="DownloadProgress" Width="123" Height="5" Canvas.Top="7" Canvas.Left="5" Fill="#00000000" Opacity="0.3" />
+			<Rectangle x:Name="TimeHighlight" Width="123" Height="5" Canvas.Top="7" Canvas.Left="5" Fill="#FF000000"/>
+			<Rectangle x:Name="TimeSymbol" Width="2" Height="7" Canvas.Top="6" Canvas.Left="5" Fill="#FF000000"/>
+		</Canvas>
+
+
+		<Canvas x:Name="ElapsedButton" Width="35" Height="20" Canvas.Left="34">
+			<Rectangle x:Name="ElapsedShadow" Width="35" Height="1" Canvas.Top="19" Fill="#55000000"/>
+			<Path x:Name="ElapsedStroke" Width="40" Height="19" Data="F1 M0,0 L35,0 L35,01 L0,1 L0,0 M 0,18 L35,18 L35,19 L0,19 L0,18 Z ">
+				<Path.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#C0000000" Offset="0"/>
+							<GradientStop Color="#C0FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Path.Fill>
+			</Path>
+			<Rectangle x:Name="ElapsedFill" Width="35" Height="17" Canvas.Left="0" Canvas.Top="1">
+				<Rectangle.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0.0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#40000000" Offset="0"/>
+							<GradientStop Color="#40FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Rectangle.Fill>
+			</Rectangle>
+			<TextBlock x:Name="ElapsedText" Text="00:00" Canvas.Left="6" Canvas.Top="4" FontFamily="Verdana" FontSize="9" FontWeight="Bold" />
+		</Canvas>
+
+
+		<Canvas x:Name="StopButton" Width="17" Height="20" Canvas.Left="17">
+			<Rectangle x:Name="StopShadow" Width="17" Height="1" Canvas.Top="19" Fill="#55000000"/>
+			<Path x:Name="StopStroke" Width="17" Height="19" Canvas.Left="0" Canvas.Top="0" Data="F1 M 0,0 L17,0 L17,19 L0,19 L0,18 L16,18 L16,1 L0,1 L0,0 Z ">
+				<Path.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#C0000000" Offset="0"/>
+							<GradientStop Color="#C0FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Path.Fill>
+			</Path>
+			<Rectangle x:Name="StopFill" Width="16" Height="17" Canvas.Top="1">
+				<Rectangle.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#40000000" Offset="0"/>
+							<GradientStop Color="#40FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Rectangle.Fill>
+			</Rectangle>
+			<Path x:Name="StopSymbol" Width="6" Height="7" Canvas.Left="5" Fill="#FF000000" Canvas.Top="6" Data="F1 M0,0 L6,0 L6,7 L0,7 L0,0 Z " />
+		</Canvas>
+
+
+		<Canvas x:Name="PlayButton" Width="17" Height="20">
+			<Rectangle x:Name="PlayShadow" Width="17" Height="1" Canvas.Top="19" Fill="#55000000"/>
+			<Path x:Name="PlayStroke" Width="17" Height="19" Canvas.Left="0" Canvas.Top="0" Data="F0 M 0,0 L17,0 L17,19 L0,19 L0,0 M1,1 L16,1 L16,18 L1,18 L1,1 Z ">
+				<Path.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#C0000000" Offset="0"/>
+							<GradientStop Color="#C0FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Path.Fill>
+			</Path>
+			<Rectangle x:Name="PlayFill" Width="15" Height="17" Canvas.Left="1" Canvas.Top="1">
+				<Rectangle.Fill>
+					<LinearGradientBrush StartPoint="0.5,1" EndPoint="0.5,0">
+						<LinearGradientBrush.GradientStops>
+							<GradientStop Color="#40000000" Offset="0"/>
+							<GradientStop Color="#40FFFFFF" Offset="1"/>
+						</LinearGradientBrush.GradientStops>
+					</LinearGradientBrush>
+				</Rectangle.Fill>
+			</Rectangle>
+			<Path x:Name="PlayOffSymbol" Width="5" Height="7" Canvas.Left="6" Fill="#FF000000" Canvas.Top="6" Visibility="Collapsed" Data="F1 M0,0 L2,0 L2,7 L0,7 L0,0 M3,0 L5,0 L5,7 L3,7 L3,0 Z " />
+			<Path x:Name="PlaySymbol" Width="6" Height="7" Canvas.Left="6" Fill="#FF000000" Canvas.Top="6" Data="F1 M0,0 L1,0 L1,1 L3,1 L3,2 L5,2 L5,3 L6,3 L6,4 L5,4 L5,5 L3,5 L3,6 L1,6 L1,7 L0,7 L0,0 Z" />
+		</Canvas>
+
+
+	</Canvas>
+
+
+</Canvas>
\ No newline at end of file