Navigation  without Java Scripts

/*****************************************************************************

		Copyright (c) 1997 Prolog Development Center A/S

 Project:  SOLVER32
 FileName: SOLVER32.PRO
 Purpose: The demonstration of the Solver
 Written by: Victor Yukhtenko
 Comments:
******************************************************************************/

include "solver32.inc"
include "pdcrunt.pre"
include "solver.pre"
include "cgitools.pre"
include "cgitools.pro"

CONSTANTS
  htmC_VarPreset		= 1000
  htmC_VarVoid			= 1010
  htmC_VarSolved		= 1020
  htmC_VarNotSolved		= 1030
  htmC_SrcDataConflict 		= 1040
  htmC_FinalDataConflict 	= 1050
  htmC_InvalidData		= 1060
  htmC_VarNegative		= 1070
  htmC_VarZero			= 1080
  
/******************************************************
	Some predicate to debug CGI application
******************************************************/

PREDICATES
  makePage(STRING message,STRING page)
  sendPage(STRING message)
CLAUSES
  makePage(Message,Page):-
	Head1="Content-type: text/html\n\n",
        Head2="<html>\n",
        Head3="<body>\n",
	Head4="</body>\n",
	Head5="</html>\n",
	format(Page,"%s%s%s%s\n%s%s",Head1,Head2,Head3,Message,Head4,Head5).
  sendPage(Message):-
	makePage(Message,Page),
	write(Page).


DATABASE - htmDB_InputData
determ  htmB_TemplateFileName(STRING fileName)
  htmB_VarValue(STRING varName,STRING varValue)
  htmB_UserData(INTEGER solvingCase,STRING userTextForReplacement)

DATABASE - htmDB_OutputData
  htmB_OutputVar(STRING varName,STRING varValue)
  htmB_VarError(STRING varName,STRING msg)
  htmB_RuleError(STRING msg)
  htmB_OutputVarMark(STRING varName,STRING toBeReplacedToThis)
  htmB_SrcDataConflict(STRING ruleNo,SLIST varList)
  htmB_FinalDataConflict(STRING ruleNo,SLIST varList)
  htmB_MSG(STRING)

PREDICATES
  nondeterm htmP_Member(parm,parmlist)
  nondeterm htmP_Member(SlvD_Var,SlvD_VarList)
  nondeterm htmP_Member(STRING,SLIST)
CLAUSES

  htmP_Member(X,[X|_]).
  htmP_Member(X,[_|Y]):-htmP_Member(X,Y).

PREDICATES
  htmP_Message : SlvPD_Message
  htmP_ErrAndWarn : SlvPD_ErrAndWarn

CLAUSES

  htmP_Message(slvErrC_InvalidSourceSetData,StrListStr):-
  	term_str(slist,DataList,StrListStr),
  	DataList=[RuleNo|VarNameList],!,
	assert(htmB_SrcDataConflict(RuleNo,VarNameList)).
  htmP_Message(slvErrC_InvalidFinalSetData,StrListStr):-
  	term_str(slist,DataList,StrListStr),
  	DataList=[RuleNo|VarNameList],!,
	assert(htmB_FinalDataConflict(RuleNo,VarNameList)).
  htmP_Message(888,_MSG):-!.
  htmP_Message(999,_MSG):-!.
  htmP_Message(_MesageId,_StrMessage):-
  	format(MSG,"SLV: %",_StrMessage),
	assert(htmB_MSG(MSG)).

  htmP_ErrAndWarn(Pos,MessageText):-
	ActualPos=Pos+1,
	format(MSG,"Error in Pos %. %",ActualPos,MessageText),
	assert(htmB_MSG(MSG)).

PREDICATES
procedure htmP_GetCaseReaction(REAL varValue,INTEGER CaseCode,STRING onCaseReaction)
CLAUSES
  htmP_GetCaseReaction(Value,htmC_VarSolved,OnCaseReaction):-
	Value<0,
	htmB_UserData(htmC_VarNegative,OnCaseReaction),!.
  htmP_GetCaseReaction(Value,htmC_VarSolved,OnCaseReaction):-
	Value=0,
	htmB_UserData(htmC_VarZero,OnCaseReaction),!.
  htmP_GetCaseReaction(_AnyValue,Case,OnCaseReaction):-
	htmB_UserData(Case,OnCaseReaction),!.
  htmP_GetCaseReaction(_AnyValue,_AnyCase,"").

PREDICATES
procedure htmP_MakeHTMLpage( STRING templateStr,STRING stringCollector,STRING outHTMLStr)
  htmP_SearchKeyString(STRING templateStr,STRING prefix,STRING varName,STRING suffix)
procedure  htmP_GetVarValue(STRING varName,STRING varValue)

CLAUSES

  htmP_GetVarValue(VarName,VarValue):-
	htmB_OutputVar(VarName,VarValue),!.
  htmP_GetVarValue(_VarName,"").

  htmP_SearchKeyString(TemplateStr,Prefix,VarName,Suffix):-
	searchChar(TemplateStr,'$',FoundPos),
	NeededFoundPos=FoundPos-1,
	frontstr(NeededFoundPos,TemplateStr,Prefix,RestString),
	frontChar(RestString,_,IncludedVarNameStr),
	searchChar(IncludedVarNameStr,'$',EndOfFieldPos),!,
	frontStr(EndOfFieldPos,IncludedVarNameStr,VarNameWithDollar,Suffix),
	concat(VarName,"$",VarNameWithDollar).

  htmP_MakeHTMLpage(TemplateStr,Collector,OutHTMLStr):-
	htmP_SearchKeyString(TemplateStr,Prefix,VarName,Suffix),
	htmP_GetVarValue(VarName,VarValue),
	format(NewCollector,"%s%s%s",Collector,Prefix,VarValue),!,
	htmP_MakeHTMLpage(Suffix,NewCollector,OutHTMLStr).
  htmP_MakeHTMLpage(Suffix,Collector,OutHTMLStr):-
	format(OutHTMLStr,"%s%s",Collector,Suffix).

PREDICATES
nondeterm htmP_MarkConflictedVariables(INTEGER conflictType,STRING varName,SLIST varNameList)
CLAUSES
  htmP_MarkConflictedVariables(ConflictType,VarName,VarNameList):-
	htmP_Member(VarName,VarNameList),
		concat("c",VarName,C_VarName),
		htmP_GetCaseReaction(0.0,ConflictType,OnCaseReaction),
		asserta(htmB_OutputVarMark(C_VarName,OnCaseReaction)).

PREDICATES
  htmP_BuildPage(STRING htmPage)
  htmP_StoreMessage(STRING msg)
CLAUSES
  htmP_StoreMessage(NewMsg):-
	retract(htmB_OutputVar("mMsg",OldMsg)),!,
	format(MSG,"%s\n%s",OldMsg,NewMsg),
	assert(htmB_OutputVar("mMsg",MSG)).
  htmP_StoreMessage(NewMsg):-
	assert(htmB_OutputVar("mMsg",NewMsg)).

  htmP_BuildPage(""):-
	htmB_VarError(VarName,Msg),
		htmP_StoreMessage(Msg),
		htmP_GetCaseReaction(0.0,htmC_InvalidData,OnCaseReaction),
		concat("c",VarName,C_VarName),
		assert(htmB_OutputVarMark(C_VarName,OnCaseReaction)),
	fail.
  htmP_BuildPage(""):-
	htmB_RuleError(Msg),
		htmP_StoreMessage(Msg),
	fail.
  htmP_BuildPage(""):-
	htmB_SrcDataConflict(RuleNo,VarNameList),
		findall(VarName,htmP_MarkConflictedVariables(htmC_SrcDataConflict,VarName,VarNameList),_DummyL),
		format(Msg,"Source Data Conflict in RuleNo: %",RuleNo),
		htmP_StoreMessage(Msg),
	fail.
  htmP_BuildPage(""):-
	htmB_FinalDataConflict(RuleNo,VarNameList),
		findall(VarName,htmP_MarkConflictedVariables(htmC_FinalDataConflict,VarName,VarNameList),_DummyL),
		format(Msg,"Solution Data Conflict in RuleNo: %",RuleNo),
		htmP_StoreMessage(Msg),
	fail.
  htmP_BuildPage(""):-
	htmB_MSG(Msg),
		htmP_StoreMessage(Msg),
	fail.
  htmP_BuildPage(""):-
	htmB_OutputVarMark(C_VarName,OnCaseReaction),
		assert(htmB_OutputVar(C_VarName,OnCaseReaction)),
	fail.
  htmP_BuildPage(HtmPage):-
	htmB_TemplateFileName(TemlateFileName),
	trap(file_str(TemlateFileName,_TemplateStr),_,fail),!,
	htmP_MakeHTMLpage(_TemplateStr,"",HtmPage),!.
  htmP_BuildPage(HtmPage):-
	makePage("Nothing Done. The Reason Unknown.",HtmPage).

PREDICATES
  htmP_BuildOutputPage(STRING htmPage)
CLAUSES

  htmP_BuildOutputPage(HtmPage):-
	not(htmB_VarError(_,_)),
	not(htmB_RuleError(_)),
	not(htmB_SrcDataConflict(_,_)),
	htmP_BuildPage(HtmPage),!.
% Error situation handling
  htmP_BuildOutputPage(""):-
	retractall(htmB_OutputVar(_,_)),
	fail.
  htmP_BuildOutputPage(""):- % restoring User's input Data
	htmB_VarValue(VarName,VarValue),
		concat("v",VarName,V_VarName),
		assert(htmB_OutputVar(V_VarName,VarValue)),
	fail.
  htmP_BuildOutputPage(""):- % prepearing Case Marking
	htmB_OutputVarMark(C_VarName,OnCaseReaction),
		assert(htmB_OutputVar(C_VarName,OnCaseReaction)),
	fail.
  htmP_BuildOutputPage(HtmPage):- % building Error Reaction Page
	htmP_BuildPage(HtmPage),!.
  htmP_BuildOutputPage(HtmPage):-
	makePage("Nothing Done. The Reason Unknown.",HtmPage).

PREDICATES
procedure  htmP_StoreVarData(
			STRING 	varName,
  			INTEGER varSrcStatus,
  			INTEGER varResultStatus,
  			REAL 	varValue)
CLAUSES
  htmP_StoreVarData(VarName,slvC_SourceIsVoid,slvC_CurrentlyIsEmpty,Value):-!,
	concat("v",VarName,V_VarName),
	assert(htmB_OutputVar(V_VarName,"")),
	htmP_GetCaseReaction(Value,htmC_VarVoid,OnCaseReaction),
	concat("c",VarName,C_VarName),
	assert(htmB_OutputVarMark(C_VarName,OnCaseReaction)).
  htmP_StoreVarData(VarName,slvC_SourceIsVoid,slvC_CurrentlyResolved,Value):-!,
	str_real(ValueStr,Value),
	concat("v",VarName,V_VarName),
	assert(htmB_OutputVar(V_VarName,ValueStr)),
	htmP_GetCaseReaction(Value,htmC_VarSolved,OnCaseReaction),
	concat("c",VarName,C_VarName),
	assert(htmB_OutputVarMark(C_VarName,OnCaseReaction)).
  htmP_StoreVarData(VarName,slvC_SourceIsSet,slvC_CurrentlyResolved,Value):-!,
	str_real(ValueStr,Value),
	concat("v",VarName,V_VarName),
	assert(htmB_OutputVar(V_VarName,ValueStr)),
	htmP_GetCaseReaction(Value,htmC_VarPreset,OnCaseReaction),
	concat("c",VarName,C_VarName),
	assert(htmB_OutputVarMark(C_VarName,OnCaseReaction)).
  htmP_StoreVarData(VarName,slvC_SourceIsVoid,slvC_CurrentlyIsNeeded,Value):-!,
	concat("v",VarName,V_VarName),
	assert(htmB_OutputVar(V_VarName,"")),
	htmP_GetCaseReaction(Value,htmC_VarNotSolved,OnCaseReaction),
	concat("c",VarName,C_VarName),
	assert(htmB_OutputVarMark(C_VarName,OnCaseReaction)).
  htmP_StoreVarData(_VarName,_VarSrcStatus,_VarResStatus,_Value).

PREDICATES
procedure htmP_GetSolverResults
CLAUSES
  htmP_GetSolverResults:-
	slvP_GetVarList(VarList),
	htmP_Member(slvT_Var(VarName,VarSrcStatus,VarCurStatus,Value),VarList),
		htmP_StoreVarData(VarName,VarSrcStatus,VarCurStatus,Value),
	fail.
  htmP_GetSolverResults.
	
PREDICATES
procedure htmP_RunSolver
CLAUSES
  htmP_RunSolver:-
	not(htmB_VarError(_,_)), % valid Input Data
	not(htmB_RuleError(_)),	 % valid Rule Script
	slvP_ResolveNet,!,
	htmP_GetSolverResults. % data stored in the internalDB
  htmP_RunSolver:- % No proper solution.
	assert(htmB_MSG("No Solution.")).

PREDICATES
  htmP_TransformData(STRING varName,STRING srcValue,INTEGER varStatus,REAL value) % (i,i,o,o)
CLAUSES
  htmP_TransformData(VarName,ValueSrc,slvC_SourceIsVoid,0.0):-
  	assert(htmB_VarValue(VarName,ValueSrc)),
  	fail.
  htmP_TransformData(_VarName,"",slvC_SourceIsVoid,0.0):-!.
  htmP_TransformData(_VarName,ValueSrc,slvC_SourceIsSet,ValueReal):-
	trap(str_real(ValueSrc,ValueReal),_,fail),!.
  htmP_TransformData(VarName,ValueSrc,slvC_SourceIsVoid,0.0):-
	format(MSG,"The wrong Variable '%s' input. Must be a number instead of '%s'.",VarName,ValueSrc),
	assert(htmB_VarError(VarName,MSG)),
	fail.

PREDICATES
  htmP_InputData(STRING varName,STRING inputValue)
procedure htmP_InsertUsrDescriptor(STRING usrEventName,STRING varValue)
CLAUSES

% User predefined Variables to mark results:
% Wrong Data Cases:
% 	usrOnInvalidData
% 	usrOnSrcConflict
% 	usrOnResConflict
% Resolvation Results:
%	usrOnPreset
%	usrOnVoid
%	usrOnNotSolved
%	usrOnSolved
%		usrOnNegative
%		usrOnZero
% Special Results marking:

  htmP_InsertUsrDescriptor("invaliddata",VarValue):-!,
	assert(htmB_UserData(htmC_InvalidData,VarValue)).
  htmP_InsertUsrDescriptor("preset",VarValue):-!,
	assert(htmB_UserData(htmC_VarPreset,VarValue)).
  htmP_InsertUsrDescriptor("void",VarValue):-!,
	assert(htmB_UserData(htmC_VarVoid,VarValue)).
  htmP_InsertUsrDescriptor("solved",VarValue):-!,
	assert(htmB_UserData(htmC_VarSolved,VarValue)).
  htmP_InsertUsrDescriptor("notsolved",VarValue):-!,
	assert(htmB_UserData(htmC_VarNotSolved,VarValue)).
  htmP_InsertUsrDescriptor("srcconflict",VarValue):-!,
	assert(htmB_UserData(htmC_SrcDataConflict,VarValue)).
  htmP_InsertUsrDescriptor("resconflict",VarValue):-!,
	assert(htmB_UserData(htmC_FinalDataConflict,VarValue)).
  htmP_InsertUsrDescriptor("negative",VarValue):-!,
	assert(htmB_UserData(htmC_VarNegative,VarValue)).
  htmP_InsertUsrDescriptor("zero",VarValue):-!,
	assert(htmB_UserData(htmC_VarZero,VarValue)).
  htmP_InsertUsrDescriptor(_EventName,_VarValue).

  htmP_InputData(VarName,VarValue):-
	frontstr(5,VarName,UsrOn,RestString),
	UsrOn="usrOn",!,
	upper_lower(RestString,UsrVar),
	htmP_InsertUsrDescriptor(UsrVar,VarValue).
  htmP_InputData("slvINFO",_Any):-!.
  htmP_InputData("slvMSG",_Any):-!.
  htmP_InputData("slvTEMPL",TempFileName):-!,
	syspath(SolverExeStartupPath,_ProgName),
        filenamepath(DataFileName,SolverExeStartupPath,TempFileName),
	assert(htmB_TemplateFileName(DataFileName)).

  htmP_InputData("slvRULE",RuleSetScript):-!,
	trap(slvP_SetRules(RuleSetScript),_,assert(htmB_RuleError("Wrong rule script"))).
  htmP_InputData(VarName,VarValueSrc):-
	htmP_TransformData(VarName,VarValueSrc,VarSourcStatus,VarValueReal),
	slvP_SetVarList([slvT_Var(VarName,VarSourcStatus,VarSourcStatus,VarValueReal)]),!.

PREDICATES
procedure htmP_LoadSolver(ParmList)
CLAUSES
  htmP_LoadSolver(ParmList):-
  	htmP_Member(parm(ParamName,ParamVal),Parmlist),
		htmP_InputData(ParamName,ParamVal),
	fail.
  htmP_LoadSolver(_ParmList).
  	
GOAL	
	slvP_SetProperty(slvT_MessageCB(htmP_Message)),
	slvP_SetProperty(slvT_ErrAndWarnCB(htmP_ErrAndWarn)),
	ParmList = cgi_GetParmList(),   
	htmP_LoadSolver(ParmList),
	htmP_RunSolver,
	htmP_BuildOutputPage(HtmPage), % takes data from the internal DB
	write(HtmPage).