Navigation  without Java Scripts

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

Copyright (c) 1998 Prolog Development Center A/S

The Equation Solver. WEB version

Project: SOLVER32

FileName: SOLVER32.PRO

Purpose: The demonstration of the Solver Engine

Written by: Victor Yukhtenko

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

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(_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(""):- % preparing 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

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):-!,

assert(htmB_TemplateFileName(TempFileName)).

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).