Power-Programmierung/CD1.mdf/magazine/drdobbs/1989/11/dunteman.lst

File List | 1989-10-04 | 13KB | 544 lines

_STRUCTURED PROGRAMMING_
by Jeff Duntemann

[LISTING ONE]

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.


[LISTING TWO]

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.