1:- module(webcla, []).
    5:- use_module(pac('expand-pac')).    6:- use_pac(web).    7% :- expects_dialect(pac).
    8term_expansion --> pac:expand_pac.
    9:- use_module(pac(op)).   10
   11:- set_prolog_flag(unknown, fail).%
   12%%%% Code for Printing  %%%%%
   13
   14dir_path(deldel). % directory for temporary files  .pdf .png .bb  etc
   15
   16file_name(cla).  % file name without extension.
   17
   18
   19% ?- Text= [command=`theory([bird, fly], [[bird] =>	[fly]])`, radioButton=`pdf`],
   20%  web:run_cgi( `(peek([@command, @radioButton]), maplist(herbrand_in_context),(eh:apply3(ifmap:theory_to_cla_html)), (basic:smash), through)`,
   21%	Text).
   22%% theory to cla [2015/10/30]
   23theory_to_cla_html(X,T,URL):- dir_path(D),  % T: output type
   24	file_name(F),
   25	phrase((eh:counter(check), eh:counter(update), obj_get([count(C)])),
   26	       [directory(D), counter_name(atm_cur_id)],  _),
   27	format(codes(OutHtml), "~w/~w~w.html", [D, F, C]),
   28	snap(c),
   29	tyeory_to_cla_html(F, D, C, X, T, Body),
   30	snap(d),
   31	flatten(["<html><body>\n", Body, "</body></html>"], H1),
   32	atom_codes(OutNameAtom, OutHtml),
   33	create_file(OutNameAtom, H1),
   34	eh:expand_cgi_path(OutHtml, URL).
   35
   36
   37%
   38theory_to_cla_html(F,D,C,R,T,H) :-
   39	regex_am(R, coa(A, Ini)),
   40	am_finals(coa(A, _), Fin),
   41	length(A, Num),
   42 	coalgebra_triples(A, M),
   43 	automaton_quasi_string(am(M, Ini, Fin), Quasi_String),
   44	maplist(pred([U-_, U]), A, S),
   45	H1 = (format_codes(`<p>Regular expression = ~w</p>`,[R]) &
   46	format_codes(`<p> The number of states = ~d</p>`,[Num]) &
   47	format_codes(`<p> Initial state = ~w</p>`,[Ini]) &
   48	format_codes(`<p> Final states = ~w</p>`,[Fin]) &
   49	format_codes(`<p> All states = ~w</p>`,[S]) &
   50	format_codes(`<p> State Transitions:</p>~n`,[])),
   51	atomic_list_concat([D, '/', F, C, '.dot'], DotName),
   52 	file(DotName, write, smash(Quasi_String)),
   53	formatForHtml(F,D,C,T,Format,Args),			% call sh from inside
   54	hybrid_print_moves(M, M1),
   55	format_codes_list(H1 & format_codes(Format,Args) & M1, L, []),
   56	!,
   57	append(L, H).
   58
   59formatForHtml(F,D,C,X,Format,[F,C,X]) :-
   60        img_frame(Format),
   61        atomic_list_concat([D, (/), F, C], Base),
   62	once(option_table(X, Opt, Ext0, Ext1)),
   63     (  X == pdf
   64     -> Com = ps2pdf(`-sOutputFile=`+ Base+ `.`+ Ext1,
   65		     Base+ `.`+ Ext0)
   66     ;  Com = 'DUMMY=1'
   67     ),
   68         once(eh:sh(dot(-'T'(Opt), Base+ `.` + dot,
   69		  -o(Base + `.` + Ext0)); Com)).
   70
   71img_frame(X) :- flatten([ `<p><div `,
   72	  `id='diagram' `,
   73	  `style='border : solid 2px #ff0000; `,
   74	  `width : 1600px; `,			% was 600px
   75	  `height : 500px; `,			% was 300px
   76	  `overflow : auto; '><br/>`,
   77	  `<img src="~w~w.~w"/>`,
   78	  `</div></p>~n`
   79	 ], X).
   80
   81% ?- coalgebra:hybrid_print_moves([(1, [97-97], 2)], R).
   82
   83hybrid_print_moves(M, H):-
   84	maplist(pred([(X, A, Y), (X, B, Y)]:-
   85	       maplist(interval_code_char, A, B)),
   86		M, M0),
   87	print_moves(M0, H).
   88
   89%
   90print_moves(M, H):-
   91	maplist(print_moves_x, M, T),
   92	flatten(T, T1),
   93	flatten(["<pre>\n", T1, "</pre>\n"], H).
   94
   95print_moves_x((X,A,Y), H):-
   96	format_codes(`   ~w----~w--->~w~n` , [X,A,Y], H)