STRUCTURED PROGRAMMING
Poly Want An Object?
Jeff Duntemann, K16RA
The toughest nut to crack in OOP's very full bowl of new concepts is certainly polymorphism, which sounds more like a developmental defect in parrots than a programming technique. Its very mystical - magical (dare I say legendary?) sound makes it irresistible to marketing types and other hypesters, few of whom can even pronounce it, much less tell you what it means.
Tersely put, polymorphism is the ability of different objects to respond in their own way to a single directive. I'm reminded of that point in Cole Porter's Kiss Me, Kate where Lois sings, "I'm always true to you, Darling, in my fashion . . ." As Cole Porter fans know, being true means one thing to most people and quite something else again to Lois.
But that's polymorphism in a nutshell. If each object in a group of five objects has a method that edits the object's internal data you, the programmer (as the user of the objects) don't have to know the specifics of editing each type of data within each of the five objects. One command -- Edit -- can be given to any of the five objects. Each object will respond to that command by executing an editing routine custom written to serve its own data. An object containing string data might execute a simple line editor. An object containing Boolean data might allow its data to be flipped between its two alternate states on presses of the space bar. An object containing a color value might place a color chart on the screen and allow the user to edit colors by bouncing a pointer along the edges of the chart.
It's all editing -- but each object allows the editing to be done in its own fashion.
OK -- so what? You can always write up an editing routine for each type of data you deal with and then CASE your way to the correct editor for each type of data you encounter:
You don't need object-oriented programming to do that.
True. But let's consider an advanced network-based electronic mail system. People can send you letters, drawings, images, even digitized voice mail over the cable. When something comes in over the net for you, an icon appears in your in-basket area. To read the mail, you have to (in effect) edit each of the different items of mail. Letters can be edited in a text editor; images in an image editor. Voice mail has to be sent to a digital analog converter. So far, so good -- you've got tools for each of those kinds of mail. But ... what happens when you receive a technical drawing in a vector format that you haven't seen before? If you don't have a tool for it, you can't read it. In other words, you must be able to anticipate every different kind of mail that comes down the cable.
Now, if you received complete objects from the net instead of just data, you could simply point at an incoming object of uncertain type and say, "Mr. Oddball Object, start your editor." The object obeys. It brought its own editor along via encapsulation, and it knows how to invoke its editor. Up pops the window and away you go, reading a type of mail you've never encountered before.
(Side note: Executing objects received over a net like this would require runtime dynamic linking and may not be possible using Turbo Pascal in its current form. Such a system, however, is certainly within the realm of object-oriented programming as we will know it within a few years.)
That's what polymorphism is good for: It decreases coupling to the point where a system can accommodate the unexpected. If all elements of a system conform to certain high-level standard directives, the details of implementing those directives can be left to the individual objects without having to "inform" the rest of the system how to deal with those objects in a detailed way.
In other words, if every element of the system knows what it means to "edit," none of the elements need to know how to edit anything except itself.
Each object is thus true to the system specs in its fashion.
That, however, is simply what polymorphism is. How to do it is another question. All object-oriented languages are capable of polymorphism (in fact, if a language can't polymorph it's not object-oriented) and each one implements polymorphism in a slightly different way. In this column I'll be describing Turbo Pascal's mechanisms because I understand them. Once I figure out what QuickPascal is doing beneath the surface (which is not covered in their rather thin little manual) I'll try to explain its innards as well.
Polymorphism depends utterly on another new concept called "late binding." Binding has always existed in Pascal, but like one hand clapping no one took much notice until there was another way to go about it.
Binding is simply the process by which the caller of a routine is given that routine's address. In traditional Pascal and C, binding happens at compile time, or at link time, if a link step is present. (Turbo and QuickPascal both compile and link in one pass, so compilation and linking are actually the same process.) The name of the called routine in the code is replaced by that routine's address. Thus a link between the two is created early in the program's life, and we call it "early binding."
Until object-oriented extensions to Pascal and C were developed, early binding was all the binding there was. Early binding requires that all possible procedure calls be known at compile time, precluding anything like the electronic mail system we described earlier. In an early-bound system, the unexpected is anathema -- all data and all code must be understood before the program is ever run.
Turbo Pascal's system for achieving late binding is elegant and about as fast as such a system is likely to be. It works like this:
All normal procedure calls in Turbo Pascal are early bound. So are calls to all object methods that are not declared as virtual. Virtual methods in Turbo Pascal are methods that are late bound rather than early bound. The new reserved word VIRTUAL is present immediately after the header of all virtual methods.
Not all objects contain virtual methods. Methods default to being static, and are treated the same way as ordinary procedure calls. Unless you hang the reserved word VIRTUAL after a method declaration, that method remains static and early bound.
All objects that do contain virtual methods also contain a little something extra: An invisible data structure called a "virtual method table" (VMT). Each object type with virtual methods has one virtual method table, stored at the beginning of the data segment. The commonest mistake in understanding Turbo Pascal's late binding machinery is to believe that each object instance has its own virtual method table. Not true -- if you have 50 objects of object-type Circle, all 50 use the same VMT. Remember: The type owns the VMT -- not the instance!
The VMT is nothing more than a table of 32-bit addresses. There is one "slot" in the VMT for each virtual method -- defined or inherited -- in the VMT's object type. (Actually, the first 32 bits of the VMT contain non-address information, including the size of the object that owns the VMT. We'll get back to that later on, in connection with constructors and destructors.)
Figure 1 summarizes this admittedly complicated and difficult behind-the-scenes machinery.
The VMT structure in the data segment is created at compile time, when the definition of the object that owns it is encountered by the compiler. The addresses in the VMT (Bullet 1 on Figure 1) are also written at compile time, and never change. This is another source of misunderstanding, the feeling that somehow the addresses in the VMT are swapped around at runtime. Again, not so: The VMT itself is fully created and filled at compile time and does not change in any way after that!
The VMT is created in the lowest portion of the data segment, but it is present in the .EXE image file that Turbo Pascal writes to disk. (More than code is written to disk as part of the .EXE file -- typed constants are placed there as well.)
Remember Bullwinkle's famous recipe for hush-a-boom? (Jay Wardian's cartoon explosion that made no noise while blowing up.) He had in fact only half the piece of paper containing the recipe, leading to his memorable line, "I know how much, but not what of." Late binding is a lot like bringing the two halves of Bullwinkle's recipe together. The VMT is one half, (the "what of") fully created and ready to go in the data segment at compile time. The other half of the recipe (the "how much") resides in an instance of an object type; in other words, in a variable of that type.
There is a link to the VMT inside every object instance. The link is actually the 16-bit offset of the VMT within the data segment. This link is shown in Figure 1 as the arrow marked with Bullet 2. Because Turbo Pascal has only one data segment, we can use a 16-bit offset rather than a full 32-bit segment: offset address.
This link does not exist at compile time, but must be set up after the program begins running. The setup is accomplished by a special kind of method called a "constructor." Constructors were originally invented for C++, and are one of numerous concepts borrowed from C++ by Borland for its object extension to Turbo Pascal. Every object type that has virtual methods must also have a constructor. And, even more important, every object instance's constructor must be called before any virtual method in that instance can be called.
This is serious business. What the constructor does is connect an object instance with its VMT, which contains the addresses of all the object's virtual methods. Without that essential link between the instance and its VMT, Turbo Pascal's late binding machinery will pull a nonsense address out of thin air instead of from the VMT. If you try to call an object instance's virtual method before calling that instance's constructor, execution will launch off into nowhere, and your system will crash hard. At compile time, a call to an object instance's virtual method is not given the address of the virtual method. Instead, it is given the number of the VMT slot that contains the address of the code implementing the virtual method. When the call is made, Turbo Pascal finds the VMT through the link in the instance, and fetches the address from the VMT slot specified in the code generated to implement the call. Then an 8086 CALL is made to that address.
Voila! The two parts of the recipe are brought together, and the making of silent explosives can begin. This time for sure, Rocky!
Now that's just how late binding works; we haven't quite gotten to applying it to polymorphism yet. Polymorphism is the what, remember, and late binding the how.
Polymorphism depends on a property of inheritance: That a pointer to a parent type may also legally point to any child type of that parent type. Consider, for example, the following object hierarchy:
If we define a pointer to type Mail, that pointer could legally point to any of the others beneath Mail in the hierarchy. Similarly, a pointer defined as pointing to Reply could also point to either Image or Secret, but not to Mail. This extended assignment compatibility, like inheritance, moves only down the object hierarchy, never up.
I've sketched out the VMTs of these four hypothetical object types in Figure 2. Keep Figure 2 handy during the following discussion.
Inheritance passes all data and methods defined within Mail down to all the types descended from Mail. If Mail defines four methods, those four methods are also present in Mail's child types. Now here's the critical fact: Any method held in common by all four object types may be called through a pointer to type Mail. That's polymorphism, whether the light has gone on in your head yet or not. But it will, it will.
Suppose you have a linked list of nodes containing pointers to type Mail:
If any kind of electronic mail message is defined as a child object of type Mail, then any message could be added to that linked list. Remember, a MailPtr can point to type Mail or to any child type of Mail. To edit your mail, you would simply traverse the linked list, and call the Edit method of each object pointed to by the MailPtrpointer named Message:
For pointers pointing to Mail objects, Mail.Edit is executed. For pointers pointing to Reply objects, Reply.Edit is executed. For pointers pointing to Image objects, Image.Edit is executed, and so on. However, nowhere in the code shown here is there any admittance at all that there is any type of object in the list other than type Mail. Once a pointer to, say, a Reply object is assigned to a MailPtr pointer, the source code treats the Reply object as though it were a Mail object. Only through late binding does a call to the Edit method get routed to the correct edit method -- that is, the Edit method belonging to type Reply.
So there you have it: Polymorphism allows you to make one virtual method call to several different types of object, and each object then responds as it should, by using the method implementation written to serve its own needs.
It's often been said that Turbo Pascal 5.5 does not support message passing, and in the strictest terms that's true. In true Smalltalk-style message passing a message is sent to an object, and the object takes total responsibility for calling the correct method in response to the message. In Turbo Pascal, by contrast, we call the methods directly.
Well ... yes and no. Certainly we call static methods directly. However, when we call a virtual method, we might think of the call as a message sent to Turbo Pascal's late binding machinery: "I want to call the method accessed through slot 4 of the virtual method table." The late binding machinery then fetches the address from VMT slot 4 and makes the call. It's certainly message passing stripped to the bone, but it's just indirect enough to qualify in my book, and thinking of the VMT mechanism as a sort of message passing can be helpful in understanding just what it is that the VMT does for a living.
Coming up with a short, working, realistic example of polymorphism in action is difficult. Demonstrating polymorphism requires multiple object types and multiple method implementations, which can add up to a lot of code. Listing One, page 154, is about as brief a demo of polymorphism as I could concoct without moving to totally artificial situations; you know, one-line methods that display "Hi boss! This is the Edit method!" on the screen when you execute them. The FIELDS.PAS unit is conceptually similar to the FORMS.PAS unit provided as a demo program with Turbo Pascal 5.5, but simpler and shorter. FIELDTST.PAS (Listing Two, page 159) is a short program that exercises the FIELDS.PAS unit.
FIELDS.PAS defines the short object hierarchy shown below:
Of the object types shown here, TextPosition and Field are abstract object types, that is, types that exist only to be inherited from, or to act as heads of polymorphic families. You never actually create instances of abstract object types. Notice in Listing One that most of type Field's methods are stubs that do nothing. The stubs are there so that Field's children can override them with working substitutes. Stubs or not, slots exist in Field's VMT for each of its virtual methods, and those slots are inherited by all of Field's children.
A field is an object containing data and the means to display and edit that data on the screen. Type Field is abstract, and contains no data of its own. Each of its children represents a different kind of data: string data, Boolean data, and integer data. Type Field and all its children have three virtual methods: Show, Hide, and Edit. Show displays the field's data at its current screen position, and Hide erases it from that position. Edit allows the user to modify the data in an appropriate way.
Listing One was written to be blatantly obvious rather than clever. Notice these things:
Reading the Mail
CASE DataType OF
DBoolean :EditBooleanData;
DString :EditString;
DInteger :EditIntegerData;
ColorValue :EditColorValue;
etc...
Bound for Glory
Virtual Method Tables
"How Much, But Not What of ..."
Family Resemblances
Mail
|_Reply
|_Image
|_Secret
TYPE
MailPtr = ail;
NodePtr = ^Node;
{Node in the linked list:}
Node = RECORD
Message: MailPtr;
Next : NodePtr;
END;
VAR
Current, ListRoot : NodePtr;
. . .
Current := ListRoot;
WHILE Current < > NIL DO
BEGIN
Current^.Message^.Edit;
{Virtual method call:}
Current := Current^.Next
END;
Message Passing, Turbo-Style
Think of It as Polymorphism in Action
TextPosition
|_Field
|_BooleanField
|_TextField
|_IntField
With all of that in mind, I'll leave the rest of digesting Listing One up to you. Listing Two is where the polymorphism happens, and it deserves a closer look.
Objects Under Construction
Listing Two defines an array of four FieldPtr pointers, which point to type Field. These pointers are given objects on the heap through calls to New, as with any dynamically-allocated data item. The Turbo Pascal 5.5 twist is the New syntax. New can now be used as a function, much the same as malloc in C:
<pointer var>:=New(<its pointer type>);
Note that this applies to all uses of New, not only those with OOP connections. No, the OOP twist-within-a-twist is the invocation of constructors from within the New call:
<pointer to object> := New(<compatible object type>, <constructor call>);This syntax allows you to allocate and initialize an object with one statement, and do it without having to use a temporary pointer variable to hold the allocated object.
Note well that the type of the pointer on the left side of the assignment statement only has to be compatible with (not identical to!) the pointer type given in the New call:
FieldArray[1]:= New(TextFieldPtr...
Here, FieldArray[I] is type FieldPtr, whereas New calls out a pointer of type TextFieldPtr. Because TextField is a child of Field, their pointers are compatible. New allocates an object of type TextField on the heap, while returning a pointer of type Field to FieldArray[I]. Thus the New call is setting up the pointers to allow polymorphism as well. That's a lot of mileage from a single New call!
A reminder: You must call the constructor of each object instance before using that instance. Turbo Pascal 5.5 includes an extension of range-checking to help you during development. With the $R+compiler directive in force, a call to a virtual method made from an uninitialized instance of an object generates a range error rather than DOS McNuggets. As with range checking in general, use it during development, then turn it off once you're satisfied things are correct. (And, of course, when things blow up, the first thing to do is turn the damned thing back on again and see how wrong you were!)
Freedom of Expression
Once you understand the amazing sophistication of the underlying mechanism, the polymorphic calls themselves almost seem an afterthought:
FOR I := 1 TO 4 DO
FieldArray^.Show;
FOR I := 1 TO 4 DO
FieldArray^.Edit;
The first statement steps through the objects attached to the array and displays their initial data on the screen through the Show virtual method. The second steps through the array again, this time editing each object in turn through the Edit virtual method.
The major advantage to polymorphism is that it encourages a unified high-level way of looking at an application, or at least at families of objects. Dealing polymorphically with objects emphasizes their similarities (that is, all data-intensive objects need editing) without letting the details of their differences get in the way of understanding and using them.
I'll be talking about polymorphism in many different contexts in future columns. Digitalk has just released its Smalltalk/V PM for Presentation Manager, and I'll (with some luck) get a chance to describe it in detail in my next column. Conquering the complexity of PM's API is probably the most important single job for polymorphism that I can think of right now, and at first glance Smalltalk/V PM does it beautifully. Stay tuned.
Get-TUG-Gether '89
The Turbo User Group has quietly and with less notice than it deserves been supporting users of Borland languages for almost five years. This year, Don Taylor and the crew have raised their profile considerably by instituting Get-TUG-Gether, a programmer's conference and party to equal anything I have ever attended in that vein. The narrowness of the focus helps. I was not beset by Unix evangelists speaking in their peculiar form of tongues ("awk! grep! yacc!" à la Bill the Cat) nor pinstriped salesmen pushing mainframe computers the size of small counties in Arkansas. Instead, we were a group of 100 or so Turbo hackers trading insights and having a good time. Half a dozen Turbo product vendors displayed and demonstrated their current releases, and I signed books for Judy Overbeek's Rockland Press. Solid technical sessions and small-group discussion sections rounded out the program. Remarkable (for Seattle) weather, a great pool, and the spectacularly dedicated TUG staff made it the best hacker gathering in recent memory.
There will be another Get-TUG-Gether next summer, from June 29 - July 1 and Don has promised more technical tutorials, particularly for nonexperts. (I have already committed to presenting "Pascal Pointers for Beginners" in conjunction with a book I'll be writing on that subject.) It's cheap, it's educational, and it feels good. Forget the invitation-only Elitist Hackers conference in Silicon Valley; this is the future.
Products Mentioned
Turbo Pascal 5.5 Borland International 1800 Green Hills Road Scotts Valley, CA 95066 408-438-8400 Standard package: $149.95 Professional package: $250
Smalltalk/V PM Digitalk Inc. 9841 Airport Blvd. Los Angeles, CA 90045 213-645-1082 $495
Turbo User Group (TUG) TUG Lines newsletter P.O. Box 1510 Poulsbo, WA 98370 BBS: 206-697-1151 Membership: $27 US; $32 Canada/Mexico; $39 elsewhere
_STRUCTURED PROGRAMMING_ by Jeff Duntemann
[LISTING ONE]
Copyright © 1989, Dr. Dobb's Journal<a name="0245_0010">
Unit Fields;
INTERFACE
USES Crt;
CONST
IntChars = ['0'..'9','-'];
TextChars = [#0..#255];
Visible = True;
Invisible = False;
TYPE
String10 = String[10];
String80 = String[80];
CharSet = SET OF Char;
PositionPtr = ^TextPosition;
TextPosition = { ABSTRACT! }
OBJECT
X,Y : Integer; { Coordinates of location on the screen }
CONSTRUCTOR Init(InitX,InitY : Integer);
FUNCTION XPos : Integer;
FUNCTION YPos : Integer;
END;
FieldPtr = ^Field;
Field = { ABSTRACT! }
OBJECT(TextPosition)
VisibleState : Boolean; { True = Field is displayed }
CONSTRUCTOR Init(InitX,InitY : Integer;
InitVisible : Boolean);
FUNCTION IsVisible : Boolean;
PROCEDURE MoveTo(NewX,NewY : Integer);
PROCEDURE Show; VIRTUAL;
PROCEDURE Hide; VIRTUAL;
PROCEDURE Edit; VIRTUAL;
END;
TextFieldPtr = ^TextField;
TextField = { For ordinary text strings }
OBJECT(Field)
StringData : String80;
FieldLength : Integer;
CONSTRUCTOR Init(InitX,InitY : Integer;
InitVisible : Boolean;
InitText : String80;
InitLength : Integer);
FUNCTION GetData : String80;
PROCEDURE Show; VIRTUAL;
PROCEDURE Hide; VIRTUAL;
PROCEDURE Edit; VIRTUAL;
END;
BooleanFieldPtr = ^BooleanField;
BooleanField =
OBJECT(Field)
Toggle : Boolean;
TrueString,FalseString : String80;
CONSTRUCTOR Init(InitX,InitY : Integer;
InitVisible : Boolean;
InitToggle : Boolean;
InitTrueStr,
InitFalseStr : String80);
FUNCTION Getdata : Boolean;
PROCEDURE Show; VIRTUAL;
PROCEDURE Hide; VIRTUAL;
PROCEDURE Edit; VIRTUAL;
END;
IntFieldPtr = ^IntField;
IntField =
OBJECT(TextField)
IntVal : Integer;
CONSTRUCTOR Init(InitX,InitY : Integer;
InitVisible : Boolean;
InitIntVal : Integer);
FUNCTION GetData : Integer;
PROCEDURE Show; VIRTUAL;
PROCEDURE Edit; VIRTUAL;
END;
IMPLEMENTATION
VAR
Blanker : String80;
FUNCTION MaxLength(String1,String2 : String) : Integer;
BEGIN
IF Length(String1) > Length(String2) THEN
MaxLength := Length(String1)
ELSE
MaxLength := Length(String2);
END;
PROCEDURE ShowBlanks(NumberOfBlanks : Integer);
BEGIN
Write(Copy(Blanker,1,NumberOfBlanks));
END;
PROCEDURE HighLight(X,Y,TargetLength : Integer; TargetText : String);
BEGIN
GotoXY(X,Y); ShowBlanks(TargetLength);
GotoXY(X,Y); Write(TargetText);
END;
PROCEDURE UhUh;
BEGIN
Sound(35); { Make first grunt }
Delay(100);
NoSound;
Delay(50); { Delay between grunts }
Sound(35); { Make second grunt }
Delay(100);
NoSound;
Delay(50); { Delay after second grunt }
END;
PROCEDURE GetLine(X,Y : Integer;
VAR MyLine : String80;
MaxWidth : Integer;
LegalChars : CharSet);
VAR
Ch : Char;
Quit,Done : Boolean;
TempLine : String;
WorkPoint : Integer;
PROCEDURE DisplayLine;
BEGIN
GotoXY(X,Y);
Write(TempLine);
END;
BEGIN
Quit := False; Done := False;
TempLine := MyLine;
DisplayLine;
REPEAT
IF KeyPressed THEN
BEGIN
WorkPoint := (WhereX-X) + 1;
Ch := ReadKey;
CASE Ord(Ch) OF
0 : BEGIN { If the first char is 0, there's more... }
Ch := ReadKey; { Get the second portion }
CASE Ord(Ch) OF
71 : GotoXY(X,Y); { Home }
79 : GotoXY(X + Length(TempLine),Y);
75 : IF WorkPoint <= 1 THEN Uhuh { Left Arrow }
ELSE
BEGIN
Dec(WorkPoint);
GotoXY(X+WorkPoint-1,Y);
END;
83 : BEGIN { Del }
Delete(TempLine,WorkPoint,1);
DisplayLine;
Write(' ');
GotoXY(X+WorkPoint-1,Y);
END;
END { case }
END;
8 : IF WorkPoint <= 1 THEN Uhuh
ELSE
BEGIN
Dec(WorkPoint); { Move left one position }
Delete(TempLine,WorkPoint,1); { Delete a char in string }
DisplayLine; { Re-display the string }
Write(' '); { Erase the last char }
GotoXY(X+WorkPoint-1,Y); { And put the cursor back }
END; { to the correct position }
13 : Done := True; { Enter }
27 : Quit := True; { Esc }
32..254 : IF Ch IN LegalChars THEN
IF Length(TempLine) >= MaxWidth THEN UhUh
ELSE
BEGIN
Insert(Ch,TempLine,WorkPoint);
DisplayLine;
GotoXY(X+WorkPoint,Y);
END
ELSE Uhuh;
END { case }
END;
UNTIL Done OR Quit;
IF Done THEN MyLine := TempLine;
END;
{------------------------------------------------------------------}
{ All of the following routines are method implementations }
{------------------------------------------------------------------}
CONSTRUCTOR TextPosition.Init(InitX,InitY : Integer);
BEGIN
X := InitX; Y := InitY;
END;
FUNCTION TextPosition.XPos : Integer;
BEGIN
XPos := X;
END;
FUNCTION TextPosition.YPos : Integer;
BEGIN
YPos := Y;
END;
CONSTRUCTOR Field.Init(InitX,InitY : Integer;
InitVisible : Boolean);
BEGIN
TextPosition.Init(InitX,InitY);
VisibleState := InitVisible;
END;
FUNCTION Field.IsVisible : Boolean;
BEGIN
IsVisible := VisibleState;
END;
PROCEDURE Field.MoveTo(NewX,NewY : Integer);
BEGIN
IF IsVisible THEN Hide;
X := NewX;
Y := NewY;
IF IsVisible THEN Show;
END;
PROCEDURE Field.Show;
BEGIN
END;
PROCEDURE Field.Hide;
BEGIN
END;
PROCEDURE Field.Edit;
BEGIN
END;
CONSTRUCTOR TextField.Init(InitX,InitY : Integer;
InitVisible : Boolean;
InitText : String80;
InitLength : Integer);
BEGIN
Field.Init(InitX,InitY,InitVisible);
StringData := InitText;
FieldLength := InitLength;
IF InitVisible THEN Show;
END;
FUNCTION TextField.Getdata : String80;
BEGIN
Getdata := StringData;
END;
PROCEDURE TextField.Show;
BEGIN
GotoXY(XPos,YPos);
Write(StringData);
VisibleState := True;
END;
PROCEDURE TextField.Hide;
BEGIN
GotoXY(XPos,YPos);
ShowBlanks(FieldLength);
VisibleState := False;
END;
PROCEDURE TextField.Edit;
VAR
AttributeStash : Byte;
BEGIN
IF IsVisible THEN
BEGIN
AttributeStash := TextAttr;
TextAttr := $70;
HighLight(XPos,YPos,FieldLength,StringData);
GetLine(XPos,YPos,StringData,FieldLength,TextChars);
TextAttr := AttributeStash;
HighLight(XPos,YPos,FieldLength,StringData);
END;
END;
CONSTRUCTOR BooleanField.Init(InitX,InitY : Integer;
InitVisible : Boolean;
InitToggle : Boolean;
InitTrueStr,
InitFalseStr : String80);
BEGIN
Field.Init(InitX,InitY,InitVisible);
Toggle := InitToggle;
TrueString := InitTrueStr;
FalseString := InitFalseStr;
IF InitVisible THEN Show;
END;
FUNCTION BooleanField.Getdata : Boolean;
BEGIN
Getdata := Toggle;
END;
PROCEDURE BooleanField.Show;
BEGIN
GotoXY(XPos,YPos);
IF Toggle THEN Write(TrueString)
ELSE Write(FalseString);
VisibleState := True;
END;
PROCEDURE BooleanField.Hide;
BEGIN
GotoXY(XPos,YPos);
IF Toggle THEN ShowBlanks(Length(TrueString))
ELSE ShowBlanks(Length(FalseString));
VisibleState := False;
END;
PROCEDURE BooleanField.Edit;
VAR
Ch : Char;
Done,Quit : Boolean;
SaveState : Boolean;
AttributeStash : Byte;
BEGIN
IF IsVisible THEN { Only edit if it's visible... }
BEGIN
SaveState := Toggle; Done := False; Quit := False;
AttributeStash := TextAttr; TextAttr := $70;
HighLight(XPos,YPos,MaxLength(TrueString,FalseString),'');
Show;
REPEAT
IF KeyPressed THEN { If there's a keystroke waiting }
BEGIN
Ch := ReadKey; { go get it... }
CASE Ord(Ch) OF { and parse it. }
0 : Ch := ReadKey; { Get second half of extended char; ignore it }
13 : Done := True; { Enter means accept current state of Toggle }
27 : Quit := True; { Esc means restore Toggle as it was on entry }
ELSE BEGIN { Another other ASCII key: Flip Toggle }
Hide; { Erase the current state string }
Toggle := NOT Toggle; { Flip Toggle to its opposite state }
Show; { Display the alternate state string }
END;
END; { CASE }
END;
UNTIL Done OR Quit;
IF Quit THEN
BEGIN
Hide; { Erase current display of state string }
Toggle := SaveState; { Restore original state of Toggle }
Show; { And re-display it }
END;
TextAttr := AttributeStash;
HighLight(XPos,YPos,MaxLength(TrueString,FalseString),'');
Show;
END;
END;
CONSTRUCTOR IntField.Init(InitX,InitY : Integer;
InitVisible : Boolean;
InitIntVal : Integer);
VAR
WorkString : String10;
BEGIN
Str(InitIntVal : 6,WorkString);
TextField.Init(InitX,InitY,InitVisible,WorkString,6);
IntVal := InitIntVal;
IF InitVisible THEN Show;
END;
FUNCTION IntField.Getdata : Integer;
BEGIN
Getdata := IntVal;
END;
PROCEDURE IntField.Show;
BEGIN
Str(IntVal : 6,Stringdata);
TextField.Show;
END;
{-------------------------------------------------------------------}
{ Notice that there is NO IntField.Hide! The mechanism for erasing }
{ an integer field is no different from erasing any string field, }
{ so objects of type IntField use the Hide method inherited from }
{ TextField. }
{-------------------------------------------------------------------}
PROCEDURE IntField.Edit;
VAR
WorkValue,ErrorPos : Integer;
AttributeStash : Byte;
BEGIN
IF IsVisible THEN { Only edit an object if it's visible... }
BEGIN
AttributeStash := TextAttr;
TextAttr := $70;
Str(IntVal : 6,StringData); { Convert the integer value to a string }
HighLight(XPos,YPos,Length(StringData),Stringdata);
REPEAT { And edit the string until it's right }
GetLine(XPos,YPos,StringData,FieldLength,IntChars);
Val(Stringdata,WorkValue,ErrorPos);
IF ErrorPos <> 0 THEN Uhuh;
UNTIL ErrorPos = 0;
IntVal := WorkValue;
TextAttr := AttributeStash;
HighLight(XPos,YPos,Length(StringData),StringData);
END;
END;
BEGIN
FillChar(Blanker,SizeOf(Blanker),' ');
Blanker[0] := Chr(80);
END.
<a name="0245_0011"><a name="0245_0011">
<a name="0245_0012">[LISTING TWO]<a name="0245_0012">
PROGRAM FieldTest;
USES Crt,
Fields; { Published in DDJ November 1989 }
CONST
Female = True;
Male = NOT Female;
VAR
FieldArray : ARRAY[1..4] OF FieldPtr;
I : Integer;
BEGIN
ClrScr;
Writeln('Patient name: ');
Writeln(' sex: ');
Writeln(' age: ');
Writeln(' Physician: ');
{ Initialize the objects on the heap & provide initial values: }
FieldArray[1] := New(TextFieldPtr,Init(15,1,Invisible,'Jones,Tom',40));
FieldArray[2] := New(BooleanFieldPtr,Init(15,2,Invisible,
Female,'Female','Male'));
FieldArray[3] := New(IntFieldPtr,Init(15,3,Invisible,42));
FieldArray[4] := New(TextFieldPtr,Init(15,4,Invisible,'Dr. Asimov',40));
{ First display initial values through polymorphic calls to Show: }
FOR I := 1 TO 4 DO FieldArray[I]^.Show;
{ Now edit each one through a polymorphic call to the Edit method: }
FOR I := 1 TO 4 DO FieldArray[I]^.Edit;
END.
