Prolog "magicslate"

Admin User, erstellt 02. Apr. 2024
         
/**
* 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('../example22/problems.p').
:- ensure_loaded('../example22/sudoku_shuffle.p').
:- ensure_loaded('opening_uniform.p').
% :- ensure_loaded('opening_binom.p').
:- ensure_loaded(library(misc/react)).
:- ensure_loaded(library(util/format)).
:- ensure_loaded(library(aggregate)).
% main
main :-
between(1, 9, Y),
between(1, 9, X),
make_mark_id(Y, X, I),
dom_cell_goto(I, C),
bind(C, 'click', E, mark(E)),
fail.
main :-
between(0, 9, N),
make_digit_id(N, I),
dom_cell_goto(I, C),
bind(C, 'click', E, digit(E)),
fail.
main :-
dom_cell_goto('undo', C),
bind(C, 'click', E, undo(E)),
fail.
main :-
dom_cell_goto('redo', C),
bind(C, 'click', E, redo(E)),
fail.
main :- reset.
/*******************************************************************/
/* Board Logic */
/*******************************************************************/
% reset
reset :-
set_text('status', 'Erstellen'),
opening(N), set_board(N, 1), info.
% info
info :-
problem(0, M), get_board(M, 1),
info2(M).
% info2(+Matrice)
info2(M) :-
\+ sudoku(M, [], _), !,
set_text('status', 'Fehlerhaft.').
info2(M) :-
aggregate_all(count, (member(X, M), member(Y, X), var(Y)), C),
info3(C).
% info3(+Integer)
info3(0) :- !,
set_text('status', 'Geschafft').
info3(C) :-
format_atom('Noch ~d Züge', [C], A),
set_text('status', A).
/*******************************************************************/
/* Undo Redo */
/*******************************************************************/
% current_undo(-Term)
:- dynamic current_undo/1.
% current_redo(-Term)
:- dynamic current_redo/1.
% undo(+Event)
undo(_) :-
retract(current_undo(action(I,B))), !,
do(I, B, A),
asserta(current_redo(action(I,A))),
info.
% redo(+Event)
redo(_) :-
retract(current_redo(action(I,A))), !,
do(I, A, B),
asserta(current_undo(action(I,B))),
info.
% do(+Atom, +Atom, -Atom)
do(I, A, B) :-
get_text(I, B),
set_text(I, A).
/*******************************************************************/
/* Digit Mark */
/*******************************************************************/
% mark(+Event)
mark(E) :-
ir_object_current(E, 'target', C),
ir_object_current(C, 'id', I),
get_style(I, 'color', 'black'),
mark2(I, A),
retractall(current_redo(_)),
do(I, A, B),
asserta(current_undo(action(I,B))),
info.
% mark2(+Atom, -Atom)
mark2(I, '') :- current_digit(0), !,
\+ get_text(I, '').
mark2(I, A) :-
get_text(I, ''),
current_digit(N),
atom_number(A, N).
% make_mark_id(+Integer, +Integer, -Atom)
make_mark_id(K, N, I) :- var(K), var(N), !,
atom_codes(I, [K2,N2]),
K is K2-96,
N is N2-48.
make_mark_id(K, N, I) :-
K2 is K+96,
N2 is N+48,
atom_codes(I, [K2,N2]).
/*******************************************************************/
/* Digit Choice */
/*******************************************************************/
% current_digit(-Integer)
:- dynamic current_digit/1.
current_digit(1).
% digit(+Event)
digit(E) :-
ir_object_current(E, 'target', C),
ir_object_current(C, 'id', I),
make_digit_id(N, I),
update_digit(N).
% update_digit(+Integer)
update_digit(M) :-
retract(current_digit(N)), !,
make_digit_id(N, I),
set_style(I, 'background', 'transparent'),
assertz(current_digit(M)),
make_digit_id(M, J),
set_style(J, 'background', 'lightgrey').
% make_digit_id(+Integer, -Atom)
make_digit_id(N, I) :- var(N), !,
atom_codes(I, [0'n, N2]),
N is N2-48.
make_digit_id(N, I) :-
N2 is N+48,
atom_codes(I, [0'n, N2]).
/*******************************************************************/
/* Populate Board */
/*******************************************************************/
/**
* set_board(M, N):
* The predicate succeeds. As a side effect the board is populated
* with the matrice M, starting at row N.
*/
% set_board(+Matrice, +Integer)
set_board([], _).
set_board([H|T], N) :-
set_board_row(H, 1, N),
M is N+1,
set_board(T, M).
% set_board_row(+List, +Integer, +Integer)
set_board_row([], _, _).
set_board_row([H|T], N, K) :-
make_mark_id(K, N, I),
(var(H) ->
S='', C = 'black', P = 'pointer';
atom_number(S, H), C = 'grey', P = 'default'),
set_text(I, S),
set_style(I, 'color', C),
set_style(I, 'cursor', P),
M is N+1,
set_board_row(T, M, K).
% get_board(+Matrice, +Integer)
get_board([], _).
get_board([H|T], N) :-
get_board_row(H, 1, N),
M is N+1,
get_board(T, M).
% get_board_row(+List, +Integer, +Integer)
get_board_row([], _, _).
get_board_row([H|T], N, K) :-
make_mark_id(K, N, I),
get_text(I, S),
(S = '' -> H = _; atom_number(S, H)),
M is N+1,
get_board_row(T, M, K).
/*************************************************************/
/* Browser Access */
/*************************************************************/
% get_text(+Atom, +Atom)
get_text(I, W) :-
dom_cell_goto(I, C),
ir_object_current(C, 'innerText', W).
% set_text(+Atom, +Atom)
set_text(I, W) :-
dom_cell_goto(I, C),
ir_object_set(C, 'innerText', W).
% get_style(+Atom, +Atom, +Style)
get_style(I, K, W) :-
dom_cell_goto(I, C),
ir_object_current(C, 'style', S),
ir_object_current(S, K, W).
% set_style(+Atom, +Atom, +Atom)
set_style(I, K, W) :-
dom_cell_goto(I, C),
ir_object_current(C, 'style', S),
ir_object_set(S, K, W).
/*************************************************************/
/* Main Initialization */
/*************************************************************/
:- initialization(main).