% #! prologcgi

:-s_charset(_,utf8).
:- publicall.
:- extern det:write_listnl/1.
:- extern html_call/1.
:- extern det:get_param/2.
:- extern det:atom_appends/2.
:- extern det:my_system_name/1.
:- extern rexpl/3.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 処理スピードの差異を確認するため、インタプリタＣＧＩ、バイトコードＣＧＩ、フルコンパイルコードＣＧＩの３通りのデモをみることができます。
%% 結果出力部分はほとんど違いはでませんので、ラジオボタンを「計算のみ」にチェックして実行秒数をお計りください。
%% なお、各コードの元ソースからの生成方法は以下です。(フルコンパイルにはＣコンパイラの設定、ＡＺのインストール先によってＤＩＲ指定変更がなどが必要です）
%%
%% インタプリタ版(queens.cgi)：　　このソースをインクルード
%% バイトコード版(queenb.cgi)：　　このソースをバイトコンパイルしたものをb_load 
%%         >azpc -utf8 -p queens.pl /byte
%% フルコンパイル版(queens , queens.exe)：　フルコンパイルししたもの
%%         >azpc -utf8 -p queens.pl /ncc && azpc -p queens.c $(AZProlog)/system/pl/utility.pl $(AZProlog)/system/pl/prologcgi.pl /fast /e queens /no /dcurses
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

top_call:-    
    get_type(Pttxt,Me,Type,Max),
    get_number(Max,N),             %% 呼び出し引数を取得する
    get_disp_check(D),
    html_call([
    "Content-Type: text/html; charset=utf-8

     <html><head><meta http-equiv='Content-Type' content='text/html; charset=utf-8'></head>
     <body><center><H1>Hello Prolog World!  <<",N," Queens!!(",Type,")>></H1>",Pttxt,
       "<br>サーバー負荷軽減のため、デモでは",Max,"クイーン以下としてください
         <form action='",Me,"' method='GET'>
            <input type='text' name='num' value='",N,"' size='2'>Queens　【
            <INPUT TYPE='radio' NAME='disp' VALUE='true' CHECKED>結果表示
            <INPUT TYPE='radio' NAME='disp' VALUE='fail'>計算のみ】
            <input type='submit'>
        </form>
     <INPUT TYPE='button' VALUE='RETURN' onClick='history.back()'><br><br>
     <font size=8><h3>",
        call(q(N,D)),            %% Prolog Call Ｎクイーンの解を出力する
    "</h3></font></center></body></html>" ]).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
get_number(Max,N):- get_param(num,N),integer(N),N =< Max,!.                    % queens.cgi?num=5&disp=true
get_number(Max,Max).

get_disp_check(D):-get_param(disp,D),!.
get_disp_check(true).

%%%% 起動後、自分の実行モデル（インタプリタ、バイトコード、フルコンパイルコード）を切り分ける
get_type(Putt,Me,Type,Max):-
    my_cgi_name(FullMe),!,         % これは組込み述語ではなくインタプリタがＣＧＩを読み込んだときにアサートされるファイル名を引数とする単位節
    del_prefix(FullMe,Me),
    atom_appends(['<a href="puttxt.exe?',Me,'" target="source">このページのソース表示</a><br>'],Putt),
    get_type(Type,Max).

get_type('',A,'FullCompiledCode',12):-
    my_system_name(X),             % C 言語の argv[0]に相当
    del_prefix(X,A).

get_type('InterpreterCode',10):- clause('___$module$___',7,0),!.   % バイトコードモジュールの定義フレームがない（節数がゼロ）
get_type('ByteCode',12).

del_prefix(X,A):-rexpl(X,"[^\\^/]+$",Y),!,name(A,Y).      % 'c:\apache2.2\cgi-bin\queens.exe' から 'queens.exe' を切り出す

%%%%%%%%%%%%%%%%%%%%%%%
q(N,D):-
    write('<table  border="2" cellpadding="3" cellspacing="0" width="95%"><tr>'),  %% Html Table Begin
    nl,
    generate(N,List),
    e_register(1,_,1),                     %% 大域数値変数１に1をセット(番号表示用）
    X is cputime,
    queen(List,D),
    Y is cputime-X,
    write('</tr></table>'),nl,
    e_register(1,X0,X0),XX is X0-1,
    nl,write('Solution'=XX),hnl,
    nl,write(Y),write(' seconds'),nl.
    
queen(List,true):-                          %% 結果表示バージョン
    put(List,[],L),                         %% 解を得る
    nl,e_register(1,N,N+1),
    write_listnl(['<td> No.',N,'<br>']),    %% 番号表示 カウントアップ
    disp(L),                                %% 解を表示する
    write('</td>'),
    ( 0 is N mod 5 -> write('</tr><tr>');true),
    fail.                                   %% 別解を求めてFailする

queen(List,fail):-                          %% 結果非表示バージョン
    put(List,[],L),                         %% 解を得る
    e_register(1,N,N+1),
    fail.

queen(_,_).

%%%%%%%%%%%%%%%%%%%%%%%%%%%
generate(0,[]):-!.
generate(N,[N|L]):- M is N-1,generate(M,L).

%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% put(要素リスト,既置リスト,答え).
put([],L,L):-!.        % 初期リストが空なら、既置リストが結果リストである
put(S,L,Ans):-
  select(S,A,B),       % 初期リストから要素を一つ取り出す。取り出した残りリストがＢ
  safe(A,A,L),         % これが今までに置いたものと衝突しないか調べる
  put(B,[A|L],Ans).    % 取り出した要素を既置リストに加え残りリストを更に置く

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%  Generate
%% リストから要素を一つ選ぶ。それを省いたリストを得る  < 非決定性
select([A|B],A,B).                % 先頭は要素である。
select([A|B],S,[A|L]):-           % 先頭以外からの要素も要素である
  select(B,S,L).

%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%   Test
%% 安全に置けるかテストする
safe(_,_,[]):-!.        % テスト対象が空なら真（True）
safe(A,B,[C|D]):-       % テスト対象の最初の既置位置(C)が
  AA is A-1,AA \==C,    % 新要素の左下が既置位置と衝突しない
  BB is B+1,BB \==C,    % 新要素の右下が既置位置と衝突しない
  safe(AA,BB,D).        % 残りの既置位置が衝突しない

/*
?-safe(2,2,[4,3,5]).    % (2-1\==4) & (2+1\==4) 
    safe(1,3,[3,5]).    % (1-1\==3) & (3+1\==3) 
      safe(0,4,[5]).    % (0-1\==5) & (4+1\==5) FAIL

 2       □？□□□
[4,      ＊□＊Ｑ□      (2-1) \==4 かつ (2+1) \==4 なので True
 3,    ＊□□Ｑ＊□      (2-1)-1 \==3 かつ (2+1)+1 \==3 なので True
 5]  ＊  □□□□Ｑ      (2-1)-1-1 \==5 だが (2+1)+1+1 ==5 なので Fail

*/

%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% 結果を表示する(To Man InterFace)
disp(L):-            % 結果リストＬを表示する
    length(L,N),    % リスト長（要素数）がＮ
    disp(N,L).        % NxNの盤面に結果リストを表示する


disp(_,[]):-!.                    % 要素なしは表示しない（全要素を表示した。終了条件）
disp(Leng,[A|L]):-                % 結果リストの先頭行を表示する
    S is A-1,tabs(S),             % 要素位置の前まで空升目を表示
    write('Ψ'),                  % Ｑｕｅｅｎを置いたことを表示
    R is Leng-A, tabs(R),hnl,     % 行末まで空升目を表示
    disp(Leng,L).                 % 次の行を表示

tabs(0):-!.
tabs(N):-write('□'),NN is N-1,tabs(NN).

hnl:-write('<br>'),nl.
