/**
 * This file provides dom writing predicates.
 *
 * Warranty & Liability
 * To the extent permitted by applicable law and unless explicitly
 * otherwise agreed upon, XLOG Technologies AG makes no warranties
 * regarding the provided information. XLOG Technologies AG assumes
 * no liability that any problems might be solved with the information
 * provided by XLOG Technologies AG.
 *
 * Rights & License
 * All industrial property rights regarding the information - copyright
 * and patent rights in particular - are the sole property of XLOG
 * Technologies AG. If the company was not the originator of some
 * excerpts, XLOG Technologies AG has at least obtained the right to
 * reproduce, change and translate the information.
 *
 * Reproduction is restricted to the whole unaltered document. Reproduction
 * of the information is only allowed for non-commercial uses. Selling,
 * giving away or letting of the execution of the library is prohibited.
 * The library can be distributed as part of your applications and libraries
 * for execution provided this comment remains unchanged.
 *
 * Restrictions
 * Only to be distributed with programs that add significant and primary
 * functionality to the library. Not to be distributed with additional
 * software intended to replace any components of the library.
 *
 * Trademarks
 * Jekejeke is a registered trademark of XLOG Technologies AG.
 */

:- ensure_loaded(library(text/markup)).

/*******************************************************************/
/* DOM Access                                                      */
/*******************************************************************/

/**
 * tag_goto(I):
 * The predicate succeeds. As a side effect the cursor
 * is set to the element with id I.
 */
% tag_goto(+Atom)
tag_goto(Id) :-
   flush_output,
   ir_cell_goto(Id, Elem),
   ir_cell_set(Elem).

/**
 * tag_clear:
 * The predicate succeeds. As a side effect the cursor
 * content is removed.
 */
% tag_clear
tag_clear :-
   flush_output,
   ir_cell_current(Elem),
   ir_object_set(Elem, 'innerHTML', '').

/**
 * tag_remove:
 * The predicate succeeds. As a side effect the cursor
 * is removed and set to its parent.
 */
% tag_remove
tag_remove :-
   flush_output,
   ir_cell_current(Elem),
   ir_object_current(Elem, 'parentElement', Elem2),
   ir_object_set(Elem, 'outerHTML', ''),
   ir_cell_set(Elem2).

/*******************************************************************/
/* Event Handler                                                   */
/*******************************************************************/

/**
 * tag_bind(T, P, G):
 * tag_bind(T, P, G, L):
 * The predicate succeeds. As a side effect it adds a type T stackless
 * event handler with formal event parameter P and callback goal G
 * to the cursor. The quaternary predicate allows specifying 
 * event options.
 */
% tag_bind(+Atom, +Term, +Goal)
tag_bind(Type, Para, Goal) :-
   flush_output,
   ir_cell_current(Elem),
   sys_cell_bind_opts(Elem, Type, Para, Goal, []).

% tag_bind(+Atom, +Term, +Goal, +List)
tag_bind(Type, Para, Goal, Opts) :-
   flush_output,
   ir_cell_current(Elem),
   sys_cell_bind_opts(Elem, Type, Para, Goal, Opts).

% sys_cell_bind_opts(+Element, +Atom, +Term, +Goal, +List)
sys_cell_bind_opts(Elem, Type, Para, Goal, Opts) :-
   sys_event_opts(Opts, 0, Flags),
   ir_cell_bind(Elem, Type, Para, Goal, Flags).

/*******************************************************************/
/* DOM Helper                                                      */
/*******************************************************************/

/**
 * The predicate succeeds in C with the cursor.
 */
% ir_cell_current(-Element)
ir_cell_current(Elem) :-
   current_output(Stream),
   ir_object_current(Stream, 'data', H),
   ir_object_current(H, 'data', Elem).

/**
 * The predicate succeeds. As side effect the cursor changes to C.
 */
% ir_cell_set(-Element)
ir_cell_set(Elem) :-
   current_output(Stream),
   ir_object_current(Stream, 'data', H),
   ir_object_set(H, 'data', Elem).

% ir_cell_bind(+Element, +Atom, +Term, +Goal, +Integer)
ir_cell_bind(Elem, Type, Para, Goal, Flags) :- Flags /\ 2 =\= 0, !,
   sys_frost_horn((''(Para) :- Goal), 0, Native),
   sys_cell_wait_promise(Elem, Type, Native, Flags, Q),
   '$YIELD'(Q).
ir_cell_bind(Elem, Type, Para, Goal, Flags) :-
   sys_frost_horn((''(Para) :- Goal), 0, Native),
   sys_cell_add_listener(Elem, Type, Native, Flags).

/*******************************************************************/
/* Listen Options                                                  */
/*******************************************************************/

/**
 * sys_event_opts(L, F, G):
 * The predicate succeeds in G with the options L starting with defaults F.
 */
% sys_event_opts(+List, +Integer, -Integer)
sys_event_opts(V, _, _) :- var(V),
   throw(error(instantiation_error,_)).
sys_event_opts([X|L], I, O) :- !,
   sys_event_opt(X, I, H),
   sys_event_opts(L, H, O).
sys_event_opts([], H, H) :- !.
sys_event_opts(L, _, _) :-
   throw(error(type_error(list,L),_)).

% sys_event_opt(+Option, +Integer, -Integer)
sys_event_opt(V, _, _) :- var(V),
   throw(error(instantiation_error,_)).
sys_event_opt(capture(B), F, G) :- !,
   sys_opt_boolean(B, 1, F, G).
sys_event_opt(block(B), F, G) :- !,
   sys_opt_boolean(B, 2, F, G).
sys_event_opt(O, _, _) :-
   throw(error(domain_error(event_option,O),_)).

/*************************************************************/
/* Notebook Support                                          */
/*************************************************************/

/**
 * instrument_elem(E):
 * The predicate succeeds. As a side effect it instruments the element E.
 */
% instrument_elem(+Element)
instrument_elem(E) :-
   colorize_elem(E),
   ir_cell_bind(E, 'input', _, notify_elem(E), 0).

% notify_elem(+Element)
notify_elem(E) :-
   ir_object_current(E, is_dirty, T), !,
   timer_cancel(T),
   call_later(mirror_elem(E), 1000, S),
   ir_object_set(E, is_dirty, S).
notify_elem(E) :-
   call_later(mirror_elem(E), 1000, S),
   ir_object_set(E, is_dirty, S).

% mirror_elem(+Element)
mirror_elem(E) :-
   ir_object_reset(E, is_dirty),
   colorize_elem(E).

/**
 * colorize_elem(E):
 * The predicate succeeds. As a side effect it colorizes the element E.
 */
% colorize_elem(+Element)
colorize_elem(E) :-
   ir_selection_current(E, F, T), !,
   ir_object_current(E, 'innerText', A),
   fancy_atom(A, B, []),
   ir_object_set(E, 'innerHTML', B),
   ir_selection_set(E, F, T).
colorize_elem(E) :-
   ir_object_current(E, 'innerText', A),
   fancy_atom(A, B, []),
   ir_object_set(E, 'innerHTML', B).

/****************************************************************/
/* Error Texts                                                  */
/****************************************************************/

% strings(+Atom, +Atom, -Atom)
:- multifile(strings/3).
strings('domain_error.event_option', de, 'Eventoption erwartet, gefunden ~q.').

strings('domain_error.event_option', '', 'Event option expected, found ~q.').

/*******************************************************************/
/* Foreign Predicates                                              */
/*******************************************************************/

% ir_cell_goto(I, E):
% defined in foreign(misc/emitlib)

% sys_cell_add_listener(E, T, N, F):
% defined in foreign(misc/emitlib)

% sys_cell_wait_promise(E, T, N, F, Q):
% defined in foreign(misc/emitlib)

% dom_prevent_default(E):
% defined in foreign(misc/emitlib)

% dom_stop_propagation(E):
% defined in foreign(misc/emitlib)

:- ensure_loaded(foreign(misc/emitlib)).
