calcdlg.pro

利用人工智能程序设计语言prolog编程实现的公式计算软件源代码。

	lbox_Add(LboxWin, 0, FNameList),
%	lbox_SetSel(LboxWin, 0, 1),
	%formula control:
%	f("直接计算",Formu1,CommentList1,VarList),
%	f(_Name,Formu1,CommentList1,VarList),!,
	F_win= win_GetCtlHandle(_Win, idc_edit_finput),
	set_win_textlist_Loop(F_win,  [""]),
	win_SetEditCtlReadOnly(F_win,1),
	%comments control:
%	CommentList1=[Cm|CommentList2],
%	slist_strplus(CommentList2, "\n",Cm, "请选择公式进行计算。"),
	Comwin= win_GetCtlHandle(_Win, idc_edit_fcommts),
	Commentstr= "请选择公式进行计算。",
	set_win_textlist_Loop(Comwin, [Commentstr ]),
	win_SetEditCtlReadOnly(Comwin,1),
	%input edit win
%	VarList=[Var|RVarList],
%	slist_strplus(RVarList, "=\n",Var, VarStr),
	edit_win(EditWin),
	edit_PasteStr(EditWin, ""),
%	win_setFocus(EditWin),
%	edit_LineEnd(EditWin),
	!.
	
	
%%end: initiate the formula window	
%%begin: set textlist to  a window control 
set_win_textlist_Loop(_Win, []):-
	!.
set_win_textlist_Loop(_Win, [Str|RList]):-
	win_setText(_Win, Str),!,
	set_win_textlist_Loop(_Win, RList).
%%begin: set textlist to  a window control 


%%%begin:convert a strlist to a string by adding additional str after each element
slist_strplus([], AddStr, TOutStr,Outstr):-
	concat(ToutStr, AddStr,Outstr),!.
slist_strplus([Str|RList], AddStr, TOutStr,OutStr):-
	format(NTOutStr,"%-%-%-",TOutStr, AddStr,Str),!,
	slist_strplus(Rlist, AddStr, NTOutStr,Outstr).
%%%end:convert a strlist to a string by adding additional str after each element


%%%get var value one by one from editwin 
PREDICATES
get_line(WINDOW Editwin, string Line,real VarSeq)-(i,o,i)
extract_varValue(string Line,real VarSeq,real VarVal)

CLAUSES
/*
get_varValue(_EditWin,N,TN,[],[],[]):-
	TN=N-1,
%	write("total var num=", Tn),nl,
	!.	
get_varValue(EditWin, TVarNum,VarSeq,[Var|RVarList],VarValueList,VarValueSList):-
	NTVarNum=TVarNum+1,
	get_varValue(EditWin, NTVarNum,VarSeq,RVarList,TVarValueList,TVarValueSList),
	LineSeq=TVarNum,
	get_line(Editwin, Line,LineSeq),
	edit_lineEnd(EditWin),
	extract_varValue(Line,LineSeq,VarVal),
	%put to db:
	retractall(var_value(LineSeq,Var, _)),
	assert(var_value(LineSeq,Var, VArVal)),
%	write("assert var ", Var, "=", VarVal),nl,
	str_real(VArValStr,VarVal),
	VarValueSList=[VarValStr|TVArValueSList],
	VarValueList=[VarVal|TVArValueList],
	!.
*/
%get_varValue(_EditWin,0,[],[]):-
%	write("total var num=", 0),nl,
%	!.	
get_varValue(EditWin, VarValueList,VarValueSList,OutVarList):-
	retract(getval_rec(TVarNum,OldVarList,TVarValueList,TVarValueSList,TVarList)),
	OldVarList=[Var|RVarList],
%	NTVarNum=TVarNum+1,
%	get_varValue(EditWin, NTVarNum,VarNum,RVarList,TVarValueList,TVarValueSList),
	LineSeq=TVarNum,
%	write("LineSeq=",TVarNum),nl,
	get_line(Editwin, Line0,LineSeq),
	edit_lineEnd(EditWin),
	%in windows 98 ,Line0="A1=21\r", so need to delete \r
	concat(Line,"\r",Line0),
	extract_varValue(Line,LineSeq,VarVal),	
%	write("extract from ", Line, ", VarVal=",VarVal),nl,
	%put to db:
	retractall(var_value(LineSeq,Var, _)),
	assert(var_value(LineSeq,Var, VArVal)),
%	write("assert var ", Var, "=", VarVal),nl,
	str_real(VArValStr,VarVal),
	NTVarValueSList=[VarValStr|TVarValueSList],
	NTVarValueList=[VarVal|TVArValueList],
	NTVarList=[Var|TVarList],
	NTVarNum=TVarNum+1, %actually is the line seqS
	assert(getval_rec(NTVarNum,RVarList,NTVarValueList,NTVarValueSList,NTVarList)),
%	write("RVarList=",RVarList),nl,
	RVarList=[],
%	NTVarNum=0,
%	VarNum=TVarNum,
	VarValueList=NTVarValueList,
	VarValueSList=NTVarValueSList,
	OutVarList=NTVarList,
%	write("here, OutVarList=", OutVarList,",VarValueList=",VarValueList, ", VarValueSlist=", NTVarValueSlist),nl,
	retractall(getval_rec(_,_,_,_,_)),
	!.
get_varValue(EditWin, [],[],[]):-
	win_setfocus(EditWin),
	fail.
%%get a line according to line seq
get_line(_win, Line,LineSeq):-
	edit_GotoLine( _Win,LineSeq),
%	write("gone to Line=", LineSeq),nl,
	edit_SelectCurLine(_Win),
	edit_GetSelection(_Win, Pos1, Pos2),
%	write("selected pos1=", Pos1,", Pos2=",Pos2),nl,
	edit_Copy(_Win),
	Line0=cb_GetString(),
	Length=Pos2-Pos1, %this will del the enter chars
	frontstr(Length,Line0,Line,_RestString),
%	dlg_note("line", Line),
	!.
	
	
get_line(_win, _Line,LineSeq):-
	format(Msg, "第%-行的变量未有数值。",LineSeq),
	beep,
	dlg_note(Msg),
	fail.
%%%get var value from the line in the editor
extract_varValue(Line,_VarSeq,VarVal):- %has "=" mark, get the str behind =
	searchstring(Line,"=", Pos),
%	write("line has = mark, at pos: ", Pos),nl,
	frontstr(Pos,Line,_StartString,VarValstr),
%	substring(Line,1,Pos,VarValstr),
%	write(" VarValstr=", VarValstr),nl,
	fronttoken(VarValStr,_,_),
	str_real(VarValStr,VarVal),
%	write("got ", _VarSeq, " 's varval=",VarVal),nl,
	!.
extract_varValue(Line,_VarSeq,VarVal):- %no "=" mark, may be deleted , only left values,
	str_real(Line,VarVal),
%	write("got ", _VarSeq, " 's varval=",VarVal),nl,
	!.
extract_varValue(Line,VarSeq,_VarVal):- %above failed.
	format(Msg, "这行输入有错：%-。找不到第%-个变量的值。", Line,VarSeq),
	dlg_note(Msg),
	fail.


%%%if item="直接计算，means user input an expr with all constants
what_calc(FormName,2):-%vars not fixed
	f(FormName,_,_,VarList),
	slist_strplus(VarList, "", "",Outstr),	
	not(fronttoken(Outstr,_,_)),
	searchstring(Outstr,"...", _),
	retractall(calc_info(_)),
	assert(calc_info(2)),
	!.
what_calc(FormName,1):-
	f(FormName,_,_,VarList),
	slist_strplus(VarList, "", "",Outstr),	
	not(fronttoken(Outstr,_,_)),
	retractall(calc_info(_)),
	assert(calc_info(1)),
	!.

what_calc(_Item,0):-
	retractall(calc_info(_)),
	assert(calc_info(0)),
	!.
	
%%%set focus according to YN, 1 or 0
set_focusYN(1, WHandle):-
	win_setFocus(WHandle),
	!.
set_focusYN(0, _WHandle):-!.

%%%set text to multiple controls
set_ctlText(_Pwin, [], _xt):-!.
set_ctlText(_Win, [CtlId|RList], Txt):-
	set_ctlText(_Win,RList, Txt),
	CtlWin=win_getCtlHandle(_Win, CtlId),
	win_setText(CtlWin,Txt).

%%%set control state to win multiple controls:
set_wins_state(_win, [],_CtlStateList):-!.
set_wins_state(_win, [Id|RList],CtlStateList):-
	set_wins_state(_win, RList,CtlStateList),
	CtlWin=win_getCtlHandle(_win, Id),
	win_SetState(CtLWin, CtlStateList).

/*%%%check if formulus contains vars specified
check_FVar(_Formulus,_NewVarList,VarStr):-
	not(fronttoken(VarStr,_,_)),
	!.
check_FVar(Formulus,NewVarList,_VarStr):-
	str_slist_member(Formulus, NewVarList, _Member, VarPos),
	VarPos<>0,
	!.
check_FVar(Formulus,_NewVarList,VarStr):-
	format(Msg,"公式\"%-\"不含变量：\"%-\", 请确认输入是否正确。", Formulus, VarStr),
	beep,
	dlg_note("啊", Msg),
	fail.
*/	
%%%begin: convert varstr to varlist, pay attention to "..."
/* get_newVarList(VarStr, OutVarList):- % not fixed vars, should add "..."
	searchstring(VarStr, "...", P1),
	L=P1-1,
	frontstr(L,VArStr,VarStr1,VarStr0),
	concat("...", VarStr2,VarStr0),
	convert_str_list(VarStr1,",",NewVarList1),
	convert_str_list(VarStr2,",",NewVarList2),
%	concat_slists(NewVarList1,["..."],OutVarList1), 
	concat_slists(NewVarList1,NewVarList2,OutVarList), 
	!.
get_newVarList(VarStr, OutVarList):- % other cases, just convert to str
	convert_str_list(VarStr,",",OutVarList),
	!.
%%%end: convert varstr to varlist, pay attention to "..."
*/
%%%begin: see if the form need expansion:
PREDICATES
go_expand(string OldFormu,integer N, string NewFormu,slist NewVarList)
check_N(string Msg,string NStr,integer N,symbol YN)

CLAUSES
get_NewFV(0, NewFormu,NewFormu,NewVarList,NewVarList,N):-%fixed var, no need to expand
	not(searchstring(NewFormu,"...", _)),
	slist_strplus(NewVarList, "", "",Outstr),	
	fronttoken(Outstr,_,_),
	retractall(calc_info(_)),
	assert(calc_info(0)),
	slist_length(NewVarList,N),
	!.
get_NewFV(2, OldFormu,NewFormu,OldVarList,NewVarList,N):- %var not fixed
	searchstring(OldFormu,"...", _),!,
	retractall(calc_info(_)),
	assert(calc_info(2)),
	format(Msg, "此公式\"%-\"是不定变量公式。现在需指定变量的个数：",
	             OldFormu),
	NStr=dlg_GetStr("输入",Msg,""),
	check_N(Msg,NStr,N1,YN),
	YN=ok,
	go_expand(OldFormu,N1, NewFormu,NewVarList0),
	concat_slists(NewVarList0,OldVarList, NewVarList), %if formu contains other vars
	slist_length(OldVarList,N2),
	N=N1+N2,
	!.

get_NewFV(1, Formu,Formu,VarList,VarList,0):-%direct calc, no var
%	not(fronttoken(Outstr,_,_)),
	edit_win(EDitWin),
	Pwin=win_getParent(EditWin),
	FWin=win_getCtlHandle(PWin, idc_edit_finput),
	win_SetEditCtlReadOnly(Fwin,0),
	retractall(calc_info(_)),
	assert(calc_info(1)),
	!.

%%%end: see if the form need expansion:

%%%begin: check input n:
check_N(_Msg,NStr,N,ok):-%ok, go to expand
	str_real(Nstr,N),
	N<=2000,
	!.
check_N(_Msg,NStr,N,ok):-%ok, go to expand
	str_real(Nstr,N),
	N>2000,
	Ans=dlg_ask("输入的变量数很大，有可能出现问题。是否继续？", ["继续", "停止"]),
	Ans=resp_default,
	!.
check_N(_Msg,NStr,N,not_goodN):-%ok, go to expand
	str_real(Nstr,N),
	N>2000,
	!.
check_N(_Msg,NStr,0,not_input):-%if Nstr is empty, mens cancel is pushed, end
	not(fronttoken(NStr,_,_)),
	edit_win(EditWin),
	Pwin=win_getParent(Editwin),
	ini_fcalc(PWin,""),
	!.
check_N(Msg,NStr,N,ok):- %if input is not real, ask to input again
	not(str_real(Nstr,_)),
%	repeat,
	beep,
	dlg_note("只能输入数值"),
	NStr1=dlg_GetStr("输入",Msg,""),
	str_real(NStr1,N),
	!.
check_N(_Msg,NStr,0,not_input):- %if input is not real, ask to input again
	not(str_real(Nstr,_)),
	beep,
	dlg_note("输入的不是数值。"),
	edit_win(EditWin),
	Pwin=win_getParent(Editwin),
	ini_fcalc(PWin,""),
	!.
%%%end: check input n:
%%%begin: go expand, if expand fail, let modify
go_expand(OldFormu,N, NewFormu,NewVarList):-%expand ok
%	expand_str_loop(OldFormu,N, "", NewFormu,[],NewVarList),
	retractall(expand_rec(_,_,_,_)),
	assert(expand_Rec(OldFormu,"",[],N)),
	expand_str_loop(NewFormu,NewVarList),
	!.
go_expand(_OldFormu,_N, "",[]):-%expand failed
	edit_win(EditWin),
	Pwin=win_getParent(Editwin),
%	ini_fcalc(PWin,""),
	MOdWin=win_getCtlHandle(Pwin, idc_pb_fmodify), 
	retractall(modOrAddId(_)),
	assert(modOrAddId(idc_pb_fmodify)), 
	_Reply=win_SendEvent(PWin,e_Control(idc_pb_fmodify,wc_PushButton,ModWin,activated)),
	!.
%%%end: go expand, if expand fail, let modify
%%%begin: extract var names from formu
extract_var(Formu, NewVarList,0):- %fixed var
	not(searchstring(Formu,"...",_)),
	retractall(record("extract_var", _, _)),
	assert(record("extract_var", Formu, [])),
	retract(record("extract_var", RFormu, TVarList)),
	fronttoken(RFormu, T, NRFormu),
	check_var(0, T,TVarList, NTVarList),
	assert(record("extract_var", NrFormu,NTVarList)),
	not(fronttoken(NRFormu,_,_)),!,
	NewVArList=NTVArlist,
	!.
extract_var(Formu, NewVarList,2):- %not fixed var
	searchstring(Formu,"...",_),
	retractall(record("extract_var", _, _)),
	assert(record("extract_var", Formu, [])),
	retract(record("extract_var", RFormu, TVarList)),
	fronttoken(RFormu, T, NRFormu),
	check_var(2, T,TVarList, NTVarList),
	assert(record("extract_var", NrFormu,NTVarList)),
	not(fronttoken(NRFormu,_,_)),!,
	NewVArList=NTVArlist,
	!.
extract_var(_Formu, [],0):- %no var
	!.
%%%end: extract var names from formu

%%begin: if is a var, ie: letter +anything, add to it
check_var(0,T,TVarList, NTVarList):-%fixed var
	frontchar(T,FrontChar,_RestString),
	str_char(FrontCharstr,FrontChar),
	is_Letter(FrontCharstr,YN),
	YN=yes,
	str_slist_member(T,functorlist,_, Pos1),
	Pos1=0,
	str_slist_member(T,TVarList, _Member, Pos),
%	not(fronttoken(Member,_,_)),
	Pos=0, 
	concat_slists(TVarList,[T],NTVarlist),
	!.
check_var(2,T,TVarList, NTVarList):-%not fixed
	frontchar(T,FrontChar,_RestString),
	str_char(FrontCharstr,FrontChar),
	is_Letter(FrontCharstr,YN),
	YN=yes,
	str_len(T,Length),
	substring(T,Length,1,LastChar),
	LastChar<>"n",
	LastChar<>"1",
	LastChar<>".",
	str_slist_member(T,functorlist, _,Pos1),
	Pos1=0,
	str_slist_member(T,TVarList, _Member, Pos),
%	not(fronttoken(Member,_,_)),
	Pos=0, 		
	concat_slists(TVarList,[T],NTVarlist),
	!.

check_var(_1, _T,TVarList, TVarList):-%no var
	!.
%%end: if is a var, ie: letter +anything, add to it