📄 eqnentry.pas
字号:
end;
{ These functions actually process an equation in order to }
{ generate the appropriate truth tables. The grammar is the }
{ same as the above, this code simply has sematic rules to }
{ actually compute results. }
function E(a,b,c,d,clk:integer; Ach, Bch, Cch, Dch:char):integer;
function F:integer;
function G:integer;
function H:integer;
var ch:char;
begin
ch := Equation[CurChar];
case (ch) of
'(': begin
inc(CurChar);
Result := E(a,b,c,d,clk,
Ach, Bch, Cch, Dch);
inc(CurChar);
end;
'A'..'Z': begin
if (ch = Ach) then
Result := a
else if (ch = Bch) then
Result := b
else if (ch = Cch) then
Result := c
else if (ch = Dch) then
Result := d;
inc(CurChar);
end;
'#': begin
Result := clk;
Inc(CurChar);
end;
'0': begin
Result := 0;
Inc(CurChar);
end;
'1': begin
Result := 1;
Inc(CurChar);
end;
end;
end;
begin {G}
Result := H;
while (Equation[CurChar] = '''') do
begin
inc(CurChar);
Result := Result xor 1;
end;
end;
begin {F}
Result := G;
if (Equation[CurChar] in ['A'..'Z', '(', '#', '0','1']) then
Result := Result and F; {YX case}
end;
begin {E}
Result := F;
if (Equation[CurChar] = '+') then
begin
inc(CurChar);
Result := Result or E(a,b,c,d,clk,
Ach, Bch, Cch, Dch);
end;
end;
{ Swap swaps characters in the "theVars" array. ParseEqn uses this }
{ function when it sorts the "theVars" array. }
procedure swap(pos1,pos2:integer);
var
ch:char;
begin
ch := thisTruth.theVars[pos1];
thisTruth.theVars[pos1] := thisTruth.theVars[pos2];
thisTruth.theVars[pos2] := ch;
end;
begin {ParseEqn}
{ Note that the input equation only contains uppercase characters }
{ at this point. The code calling this function has seen to that. }
{ This statement appends a zero byte to the end of the string }
{ for use as a sentinel value. }
Equation := EqnDlg.InputEqn.Text + chr(0);
{ Remove any spaces present in the string }
RmvBlanks(Equation);
{ Some truth table initialization before we parse this equation: }
thisTruth.NumVars := 0;
TruthVars := [];
{ At a minimum, the equation must have four characters: "F=A" plus }
{ a zero terminating byte. If it has fewer than four characters, }
{ it cannot possibly be correct. }
if (length(Equation) < 4) then
begin
MessageDlg(
'Syntax error, functions take the form "<var> = <expr>".',
mtWarning, [mbok], 0);
result := false;
exit;
end
{ Functions must take the form "<var> = <expr>". }
else if (Equation[2] <> '=') or not (Equation[1] in ['A'..'Z', '#']) then
begin
MessageDlg(
'Syntax error, functions take the form "<var> = <expr>".',
mtWarning, [mbok], 0);
result := false;
exit;
end
{ Variables A..D and "#" are read-only, no functions can redefine }
{ them. Check that here. }
else if (Equation[1] in ['A'..'D','#']) then
begin
MessageDlg(
'A-D and # are read-only and may not appear to the left of "=".',
mtWarning, [mbok], 0);
result := false;
exit;
end
{ Okay, now all that's left to check is the expression. }
else begin
{ Set up the variable array. Fill the fifth element with the }
{ name of the function we are defining. }
for i := 0 to 3 do thisTruth.theVars[i] := chr(0);
thisTruth.theVars[4] := Equation[1];
{ Start just past the "<var>=" portion of the equation and }
{ check to see if this equation is syntactically correct. }
CurChar := 3;
Result := S;
{ If we've got too may variables, complain about that here. }
if (thisTruth.NumVars > 4) then
begin
MessageDlg('Too many variables in equation (max=4).',
mtWarning, [mbok], 0);
result := false;
end
{ Be sure there's no junk at the end of the equation. If we're }
{ currently pointing at the sentinel character (the zero byte) }
{ then we've processed the entire equation. If not, then there }
{ is junk at the end of the equation and we need to complain }
{ about this. }
else if (Equation[CurChar] <> chr(0))then
begin
MessageDlg('Syntax Error', mtWarning, [mbok], 0);
result := false;
end;
if not Result then exit;
{ Sort the array of characters used in this truth table. This }
{ is a simple unrolled bubble sort of four elements. }
with thisTruth do begin
if (NumVars >= 2) then
begin
if theVars[0] > theVars[1] then swap(0,1);
if (NumVars >= 3) then
begin
if theVars[1] > theVars[2] then swap(1,2);
if theVars[0] > theVars[1] then swap(0,1);
if (NumVars = 4) then
begin
if theVars[2] > theVars[3] then swap(2,3);
if theVars[1] > theVars[2] then swap(1,2);
if theVars[0] > theVars[1] then swap(0,1);
end;
end;
end;
{ Evaluate the function for all possible values of Clk, }
{ A, B, C, and D. Store the results away into the }
{ truth tables. }
for Clk := 0 to 1 do
for a := 0 to 1 do
for b := 0 to 1 do
for c := 0 to 1 do
for d := 0 to 1 do
begin
CurChar := 3;
tt[Clk,d,c,b,a] := e(a,b,c,d,Clk,
theVars[0],
theVars[1],
theVars[2],
theVars[3]);
end;
{ After building the truth tables, draw them. }
DrawTruths(thisTruth);
end;
end;
end;
{ If the user presses the OKAY button, then we need to parse the func- }
{ tion the user has entered and, if it's correct, build the truth table }
{ for that function. }
procedure TEqnDlg.OKBtnClick(Sender: TObject);
var
ii: integer;
ch: char;
begin
{ Convert all the characters in the equation to upper case. }
InputEqn.Text := UpperCase(InputEqn.Text);
{ Get the name of the function we are defining. }
ch := InputEqn.Text[1];
with LogicEval do begin
{ See if this function is syntactically correct. If it is, then }
{ ParseEqn also constructs the truth table for the equation. }
if (not ParseEqn) then
begin
messagebeep($ffff);
InputEqn.Color := clRed;
end
else begin
InputEqn.Color := clWhite;
{ EqnSet is the set of all function names we're defined up to }
{ this point. If the current function name is in this set, }
{ then the user has just entered a name of a pre-existing }
{ function. Ask the user if they want to replace the exist- }
{ ing function with the new one. }
if (ch in EqnSet) then
begin
if MessageDlg('Okay to replace existing function?',
mtWarning, [mbYes, mbNo], 0) = mrYes then
begin
{ Search for the equation in the equation list. }
ii := 0;
while (EqnList.Items[ii][1] <> ch) do inc(ii);
{ Replace the equation and its truth table. }
EqnList.Items[ii] := InputEqn.Text;
TruthTbls[thisTruth.theVars[4]] := thisTruth;
end
{ If the user elected not to replace the function, set }
{ thisTruth to the original truth table so we will draw }
{ the correct truth table (the original one) when we exit.}
else begin
thisTruth := TruthTbls[InputEqn.Text[1]];
end;
end
{ If this isn't a duplicate function definition, enter the }
{ new function into the system down here. }
else begin
LastEqn := InputEqn.Text;
TruthTbls[ch] := thisTruth;
EqnSet := EqnSet + [ch];
EqnList.Items.add(LastEqn);
end;
{ Draw the truth table and close the equation editor dialog box. }
DrawTruths(thisTruth);
EqnDlg.Close;
end;
end;
end;
{ If the user presses the cancel button, close the equation editor }
{ dialog box and restore the default equation to the last equation }
{ entered in the editor (rather than the junk that is in there now). }
procedure TEqnDlg.CancelBtnClick(Sender: TObject);
begin
InputEqn.Text := LastEqn;
Close;
end;
{ If there was a syntax error, the equation input box will have a red }
{ background. The moment the user changes the equation the following }
{ code will restore a white background. }
procedure TEqnDlg.InputEqnChange(Sender: TObject);
begin
InputEqn.Color := clWhite;
end;
procedure TEqnDlg.HelpBtnClick(Sender: TObject);
begin
HelpBox.Show;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -