/*
	ニューラルネットワークを使った文字認識サンプルプログラム
	
	| ?-[-'font.pl'].
	yes
	| ?-top_level.

	５＊７のフォントパターンの認識（Ａ，Ｂ，Ｃのみ）
      *→ 5
      ↓--------------------------
      7 | 01 | 02 | 03 | 04 | 05 |
        --------------------------
        | 06 | 07 | 08 | 09 | 10 |
        --------------------------
        | 11 | 12 | 13 | 14 | 15 |
        --------------------------
        | 16 | 17 | 18 | 19 | 20 |
        --------------------------
        | 21 | 22 | 23 | 24 | 25 |
        --------------------------
        | 26 | 27 | 28 | 29 | 30 |
        --------------------------
        | 31 | 32 | 33 | 34 | 35 |
        --------------------------
        
	［処理内容］
	　１．　Ａ，Ｂ，Ｃの８１個のフォントパターンを学習させる。
	　２．　実際にパターンを入力して検証する。
	　３．　どのようなパターンを学習させたかを確認する。
	  ４．　学習済みのデータを読み込む。

	学習用データファイル：mojidata.pl

	Used Builtin Pred : ニューラルネットワーク操作用述語
		create_neuron/4
		learn_neuron/6
		save_neuron/2
		load_neuron/2
		inference_neuron/3

	Used Builtin Pred : アレイ操作用述語
		create_array/2
		set_array/3
		get_array/3

*/

:- [-'mojidata.pl'].	/* 学習用データファイルの読み込み　*/

:- s_mode(_,on).

%%%
%%%	top_level/0
%%%

top_level :- 
	initialize,repeat,top_level_menu(Com),
	top_level_command(Com),Com==13,!.

%%%
%%%	top_level_menu/1
%%%

top_level_menu(Com):-
	d_clear,get_display_pos(X,Y),
	poswrite(X,Y,'**** 文字認識サンプルプログラム ****'),
	poswrite(X,Y+2,'[1] Ａ,Ｂ,Ｃのフォントパターンを学習'),
	poswrite(X,Y+3,'[2] パターンを入力して推論'),
	poswrite(X,Y+4,'[3] 学習させたパターンを確認する'),
	poswrite(X,Y+5,'[4] 学習済みデータの読み込み'),
	poswrite(X,Y+6,'入力してください(リターンキーのみ入力で終了):'),
	d_keyin(Com),ttyput(Com).

%%%
%%%	top_level_command/1
%%%

top_level_command(13) :- !.
top_level_command(0'31) :- moji_learning,!,fail.
top_level_command(0'32) :- inference_font,!,fail.
top_level_command(0'33) :- learn_font_disp,!,fail.
top_level_command(0'34) :- load_font_data,!,fail.
top_level_command(_) :- ttyput(7),ttyput(7),fail.

initialize :- 
	abolish('$_array',1),abolish('$_neuron',4),abolish(learned,0),
	e_register(0,_,0),	/* Editor X pos */
	e_register(1,_,0),	/* Editor Y pos */
	e_register(2,_,15),	/* Display X Pos */
	e_register(3,_,7).	/* Display Y Pos */

get_display_pos(X,Y) :-	e_register(2,X,X),e_register(3,Y,Y).

poswrite(X,Y,A) :- d_cursor(X,Y),write(A).

%%%
%%%	moji_learning/0
%%%

moji_learning :- 
	get_neuron_object(35,10,3,Neuron),
	d_clear,get_display_pos(X,Y),
	poswrite(X,Y,'学習中....暫くお待ちください'),nl,
	learn_neuron(Neuron,data,2,1,2,_),
	d_clear,
	poswrite(X,Y,'学習データをファイル名"abcfont"で保存します。'),
	save_neuron(Neuron,abcfont),learn_check,
	poswrite(X,Y+1,どれかのキーを押してください),d_keyin(_).

learn_check :- learned,!.
learn_check :- assert(learned).

%%%
%%%	inference_font/0
%%%

inference_font :- 
	d_clear,learned,repeat,
	font_editor(FontList),
	get_neuron_object(35,10,3,Neuron),
	inference_neuron(Neuron,FontList,IFL),
	get_abc(IFL),get_cmd(Com),Com==9,!.

inference_font :-
	get_display_pos(X,Y),
	poswrite(X,Y,学習データがありません！！),ttyput(7),s_sleep(1).

get_abc(IFL):-
	get_abc1(IFL,[Ａ,Ｂ,Ｃ],Result),
	!,
	get_display_pos(X,Y),poswrite(X+15,Y+7,結論(Result)),d_cleol.

get_abc(_) :-
	get_display_pos(X,Y),
	poswrite(X+15,Y+7,該当パターンが見つかりません),d_cleol.

get_abc1([A|_],[B|_],B) :- A > 0.9,!.
get_abc1([_|R],[_|L],F) :- get_abc1(R,L,F).

get_cmd(Com) :- 
	get_display_pos(X,Y),
	poswrite(X+15,Y+8,終了はTABキー続行ならば他のキー),
	d_keyin(Com),d_cursor(X+15,Y+7),d_cleol,d_cursor(X+15,Y+8),d_cleol.
%%%
%%%	learn_font_disp/0
%%%

learn_font_disp :- 
	d_clear,get_display_pos(X,Y),
	poswrite(X+15,Y,学習用データを表示します。),
	poswrite(X+15,Y+1,中止はTabキー、続行ならば他のキー),
	data(FontList,_),font_disp(5,FontList,'[Font Disp]'),
	d_keyin(Com),Com == 9,!.

learn_font_disp.

%%%
%%%	load_font_data/0
%%%

load_font_data :-
	d_clear,get_display_pos(X,Y),
	poswrite(X,Y,学習済みのデータを読込ます。),
	get_neuron_object(35,10,3,Neuron),load_neuron(Neuron,abcfont),
	poswrite(X,Y+1,読込が終了しました。キーを押してください。),
	learn_check,d_keyin(_).

%%%
%%%	font_editor/1
%%%

font_editor(FontList) :-
	get_array_object(35,Array),
	get_display_pos(X,Y),
	poswrite(X+15,Y,'TABキーで推論実行'),
	poswrite(X+15,Y+1,'         ↑'),
	poswrite(X+15,Y+2,'         8'),
	poswrite(X+15,Y+3,'   ← 4     6 →'),
	poswrite(X+15,Y+4,'         2'),
	poswrite(X+15,Y+5,'         ↓'),
	poswrite(X+15,Y+6,リターンキーで決定),
	repeat,
	get_font_list(Array,0,35,FontList),
	font_disp(5,FontList,'[Font Editor]'),
	command(5,7,Array,Com),Com==9,!.

%%%
%%%	get_neuron_object/4
%%%

get_neuron_object(I,M,O,Neuron) :- '$_neuron'(I,M,O,Neuron),!.
get_neuron_object(I,M,O,Neuron) :-
	create_neuron(I,M,O,Neuron),assert('$_neuron'(I,M,O,Neuron)).

%%%
%%%	get_array_object/2
%%%

get_array_object(N,Array) :- '$_array'(N,Array),!,clear(N,0,Array).
get_array_object(N,Array) :- create_array(N,Array),assert('$_array'(N,Array)).

clear(N,N,_) :- !.
clear(N,M,Array) :- set_array(Array,M,0),M1 is M+1,clear(N,M1,Array).

%%%
%%%	font_disp/5
%%%

font_disp(Width,FontList,Message) :-
	get_display_pos(X,Y),
	d_cursor(X,Y-1),write(Message),font_disp1(Width,0,X,Y,FontList).

%%%
%%%	font_disp1/4
%%%

font_disp1(_,_,_,_,[]) :- !.
font_disp1(W,N,X,Y,[D|R]):-
	write_font(D,X,Y,N,W),N1 is N+1,font_disp1(W,N1,X,Y,R).

write_font(0.0,X,Y,N,W):- !,d_cursor(X+(N mod W)*2,Y+N/W),write(・).
write_font(1.0,X,Y,N,W):- d_cursor(X+(N mod W)*2,Y+N/W),write(● ).

%%%
%%%	ed_cursor/0
%%%

ed_cursor :- 
	e_register(0,A,A),e_register(1,B,B),
	get_display_pos(X,Y),
	d_cursor(X+A*2,Y+B).

%%%
%%% 	command/3 
%%%

command(X,Y,Array,Com) :- 
	repeat,ed_cursor,d_keyin(Com),command1(X,Y,Array,Com),!.

%%%
%%% 	command1/4
%%%

command1(X,Y,Array,9) :- !.		/*  End   */

command1(X,Y,Array,13) :- 		/*  Enter */
	!,
	e_register(0,A,A),e_register(1,B,B),
	C is A+B*X,get_array(Array,C,N),N1 is 1-N,set_array(Array,C,N1).

command1(X,Y,Array,0'32) :- 		/*  Down  */
	e_register(1,A,A+1),!,A+1=:=Y,e_register(1,_,0),fail.

command1(X,Y,Array,0'34) :- 		/*  Left  */
	e_register(0,0,0),!,e_register(0,_,X-1),fail.
command1(X,Y,Array,0'34) :- e_register(0,A,A-1),!,fail.

command1(X,Y,Array,0'36) :-		/*  Right */
	e_register(0,A,A+1),!,A+1=:=X,e_register(0,_,0),fail.

command1(X,Y,Array,0'38) :- 		/*  Up   */
	e_register(1,0,0),!,e_register(1,_,Y-1),fail.
command1(X,Y,Array,0'38) :- e_register(1,A,A-1),fail.


%%%
%%%	get_font_list/4
%%%

get_font_list(_,N,N,[]) :- !.
get_font_list(Array,N,M,[F|R]) :-
	get_array(Array,N,D),
	F is float(D),N1 is N+1,get_font_list(Array,N1,M,R).

:- s_mode(_,off).
