unit Eqnentry;
interface
uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
StdCtrls, ExtCtrls, Dialogs, SysUtils, LogicEV, Help1;
type
TEqnDlg = class(TForm)
OKBtn: TBitBtn;
CancelBtn: TBitBtn;
HelpBtn: TBitBtn;
Bevel1: TBevel;
InputEqn: TEdit;
procedure OKBtnClick(Sender: TObject);
procedure CancelBtnClick(Sender: TObject);
procedure InputEqnChange(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
LastEqn:string;
EqnDlg: TEqnDlg;
procedure DrawTruths(var TTbl:TruthType);
implementation
var
thisTruth:TruthType;
{$R *.DFM}
{ RmvBlanks- Removes all spaces from a string. }
procedure RmvBlanks(var Equation:string);
var dest:integer;
i:integer;
begin
dest := 1;
for i := 1 to length(Equation) do
if (Equation[i] <> ' ') then begin
Equation[dest] := Equation[i];
dest := dest + 1;
end;
end;
{ DrawTruths- This procedure takes a truth table as a parameter and }
{ draws that truth table on the CREATE page. Zero variable functions }
{ produce a blank truth table, one-variable functions produce a 1x2 }
{ truth table, two-variable functions produce a 2x2 table, three- }
{ variable functions produce a 2x4 table, and four-variable functions }
{ produce a 4x4 table. }
procedure DrawTruths(var TTbl:TruthType);
var
i,j,
a,b,c,d,
Clk :integer;
{ ToDigit converts the integer value at the given spot in the truth }
{ table to a '0' or '1' character and returns this character. }
function ToDigit(clk,d,c,b,a:integer):char;
begin
result := chr(ord('0') + TTbl.tt[clk,d,c,b,a]);
end;
begin {DrawTruth}
{Initialize all the truth table labels to spaces. We will fill }
{in the necessary ones later. }
with LogicEval do begin
ba00.Caption := '';
ba01.Caption := '';
ba10.Caption := '';
ba11.Caption := '';
dc00.Caption := '';
dc01.Caption := '';
dc10.Caption := '';
dc11.Caption := '';
dc200.Caption := '';
dc201.Caption := '';
dc210.Caption := '';
dc211.Caption := '';
end;
{ Clear all the labels in the truth table. For functions with }
{ less than four variables, the unused squares need to be blank.}
{ We will fill in the non-blank ones later. }
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
tt[clk,d,c,b,a].Caption := '';
end;
{ Okay, fill in the truth tables and attach appropriate labels }
{ down here. Since functions of different numbers of variables }
{ each produce completely different truth tables, the following }
{ case statement divides up the work depending on the number }
{ of variables in the function. }
case TTbl.NumVars of
{ Handle functions of a single variable here. Produce a 1x2 }
{ truth table. }
1: begin
for Clk := 0 to 1 do
for a := 0 to 1 do
tt[Clk,0,0,0,a].Caption := ToDigit(Clk,0,0,0,a);
with LogicEval do begin
ba00.Caption := ' ' + TTbl.theVars[0] + '''';
ba01.Caption := ' ' + TTbl.theVars[0];
end;
end;
{ Handle functions of two variables here, producing a 2x2 }
{ truth table. Note that this code swaps the B and C variables }
{ in the actual truth table to get a 2x2 format rather than a }
{ 1x4 format. }
2: begin
for clk := 0 to 1 do
for a:= 0 to 1 do
for b:= 0 to 1 do
tt[clk,0,b,0,a].Caption := ToDigit(clk,0,0,b,a);
with LogicEval do begin
ba00.Caption := ' ' + TTbl.theVars[0] + '''';
ba01.Caption := ' ' + TTbl.theVars[0];
dc00.Caption := ' ' + TTbl.theVars[1] + '''';
dc01.Caption := ' ' + TTbl.theVars[1];
dc200.Caption := ' ' + TTbl.theVars[1] + '''';
dc201.Caption := ' ' + TTbl.theVars[1];
end;
end;
{ Process three-variable functions down here. This code pro- }
{ duces a 2x4 truth table. }
3: begin
for clk := 0 to 1 do
for c := 0 to 1 do
for b := 0 to 1 do
for a := 0 to 1 do
begin
tt[clk,0,c,b,a].Caption := ToDigit(clk,0,c,b,a);
end;
with LogicEval do begin
ba00.Caption := TTbl.theVars[1] + '''' +
TTbl.theVars[0] + '''';
ba01.Caption := TTbl.theVars[1] + '''' +
TTbl.theVars[0];
ba10.Caption := TTbl.theVars[1] +
TTbl.theVars[0] + '''';
ba11.Caption := TTbl.theVars[1] +
TTbl.theVars[0];
dc00.Caption := ' ' + TTbl.theVars[2] + '''';
dc01.Caption := ' ' + TTbl.theVars[2];
dc200.Caption := ' ' + TTbl.theVars[2] + '''';
dc201.Caption := ' ' + TTbl.theVars[2];
end;
end;
{ Produce a 4x4 truth table for functions of four variables. }
4: begin
for clk := 0 to 1 do
for d := 0 to 1 do
for c := 0 to 1 do
for b := 0 to 1 do
for a := 0 to 1 do
begin
tt[clk,d,c,b,a].Caption :=
ToDigit(clk,d,c,b,a);
end;
with LogicEval do begin
ba00.Caption := TTbl.theVars[1] + '''' +
TTbl.theVars[0] + '''';
ba01.Caption := TTbl.theVars[1] + '''' +
TTbl.theVars[0];
ba10.Caption := TTbl.theVars[1] +
TTbl.theVars[0] + '''';
ba11.Caption := TTbl.theVars[1] +
TTbl.theVars[0];
dc00.Caption := TTbl.theVars[3] + '''' +
TTbl.theVars[2] + '''';
dc01.Caption := TTbl.theVars[3] + '''' +
TTbl.theVars[2];
dc10.Caption := TTbl.theVars[3] +
TTbl.theVars[2] + '''';
dc11.Caption := TTbl.theVars[3] +
TTbl.theVars[2];
dc200.Caption := TTbl.theVars[3] + '''' +
TTbl.theVars[2] + '''';
dc201.Caption := TTbl.theVars[3] + '''' +
TTbl.theVars[2];
dc210.Caption := TTbl.theVars[3] +
TTbl.theVars[2] + '''';
dc211.Caption := TTbl.theVars[3] +
TTbl.theVars[2];
end;
end;
end;
end;
{ ParseEqn- This function checks to see if an equation input by the }
{ user is syntactically correct. If not, this function }
{ returns false. If so, this function constructs the }
{ truth table for the equation by evaluating the function }
{ for all possible values of the clock, a, b, c, and d. }
function ParseEqn:boolean;
var
a,b,c,d,
clk,
i :integer;
CurChar :integer;
Equation :string;
TruthVars : set of char;
{ Parse- Parses the "Equation" string and evaluates it. }
{ Returns true if expression is legal, returns }
{ false if the equation is syntactically incorrect. }
{ }
{ Grammar: }
{ S -> X + S | X }
{ X -> YX | Y }
{ Y -> Y' | Z }
{ Z -> a .. z | # | ( S ) }
function S:boolean;
function X:boolean;
var dummy:boolean;
function Y:boolean;
function Z:boolean;
begin
case (Equation[CurChar]) of
{ The following case handles parenthesized }
{ expressions. }
'(': begin
inc(CurChar); { Skip the parenthesis. }
Result := S; { Check internal expr. }
{ Be sure the expression ends with a }
{ closing parenthesis. }
if (Equation[CurChar] <> ')') then
Result := false
else inc(CurChar);
end;
{ If this term is a variable name, we need }
{ check a couple of things. First of all, }
{ equations cannot have more than four dif- }
{ ferent variables. The TruthVars set con- }
{ tains the variables found in the equation }
{ up to this point. If the current vari- }
{ able is not in this set, add it to the }
{ set and bump the variable counter by one. }
{ If the variable is already in the set, }
{ then we've already counted it towards our }
{ maximum of four variables. }
{ We return true if we haven't exceeded our }
{ four variable maximum. }
'A'..'Z': begin
if (not (Equation[CurChar] in TruthVars)) then
begin
thisTruth.theVars[thisTruth.NumVars]:=
Equation[CurChar];
TruthVars := TruthVars +
[Equation[CurChar]];
Result := thisTruth.NumVars < 4;
if Result then inc(thisTruth.NumVars);
end
else Result := true;
inc(CurChar);
end;
{ The clock value ("#") and the zero and }
{ one constants do not need any special }
{ handling. Just skip over them and return }
{ true as the function result. }
'#','0','1': begin
Result := true;
Inc(CurChar);
end;
{ If not one of the above symbols, we've }
{ got an illegal symbol in the equation. }
{ Return an error if this occurs. }
else Result := false;
end;
end;
{ Y handles all sub-expressions of the form <var>'. }
begin {Y}
{ Note: This particular operation is left recursive }
{ and would require considerable grammar transform- }
{ ation to repair. However, a simple trick is to }
{ note that the result would have tail recursion }
{ which we can solve iteratively rather than recur- }
{ sively. Hence the while loop in the following }
{ code. }
Result := Z;
while (Result) and (Equation[CurChar] = '''') do
inc(CurChar);
end;
{ X handles all subexpressions containing concatenated values }
{ (i.e., logical AND operations). }
begin {X}
Result := Y;
if Result and
(Equation[CurChar] in ['A'..'Z','0','1','#','(']) then
result := X;
end;
{ S handles all general expressions and, in particular, those tak- }
{ ing the form <var> + <var>. }
begin {S}
Result := X;
if Result and (Equation[CurChar] = '+') then
begin
inc(CurChar);
Result := S;
end;
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.
