Mike is executive editor at DDJ. He can be reached at the DDJ offices, on CompuServe at 76703,4057, or on MCI Mail at mfloyd.
There's an old saying among veteran programmers that real programmers don't eat quiche, code only in assembly language, and eschew languages like Basic, Fortran, and (especially) Cobol. Over the past few years, however, C (and more recently C++) has replaced assembler as the "macho" language of choice.
Windows developers in particular have been led to believe that C and C++ are their only options. But a recent encounter with Borland's Turbo Pascal for Windows (TPW) leads me to believe that you can have your quiche and eat it too--and do some real programming in the process.
To test TPW's suitability as a Windows programming tool, I wrote ExpertWin, a general-purpose expert shell. This seemed appropriate because expert systems are typically UI intensive. In addition to examining TPW, I use Borland's ObjectWindows Library (OWL) and explore issues relating to common user-interface design. ExpertWin makes no attempt to use every feature in OWL; it does what it needs to with pull-down menus and dialog boxes.
The ExpertWin System
ExpertWin is a "backward chaining" system, meaning it starts with a conclusion (or goal) and a set of rules leading to that conclusion. The system then attempts to prove the goal by matching the rules with known facts from a database. If a needed fact is not contained in the database, the system queries the user for information.
Each conclusion is stored along with its associated attributes in a database (called either a "rule" or a "knowledge base") in the form: conclusion[attr1, attr2,...attrN]. The square brackets denote a list of attributes, and commas are used to AND two attributes. The rule reads as "conclusion is true if attr1 and attr2 and everything up to attrN are true." Upon opening a file, ExpertWin parses each rule and stores the resulting rule components into a nested linked-list structure. Once the rule base is loaded, the user can insert additional rules, search for either a conclusion or an attribute, list rules in the knowledge base, implement a query, or clear the rule base from memory so that a new database can be loaded.
Any given rule can inherit attributes from an ancestor rule, much as an object inherits features from its parent. The user creates this relationship by specifying the parent's rule name in the child's attribute list. During a query, ExpertWin looks at each attribute and first determines whether it is another rule. If so, ExpertWin goes to that rule and attempts to prove it before continuing through the list. I won't spend much time on the code, but the entire inference engine is contained in the TExpert.Inference method; see Listing One, page 145.
Some Assembly Required
ExpertWin uses OWL, Borland's application framework; for more on this, see the text box entitled "Application Frameworks." From the term framework, you might expect a superstructure--a skeleton program from which to build your application--that contains all common elements required for compliance with user-interface guidelines. However, every application framework I've worked with requires you to assemble various components to create a skeleton program. Figure 1 (page 149) shows a template for a generic application that includes the basic elements an ObjectWindows application requires. Although the template has been abbreviated for clarity, I maintain an expanded version of this template that includes all standard menus, such as File and Help, and all common dialogs, such as FileOpen and About. It's a living, breathing Windows application complete with all standard Windows interface objects.
The generic template in Figure 1 also details the basic structure of an OWL application. All apps must define an application object (TGenericApp), which is derived from the standard OWL type TApplication. TApplication initializes the first instance of your application, creates and displays the main window, and handles the processing of Windows messages. It also handles cleanup when the app is closed.
These routines are invoked from the main body of the program, which first creates an instance of TGeneric, then calls Init, Run, and Done. Init constructs the application object, then calls InitMainWindow to construct the main window. You'll usually find it necessary to override the InitMainWindow method defined in TApplication, so I've included a definition in the template.
Run invokes a message-processing loop which intercepts Windows messages and dispatches them to methods in your program. These methods, called "message-response methods," are contained in TGeneric and represent all behavior within main window. A message-response method is analogous to a Windows callback function--a function called by Windows. In this case, however, your message-response method is called via TApplication. By convention, message-response methods are given a name corresponding to the command message they respond to. For example, TGeneric.CMAbout is a message-response method that invokes the About dialog box when it receives the cm_About message (defined as Const in Figure 1).
The message-processing loop runs until the user terminates the application. At this point, the destructor Done is called to free memory and terminate the program.
OWL Hierarchy
There's a significant learning curve to both Windows and OWL programming. Fortunately, with OWL you can take it in bites. Once you learn to create the main window and you're comfortable with basic message-loop processing, you begin to learn how to create window, menu, dialog, and control objects--the interface objects. Be especially prepared to spend time with the plethora of controls, which include edit controls, list boxes, radio buttons, combo boxes, check boxes, and scroll bars.
Seemingly unrelated to user-interface objects is the support for simple container objects called collections. Collections provide a powerful means to implement data structures such as dynamic arrays and lists, as well as collections of objects in a generic, yet consistent manner. The TCollection object type includes over 20 collection-manipulation methods such as Load, GetItem, PutItem, and Delete, and iterator methods that can apply a function or procedure to each item in the collection. There are also subtypes that allow you to work with sorted collections and collections of strings.
OWL also provides support for object-oriented I/O using streams. You can create your own stream types, but you must override many of the basic I/O methods. My guess is that most newcomers will spend time learning to create the other interface objects before getting into TStream and its descendants, TDosStream and TEmsStream.
With OWL, you can create an app without really getting the Windows dirt under your fingernails. But there's more to a Windows app than windows, menus, and dialogs. Although OWL supports MDI, you must make calls directly to the Windows API to support GDI, DDE, or OLE. This isn't a complaint, just an observation that OWL does not completely insulate you from the Windows API. It does, however, reduce the number of API calls you must learn.
Reusable vs. Roll Your Own
Two singly linked lists are used to handle the rule base; see Listing Two, page 148. Attr is a simple record that uses a character array to store a rule, and ANext is a pointer to the next rule in the list. The second linked list, Item, also uses a character array to store the conclusion and a pointer to the next conclusion. But Item also contains a pointer to Attr, which links the rule list to the conclusion. The net effect is that Attr is a nested linked list.
SList is an object that handles list manipulation of conclusions. NestedList is derived from SList and handles the rule list. Most of this is straight linked-list manipulation with the twist that list traversals must often pass through both lists.
I'd originally decided to use a stream to read the rules from disk file into a collection. As mentioned, both collections and streams are provided for in OWL. But there's an inherent problem in trying to manufacture something new while you're still learning the framework. Recall that the inference engine requires synchronized list traversal. At this point, I didn't know enough about OWL internals to create a collection of collections, much less write a routine to synchronously traverse two collections. I could have grabbed the source, picked it apart, and modified the general collection routines to suit my specific needs. Or I could write my own in half the time. So much for reusability.
Once that decision was made, it became evident that using streams to read the data into a record was overkill. Streams are great for dealing with the complexities of storing objects to disk, but straightforward Turbo Pascal I/O would serve better. In all fairness, you gain a great deal of power using streams. For example, storing the current state of a query would best be implemented using streams.
Strings vs. PChars
Because Windows requires null-terminated strings, TPW introduces the pointer type PChar. Note that the string types in Listing Two are all null-terminated. Though the changes are relatively easy, PChars require some adjustments in the way you work with strings. Most problems you encounter will result from confusing PChars with normal strings.
A PChar is a pointer to a null-terminated string and is equivalent to the declaration PChar=^Char. You create a null-terminated string variable either by declaring the variable as type PChar or by declaring it as a zero-based array of characters. If the variable is declared as a PChar, you must allocate memory for the string using the StrNew function. Further, you must dispose of the string using StrDispose before assigning a different string to the variable. Failure to do so can have disastrous consequences. On the other hand, the compiler automatically allocates memory when the string is declared as a zero-based array. Note that despite the array of Char declaration, this is an array of pointers, not of characters.
PChars require that you use functions to manipulate strings instead of using familiar TP syntax. For example, with normal Turbo Pascal strings, you assign a string to a variable using the assignment operator: Str:='foo. To assign the same string to a PChar, you must use the StrCopy function: StrCopy(Str, 'foo').
Also note that because PChars are pointers, you are passing by reference when calling a procedure or function. Normal strings, however, are usually passed by value unless you use the Var keyword in the function header. If you need to work on a copy of the PChar string rather than the string itself, you must create a local variable and copy the string to that variable.
Finally, make sure you set the $X+ compiler directive to enable extended syntax. This is the default setting, but it may on occasion be turned off.
UI Design
IBM formalized its guidelines for OS/2 Presentation Manager interface design in its common user access (CUA) guidelines, published in 1989. Windows developers have used these guidelines as a road map in developing their applications. (Note that IBM updated these guidelines in 1991, but the revisions are specific to OS/2 2.0.) For the purposes of this article, I've used The Windows Interface (Microsoft Press, 1992) to aid in the design of the ExpertWin UI.
Conformance to user-interface guidelines is important for visual and functional consistency. Guidelines also take much of the guesswork out of your design and will probably keep your boss happy when the product ships.
In browsing this design guide, however, you quickly realize the enormity of detail in such an undertaking. Fortunately, the components of TPW are a big help in creating interface objects that conform to the Microsoft (and CUA '89) guidelines. For example, I found the Resource Workshop extremely helpful in implementing conforming menus. According to the guidelines, any menu item that leads to a dialog box should contain three trailing ellipses. Further, menu items that fall into logical groups should use a separator line to distinguish the groups. There are also specific recommendations for features within File, Edit, View, Options, and Help menus. Returning to ExpertWin with guidelines in hand, I was prepared to go through the process of updating the menus starting with the File menu. To my surprise, I was able to automatically generate the standard File menu complete with ellipses, separators, keyboard accelerators--the works.
There are also recommendations for "common dialogs" like Open, Save As, Print, and so on. As you might expect, TPW includes a Common Dialogs DLL (CommDlg) that you include in a USES statement. Once included, you can display the dialog via a single call rather than the traditional method of creating a dialog resource and dialog-box procedure. I was able to implement the File menu, all common dialogs, and processing code (such as parsing the rules after opening a file) all in one day.
You also have access to the Borland Windows Custom Controls (BWCC), which include various controls that have a chiseled-steel, 3-D look. Accessing the custom controls is a simple matter of including BWCC in the USES clause and recompiling. Now all standard controls will take on the Borland look. My primary complaint is that they're non-standard UI components. But if you can live with this nonstandard appearance, they can spice up an otherwise ordinary interface.
Conclusion
I didn't spend much time talking about the typical tools like the Windows-hosted development environment, which features integrated debugging, a configurable desktop and toolbar, and syntax-directed highlighting. These are features you should expect. And although I'd still like to see an integrated class browser that lets me move to and edit objects, or a debugger that doesn't have to switch to character mode, the feature list isn't what's important. More important is getting a developer-class tool for creating real-world Windows applications. Turbo Pascal for Windows fits the bill.
References
The Windows Interface. An Application Design Guide. Redmond, WA: Microsoft Press, 1992.
SAA CUA Basic Interface Design Guide, Document SC26-4582. IBM: 1989.
SAA CUA Advanced Interface Design Guide, Document SC26-4583. IBM: 1989.
Products Mentioned
Turbo Pascal for Windows Borland International 1800 Green Hills Road Scotts Valley, CA 95066 408-438-8400 $149.95
Application Frameworks
There are a number of so-called application frameworks bouncing around, among them Symantec's yet-to-be-released Bedrock, Borland's OWL, and Inmark's zApp. Microsoft, too, has dabbled with the "application framework" moniker, originally tagging its C++ class library "AFX" before releasing it as "MFC."
With all these diverse tools making the rounds, I began looking for a precise definition of an application framework. What I discovered was that, while all tool vendors could describe their application framework, none could come up with a general, yet succinct definition of one. (This caused me to wonder if, when it comes to application frameworks, marketing gurus were indeed engaging in "fuzzy logic.")
The original application framework might have been the user-interface class library for Smalltalk-80. In the days that predate GUIs, Smalltalk-80 was exceptional at constructing highly interactive, easy-to-use user interfaces. It's no accident that both Smalltalk-80 and much of the UI design in the Macintosh was pioneered at Xerox PARC. Nor is it surprising that an object-oriented approach based on Smalltalk's Model-View-Controller (MVC) was adopted in the Lisa Toolkit and later MacApp.
Eventually, Apple Computer coined the term "application framework" to describe MacApp. But when DDJ asked Apple for the "official" definition of the term, we were surprised to learn that Apple didn't have one either--even in the MacApp documentation. After some discussion, an Apple spokesperson provided us with the following: "An application framework is an extended collection of classes that cooperate to support a complete application architecture or model, providing more complete application development support than a simple set of classes."
Borland's ObjectWindows Library (discussed in this article) not only generally conforms to the Apple definition, but looks remarkably similar to MacApp. For example, both rely on an event-based processing loop that is built into the framework and use a naming convention that prefixes all framework objects with a T and pointers to that object with a P. Also like MacApp, OWL combines interface objects that make it difficult to create an application that does not conform to user-interface guidelines. While the OWL class hierarchy differs somewhat from MacApp, every object in the hierarchy is derived from the base object TObject. This design also bears striking similarity to Smalltalk.
-- M.F.
_EXAMINING TURBO PASCAL FOR WINDOWS_ by Michael Floyd[LISTING ONE]
<a name="0295_0010">
program ExpSys;
{$R WINXPERT.RES}
uses WinDOS, WObjects, WinTypes, Strings, WinProcs, StdDlgs, CommDlg, BWCC, Lists;
const
id_Menu = 200;
id_About = 100;
cm_FileOpen = 102;
cm_FileSaveAs = 104;
cm_Insert = 201;
cm_Search = 202;
cm_FindAttr = 203;
cm_ForChain = 212;
cm_BackChain = 204;
cm_ClearFacts = 205;
cm_About = 999;
cm_Quit = 108;
id_EC1 = 106;
id_EC2 = 107;
id_EC3 = 108;
id_CB2 = 109;
id_ST1 = 110;
id_ST2 = 111;
id_ST3 = 155;
id_ST4 = 160;
id_LB1 = 151;
id_BN1 = 152;
id_BN2 = 153;
id_BN3 = 154;
id_YesBtn = 161;
id_NoBtn = 162;
NotFound = 97;
YesBtn = 98;
NoBtn = 99;
Type
TFilename = array [0..255] of Char;
DataFile = file of Item;
{---------------------}
{ Application Objects }
{---------------------}
type
StatTxtRec = record
StaticText : array [0..40] of Char;
end;
TExpertApp = object(TApplication)
procedure InitMainWindow; virtual;
end;
PExpert = ^TExpert;
TExpert = object(TWindow)
DC : HDC;
EC1, EC2, EC3 : PEdit;
LB1 : PListBox;
Head, Tail : PItem;
AHead, ATail : Pattr;
FileName : TFileName;
IName, AName : array[0..40] of Char;
constructor Init(AParent: PWindowsObject; ATitle: PChar);
destructor Done; virtual;
function Inference(Query : PChar; Rules : PItem) : Integer;
procedure Show; virtual;
procedure CmInsert(var Msg: TMessage); virtual cm_First + cm_Insert;
procedure CMFileOpen(var Msg: TMessage); virtual cm_First + cm_FileOpen;
procedure CMFileSaveAs(var Msg: TMessage); virtual cm_First + cm_FileSaveAs;
procedure CMSearch(var Msg: TMessage); virtual cm_First + cm_Search;
procedure CMFindAttr(var Msg: TMessage); virtual cm_First + cm_FindAttr;
procedure CMForChain(var Msg: TMessage); virtual cm_First + cm_ForChain;
procedure CMBackChain(var Msg: TMessage); virtual cm_First + cm_BackChain;
procedure ClearFacts(var Msg : TMessage); virtual cm_First + cm_ClearFacts;
procedure CMAbout(var Msg: TMessage); virtual cm_First + cm_About;
procedure CMQuit(var Msg: TMessage); virtual cm_First + cm_Quit;
end;
PTestDialog = ^TTestDialog;
TTestDialog = object(TDialog)
constructor Init(AParent: PWindowsObject; ATitle: PChar);
procedure IDBN1(var Msg: TMessage); virtual id_First + id_BN1;
procedure IDLB1(var Msg: TMessage); virtual id_First + id_LB1;
end;
PQueryDlg = ^TQueryDlg;
TQueryDlg = object(TTestDialog)
procedure IDBN2(var Msg: TMessage); virtual id_First + id_BN2;
procedure IDBN3(var Msg: TMessage); virtual id_First + id_BN3;
end;
PGetFact = ^TGetFact;
TGetFact = object(TDialog)
constructor Init(AParent: PWindowsObject; ATitle: PChar);
procedure IDYesBtn(var Msg: TMessage); virtual id_First + id_YesBtn;
procedure IDNoBtn(var Msg: TMessage); virtual id_First + id_NoBtn;
end;
Var
APtr : PAttr; {Global ptr to PAttr}
KnowledgeBase : Text;
InFile, OutFile : Text;
{---------------------}
{ TGetFact Methods }
{---------------------}
constructor TGetFact.Init(AParent: PWindowsObject; ATitle: PChar);
begin
TDialog.Init(AParent, ATitle);
end;
procedure TGetFact.IDYesBtn(var Msg: TMessage);
begin
EndDlg(YesBtn); {Return YesBtn to ExecDialog and end dialog}
end;
procedure TGetFact.IDNoBtn(var Msg: TMessage);
begin
EndDlg(NoBtn); {Return NoBtn to ExecDialog and end dialog}
end;
{---------------------}
{ TTestDialog Methods }
{---------------------}
constructor TTestDialog.Init(AParent: PWindowsObject; ATitle: PChar);
begin
TDialog.Init(AParent, ATitle);
end;
procedure TTestDialog.IDBN1(var Msg: TMessage);
var
TextItem : PChar;
TmpStr : array[0..40] of Char;
IList : PItem;
begin
IList := ListPtr;
While IList <> nil do
begin
TextItem := StrNew(IList^.ItemName);
SendDlgItemMsg(id_LB1, lb_AddString, 0, LongInt(TextItem));
StrDispose(TextItem); { Don't forget to dispose TextItem }
IList := IList^.Next;
end;
end;
procedure TTestDialog.IDLB1(var Msg: TMessage);
var
RDlg, Idx : Integer;
SelectedText: array[0..20] of Char;
ExpList : SList;
AttrTxtRec : StatTxtRec;
D: PDialog;
S1: PStatic;
begin
if Msg.LParamHi = lbn_SelChange then
begin
Idx := SendDlgItemMsg(id_LB1, lb_GetCurSel, 0, LongInt(0));
SendDlgItemMsg(id_LB1, lb_GetText, Idx, LongInt(@SelectedText));
APtr := ExpList.GetAttr(SelectedText);
D := New(PQueryDlg, Init(@Self, 'DIAL2'));
StrCopy(AttrTxtRec.StaticText, APtr^.Attribute);
New(S1, InitResource(D, id_ST3, SizeOf(AttrTxtRec.StaticText)));
D^.TransferBuffer := @AttrTxtRec;
RDlg := Application^.ExecDialog(D);
end;
end;
{---------------------}
{ TQueryDlg Methods }
{---------------------}
procedure TQueryDlg.IDBN2(var Msg: TMessage);
begin
If APtr^.ANext <> nil then
begin
APtr := APtr^.ANext;
SetWindowText(GetItemHandle(id_ST3), APtr^.Attribute);
end
else
begin
MessageBox(HWindow, 'Item is True', 'List Check completed', MB_OK);
EndDlg(MB_OK);
end;
end;
procedure TQueryDlg.IDBN3(var Msg: TMessage);
begin
MessageBox(HWindow, 'Cannot prove item', 'Item not proved', MB_OK);
EndDlg(0);
end;
{--------------------}
{ TExpertApp Methods }
{--------------------}
procedure TExpertApp.InitMainWindow;
begin
MainWindow := New(PExpert, Init(nil, 'WinExpert 1.0'));
end;
{-------------------}
{ TExpert Methods }
{-------------------}
constructor TExpert.Init(AParent: PWindowsObject; ATitle: PChar);
var
AStat : PStatic;
begin
Head := nil;
Tail := nil;
AHead := nil;
TWindow.Init(AParent, ATitle);
With Attr do
Begin
Menu := LoadMenu(HInstance, PChar(100));
Style := ws_SysMenu or ws_VScroll or ws_HScroll or ws_MaximizeBox
or ws_MinimizeBox or ws_SizeBox;
X := 0; Y := 0;
W := 640; H := 450;
end;
EC1 := New(PEdit,Init(@Self, id_EC1, 'foo', 20, 50, 100, 30, 0, False));
EC2 := New(PEdit, Init(@Self, id_EC2, '', 121, 50, 150, 30, 0, False));
AStat := New(PStatic, Init(@Self, id_ST1, 'Classification:', 20, 30, 150, 20, 0));
AStat := New(PStatic, Init(@Self, id_ST2, 'Attributes:', 121, 30, 150, 20, 0));
end;
destructor TExpert.Done;
begin
TWindow.Done;
end;
function TExpert.Inference(Query : PChar; Rules : PItem) : Integer;
var
Goal : PItem;
Conditions : PAttr;
MBoxText : array[0..40] of Char;
RVal, InferFlag : Integer;
D: PDialog;
S1: PStatic;
STxtRec : StatTxtRec;
Begin
Inference := NotFound;
Goal := Rules;
{ Pattern Matcher }
While (Goal <> nil) and (StrIComp(Goal^.ItemName, Query) <> 0) do
Goal := Goal^.Next;
If Goal <> nil then { This is necessary because TPW's StrIComp() }
begin { does no checking & crashes when Goal is nil }
If StrIComp(Goal^.ItemName, Query) = 0 then
begin { Goal Matches }
Conditions := Goal^.Prop;
While Conditions <> nil do
begin
InferFlag := Inference(Conditions^.Attribute, Rules);
If InferFlag = YesBtn then
Conditions := Conditions^.ANext
Else If InferFlag = NoBtn then
begin
Inference := NoBtn;
exit;
end
Else If InferFlag = NotFound then
begin {prove attribute by asking; if true get next and prove }
StrCopy(MBoxText, 'is ');
StrCat(MBoxText, Goal^.ItemName);
StrCat(MBoxText, ' ');
StrCat(MBoxText, Conditions^.Attribute);
StrCopy(STxtRec.StaticText, MBoxText);
D := New(PGetFact, Init(@Self, 'DIAL3'));
New(S1, InitResource(D, id_ST4, SizeOf(STxtRec.StaticText)));
D^.TransferBuffer := @STxtRec;
RVal := Application^.ExecDialog(D);
If RVal = YesBtn then
begin
Conditions := Conditions^.ANext;
end
else {Condition Failed--Backtrack for other solutions}
begin
Inference := NoBtn;
exit;
end; { else }
end; { Else If}
end; { While }
{if all True then Inference := True }
If (RVal = YesBtn) or (Conditions = nil) then
Inference := YesBtn
else Inference := NotFound;
end; {While}
end; {If}
end; { Inference }
procedure TExpert.CMInsert;
var
AttrList : NestedList;
Attribute : array[0..40] of Char;
StartPos, EndPos: Integer;
TxtField1, TxtField2 : array[0..40] of Char;
begin
EC1^.GetSelection(StartPos, EndPos);
if StartPos = EndPos then
EC1^.GetText(@TxtField1, 20)
Else
EC1^.GetSubText(@TxtField1, StartPos, EndPos);
StrCopy(IName, TxtField1);
EC2^.GetText(@TxtField2, 20);
StrCopy(Attribute, TxtField2);
If Length(Attribute) > 0 then
AttrList.NewNode(AHead, ATail, Head, Tail, IName, Attribute);
Show;
end;
procedure TExpert.Show;
var
PStr : array[0..19] of Char;
Y1 : Integer;
Node : PItem;
begin
Node := ListPtr;
Y1 := 100;
DC := GetDC(HWindow);
TextOut(DC, 2,99, 'Items in list: ',14);
While Node <> nil do
begin
Y1 := Y1 + 15;
StrCopy(PStr,Node^.ItemName);
TextOut(DC, 31,Y1, PStr, StrLen(PStr));
Node := Node^.Next;
end;
ReleaseDC(HWindow, DC);
end;
procedure TExpert.CMFileOpen(var Msg: TMessage);
const
DefExt = 'dat';
var
OpenFN : TOpenFileName;
Filter : array [0..100] of Char;
FullFileName: TFilename;
WinDir : array [0..145] of Char;
Node : PItem;
AttrList : NestedList;
Attribute : array[0..40] of Char;
Ch : Char;
Str : array[0..40] of Char;
I : Integer;
begin
GetWindowsDirectory(WinDir, SizeOf(WinDir));
SetCurDir(WinDir);
StrCopy(FullFileName, '');
{ Set up a filter buffer to look for Wave files only. Recall that filter
buffer is a set of string pairs, with the last one terminated by a
double-null.
}
FillChar(Filter, SizeOf(Filter), #0); { Set up for double null at end }
StrCopy(Filter, 'Dat Files');
StrCopy(@Filter[StrLen(Filter)+1], '*.dat');
FillChar(OpenFN, SizeOf(TOpenFileName), #0);
with OpenFN do
begin
hInstance := HInstance;
hwndOwner := HWindow;
lpstrDefExt := DefExt;
lpstrFile := FullFileName;
lpstrFilter := Filter;
lpstrFileTitle:= FileName;
flags := ofn_FileMustExist;
lStructSize := sizeof(TOpenFileName);
nFilterIndex := 1; {Index into Filter String in lpstrFilter}
nMaxFile := SizeOf(FullFileName);
end;
If GetOpenFileName(OpenFN) then
begin
I := 0;
FillChar(IName, sizeOf(IName), #0);
FillChar(Attribute, sizeOf(Attribute), #0);
Assign(InFile, FileName);
Reset(InFile);
While not eof(InFile) do
begin
Read(InFile, Ch);
While Ch <> '[' do {construct class name from file}
begin
Move(Ch, IName[I], sizeOf(Ch));
I := I + 1;
Read(InFile, Ch);
end; {While}
I := 0;
Read(InFile, Ch); {Now get Attributes}
While Ch <> ']' do
begin
If Ch <> ',' then
begin
FillChar(Attribute[I], sizeOf(Ch), Ch);
I := I + 1;
end {If <> ','}
else begin
If Length(Attribute) > 0 then
AttrList.NewNode(AHead, ATail, Head, Tail, IName, Attribute);
FillChar(Attribute, sizeOf(Attribute), #0);
I := 0;
end; {else}
Read(InFile, Ch);
end; {While <> ']'}
If Length(Attribute) > 0 then
AttrList.NewNode(AHead, ATail, Head, Tail, IName, Attribute);
Read(InFile, Ch);
Read(InFile, Ch);
I := 0;
FillChar(IName, sizeOf(IName), #0);
FillChar(Attribute, sizeOf(Attribute), #0);
end; {While not eof}
close(Infile);
Show;
end; {If}
end;
procedure TExpert.CMFileSaveAs(var Msg: TMessage);
const
DefExt = 'dat';
var
SaveFN : TOpenFileName;
Filter : array [0..100] of Char;
FullFileName: TFilename;
WinDir : array [0..145] of Char;
Goal : PItem;
Conditions : PAttr;
begin
GetWindowsDirectory(WinDir, SizeOf(WinDir));
SetCurDir(WinDir);
StrCopy(FullFileName, '');
{ Set up a filter buffer to look for Wave files only. Recall that filter
buffer is a set of string pairs, with the last one terminated by a
double-null.
}
FillChar(Filter, SizeOf(Filter), #0); { Set up for double null at end }
StrCopy(Filter, 'Dat Files');
StrCopy(@Filter[StrLen(Filter)+1], '*.dat');
FillChar(SaveFN, SizeOf(TOpenFileName), #0);
with SaveFN do
begin
hInstance := HInstance;
hwndOwner := HWindow;
lpstrDefExt := DefExt;
lpstrFile := FullFileName;
lpstrFilter := Filter;
lpstrFileTitle:= FileName;
flags := ofn_FileMustExist;
lStructSize := sizeof(TOpenFileName);
nFilterIndex := 1; {Index into Filter String in lpstrFilter}
nMaxFile := SizeOf(FullFileName);
end;
if GetSaveFileName(SaveFN) then
begin
Goal := ListPtr;
Conditions := Goal^.Prop;
Assign(OutFile, FileName);
Rewrite(OutFile);
while Goal <> nil do
begin
write(OutFile, Goal^.ItemName);
write(OutFile,'[');
while Conditions <> nil do
begin
write(OutFile, Conditions^.Attribute);
Conditions := Conditions^.ANext;
If Conditions <> nil Then
write(OutFile, ',');
end;
writeln(OutFile, ']');
Goal := Goal^.Next;
If Goal <> nil then
Conditions := Goal^.Prop;
end;
close(Outfile);
end;
end;
procedure TExpert.CMSearch;
var
ExpList : SList;
SearchStr : array[0..40] of Char;
begin
StrPCopy(SearchStr,'');
Application^.ExecDialog(New(PInputDialog, Init(@Self,'Search Item',
'Enter Item:', SearchStr, Sizeof(SearchStr))));
If ExpList.Search(Head, SearchStr) <> nil Then
MessageBox(HWindow, SearchStr, 'Item found: ',mb_OK)
Else
MessageBox(HWindow, SearchStr, 'Item NOT found: ',mb_OK);
Show;
end;
procedure TExpert.CMFindAttr;
var
TmpPStr, SearchStr : array[0..40] of Char;
Classification : String;
begin
StrPCopy(SearchStr,'');
Application^.ExecDialog(New(PInputDialog, Init(@Self,'Search Item',
'Enter Item:', SearchStr, Sizeof(SearchStr))));
StrCopy(AName, SearchStr);
If (Length(AName) <> 0) and (Head <> nil) then
Begin
Classification := SearchItemList(Head, AName);
If Length(Classification) <> 0 Then
Begin
StrCat(SearchStr,' is an attribute of ');
StrPCopy(TmpPStr, Classification);
StrCat(SearchStr, TmpPStr);
MessageBox(HWindow, SearchStr, 'Attribute found: ',mb_OK)
end
else
MessageBox(HWindow, SearchStr, 'Attribute NOT found: ',mb_OK);
end;
Show;
end;
procedure TExpert.CMForChain;
begin
Application^.ExecDialog(New(PTestDialog, Init(@Self, 'DIAL1')));
end;
procedure TExpert.CMBackChain(var Msg: TMessage);
var
TmpPStr, SearchStr : array[0..40] of Char;
Inferred : Integer;
begin
StrPCopy(SearchStr,'');
Application^.ExecDialog(New(PInputDialog, Init(@Self,'Search Item',
'Enter Item:', SearchStr, Sizeof(SearchStr))));
Inferred := Inference(SearchStr, ListPtr);
If Inferred = YesBtn then
MessageBox(HWindow, 'Goal proved', 'Message', MB_OK)
else
MessageBox(HWindow, 'Cannot prove Goal', 'Message', MB_OK);
Show;
end;
procedure TExpert.ClearFacts(var Msg : TMessage);
var
Expert : TExpertApp;
ExpList : SList;
AttrList : NestedList;
begin
ExpList.FreeList;
ListPtr := nil;
NListPtr := nil;
Head := nil; AHead := nil;
Tail := nil; ATail := nil;
MessageBox(HWindow, 'Knowledge Base Cleared!', '',mb_OK);
end;
procedure TExpert.CMQuit;
begin
PostQuitMessage(0);
end;
{ Displays the program's About Box dialog.}
procedure TExpert.CMAbout(var Msg: TMessage);
begin
Application^.ExecDialog(New(PDialog, Init(@Self, PChar('DIAL4'))));
end;
{ Main }
var
Expert : TExpertApp;
Begin
Expert.Init('WinExpert');
Expert.Run;
Expert.Done;
end.
<a name="0295_0011">
<a name="0295_0012">[LISTING TWO]<a name="0295_0012">
Unit Lists;
Interface
Type
PAttr = ^Attr;
Attr = record
Attribute : array[0..40] of Char;
ANext : PAttr;
end;
PItem = ^Item;
Item = record
ItemName : array[0..40] of Char;
Prop : PAttr;
Next : PItem;
end;
PList = ^SList;
SList = object
Node : PItem;
constructor Init;
destructor Done; virtual;
procedure FreeList;
procedure AddNode(var Head, Tail : PItem; NewName : PChar);
function Search(Head : PItem; Name : PChar) : PItem;
function GetAttr(Key : PChar) : PAttr;
end;
PNestedList = ^NestedList;
NestedList = object(SList)
NNode : PAttr;
constructor Init;
procedure FreeList;
procedure NewNode(var AHead, ATail : PAttr; var Head, Tail : PItem;
IName, NewAttr : PChar);
function Search(Head : PAttr; Attribute : PChar) : Boolean;
end;
function SearchItemList( Head : PItem; Attribute : PChar): String;
var
ListPtr : PItem;
NListPtr : PAttr;
Implementation
Uses WinDOS, WObjects, WinTypes, Strings, WinProcs;
{ ----------------------- }
{ NestedList methods }
{ ----------------------- }
constructor NestedList.Init;
begin
NNode := nil;
end;
procedure NestedList.FreeList;
begin
NNode := NListPtr;
while NNode <> nil do
begin
Dispose(NNode);
NNode := NNode^.ANext;
end;
end;
procedure NestedList.NewNode (var AHead, ATail : PAttr; var Head, Tail : PItem;
IName, NewAttr : PChar);
var
ANode : PAttr;
LPtr : PItem;
begin
LPtr := SList.Search(Head, IName);
If LPtr = nil Then
begin
AddNode(Head, Tail, IName);
New(ANode);
AHead := ANode;
ATail := ANode;
ANode^.ANext := nil;
StrCopy(ANode^.Attribute, NewAttr);
LPtr := SList.Search(Head, IName);
LPtr^.Prop := ANode;
end
Else {Item already exists-add ANode to existing}
begin
New(ANode);
AHead := LPtr^.Prop;
ATail^.ANext := ANode;
ATail := ANode;
ANode^.ANext := nil;
StrCopy(ANode^.Attribute, NewAttr);
end;
end;
function NestedList.Search ( Head : PAttr; Attribute : PChar) : Boolean;
var
I : Integer;
begin
Search := False;
NNode := Head;
While NNode <> nil do
begin
I := StrIComp(NNode^.Attribute, Attribute);
If I = 0 then
begin
Search := True;
Exit;
end;
NNode := NNode^.ANext;
end;
end;
function SearchItemList( Head : PItem; Attribute : PChar): String;
var
Node : PItem;
ANode : PAttr;
AttrList : NestedList;
begin
Node := Head;
ANode := Node^.Prop;
SearchItemList := '';
While Node <> nil do
begin
If not AttrList.Search(ANode, Attribute) then
begin
Node := Node^.Next;
If Node <> nil Then
ANode := Node^.Prop;
end
else
begin
SearchItemList := Node^.ItemName;
Exit;
end;
end;
end;
{ ----------------------- }
{ List methods }
{ ----------------------- }
constructor SList.Init;
begin
ListPtr := nil;
Node := nil;
end;
Destructor SList.Done;
begin
FreeList;
end;
procedure SList.FreeList;
var
AttrList : NestedList;
begin
Node := ListPtr;
while Node <> nil do
begin
NListPtr := Node^.Prop;
Dispose(Node);
AttrList.FreeList;
Node := Node^.Next;
end;
end;
{ Insert a New Item in the list }
procedure SList.AddNode (var Head, Tail : PItem; NewName : PChar);
var
Added : PItem;
begin
New(Added);
If Head = nil then
begin
Head := Added;
Tail := Added;
ListPtr := Added;
end
Else begin
Tail^.Next := Added;
Tail := Added;
end;
Node := Head;
Added^.Next := nil;
StrCopy(Added^.ItemName, NewName);
end;
{ Search for a specified Item - return pointer if found }
function SList.Search ( Head : PItem; Name : PChar) : PItem;
var
I : Integer;
begin
Search := nil;
Node := Head;
While Node <> nil do
begin
I := StrIComp(Node^.ItemName, Name);
If I = 0 then
begin
Search := Node;
Exit;
end;
Node := Node^.Next;
end;
end;
{Search for an Attribute and return pointer to its list}
function SList.GetAttr(Key : PChar) : PAttr;
var
I : Integer;
Begin
GetAttr := nil;
Node := ListPtr;
While Node <> nil do
begin
I := StrIComp(Node^.ItemName, Key);
If I = 0 then
begin
GetAttr := Node^.Prop;
Exit;
end
else
Node := Node^.Next
end;
end;
end.
Copyright © 1992, Dr. Dobb's Journal
