ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MAGAZINE/MISC/PCTV2N1.ZIP/WATCH.PAS

Pascal/Delphi Source File | 1991-02-07 | 14.0 KB | 499 lines

Unit Watch;

  { This unit provides watch variable capabilities to object-oriented
    Turbo Pascal programs.

    Written by Rick Gessner, 1990.  }

Interface {-----------------------------------------------------}

  Const MaxListItems = 10;
  Type
    StringPtr = ^String;
    FormatSet = Set of (AsRecord,AsDefault);

    PointPtr = ^Point;
    Point = Object
      X,Y     : Integer;
      CONSTRUCTOR Init(Xpos,Ypos: Integer);
      DESTRUCTOR  Done;
      PROCEDURE   MoveTo(NewX,NewY: Integer);
      FUNCTION    WhereXPos: Integer;
      FUNCTION    WhereYPos: Integer;
      PROCEDURE   Show; Virtual;
      FUNCTION    Who_Am_I: StringPtr; Virtual;
      FUNCTION    Describe( FNum: Integer;
                            As: FormatSet): String; Virtual;
      FUNCTION    Find_Var( Identifier: String;
                            Var FNum: Integer): PointPtr; Virtual;
    end; {Point}

    Square = Object(Point)
      BotRight  : Point;
      CONSTRUCTOR Init(x1,y1,x2,y2: Integer);
      FUNCTION    Width : Integer;
      FUNCTION    Height: Integer;
      DESTRUCTOR  Done;
      PROCEDURE   Show; Virtual;
      FUNCTION    Who_Am_I: StringPtr; Virtual;
      FUNCTION    Describe( FNum: Integer;
                            As: FormatSet): String; Virtual;
      FUNCTION    Find_Var( Identifier: String;
                            Var FNum: Integer): PointPtr; Virtual;
    end; {Square}
    SquarePtr = ^Square;

    TextWindow = Object(Square)
      Heading  :  String;
      CONSTRUCTOR Init(x1,y1,x2,y2: integer; Header: String);
      DESTRUCTOR  Done;
      PROCEDURE   Show; Virtual;
      FUNCTION    Who_Am_I: StringPtr; Virtual;
      FUNCTION    Describe( FNum: Integer;
                            As: FormatSet): String; Virtual;
      FUNCTION    Find_Var( Identifier: String;
                            Var FNum: Integer): PointPtr; Virtual;
    end; {TextWindow}
    TextWindowPtr = ^TextWindow;

    List = Object(Point)
      ListName :  String;
      Count    :  Integer;
      Elements :  Array[1..MaxListitems] of PointPtr;
      CONSTRUCTOR Init(Name: String);
      DESTRUCTOR  Done;
      FUNCTION    Add_Element(Item: PointPtr): Integer;
      PROCEDURE   Show; Virtual;
      FUNCTION    Who_Am_I: StringPtr; Virtual;
      FUNCTION    Describe( FNum: Integer;
                            As: FormatSet): String; Virtual;
      FUNCTION    Find_Var( Identifier: String;
                            Var FNum: Integer): PointPtr; Virtual;
    end; {List}
    ListPtr = ^List;

    WatchPtr= ^Point;
    WatchObj = Object(Point)
      TheVar,
      VarList : PointPtr;
      FieldNum: Integer;
      Format  : FormatSet;
      Spec    : String;
      CONSTRUCTOR Init(Xpos,Ypos: Integer; Vars: PointPtr);
      DESTRUCTOR  Done;
      PROCEDURE   Show; Virtual;
      PROCEDURE   Get_Format_Specifiers(Identifier: String);
      FUNCTION    Describe( FNum: Integer;
                            As: FormatSet): String; Virtual;
      FUNCTION    Find_Var( Identifier: String;
                            Var FNum: Integer): PointPtr; Virtual;
    end; {WatchObj}

  Implementation {----------------------------------------------}

  Uses Dos,Crt;

  Const Pads   : Array[Boolean] of String[1] = ('',',');
        Prefix : Array[Boolean] of String[1] = ('','(');
        Suffix : Array[Boolean] of String[1] = ('',')');
        MaxLists   = 20;
        UnknownIdentifier = -1;
        ConstantOutOfRange = -2;

  { Auxillary Routines... }

  FUNCTION Get_Next_Word(Var Expr: String): String;
  Var I,Len: Integer;
  Begin
     I:=1; Len:=0; Get_Next_Word := '';
     While (Expr[I] in ['.',' ']) and (I<Length(Expr)) do Inc(I);
     If Expr[I]=' ' then Exit else
     Begin
       Case Upcase(Expr[i]) of
         '[','-','0'..'9':
            Begin
               If Expr[Len+I]='[' then Inc(I);
               While (I+Len<Length(Expr)) and
                    (Expr[Len+I+1] in ['0'..'9','.','-']) do Inc(Len);
               If Expr[Len+I+1]=']' then Delete(Expr,Len+I+1,1);
            end;
         '#','A'..'Z':
            Begin
               Expr[I+Len]:=UpCase(Expr[I+Len]);
               While (I+Len<Length(Expr)) and
                     (Expr[Len+I+1] in
                      ['#','A'..'Z','a'..'z','0'..'9']) do
                        Begin
                             Inc(Len);
                             Expr[I+Len]:=UpCase(Expr[I+Len]);
                        end; {While}
            end;
            else Exit;
       end; {Case}
       Get_Next_Word := Copy(Expr,I,Len+1);
       Delete(Expr,1,I+Len);
     end; {if}
  end; { Get next word }

  FUNCTION Upcase_String(S : String) : String;
  {Function returns the string S, with all uppercase letters.}
  Var StrPos: Integer;
  Begin
     For StrPos:= 1 to Length(S) do S[StrPos]:=Upcase(S[StrPos]);
     Upcase_String:= S;
  end; {UpCase String}


 { Point Methods: }

  CONSTRUCTOR Point.Init(xpos,ypos: integer);
  Begin
     MoveTo(XPos,YPos);
  end; {init}

  PROCEDURE Point.MoveTo(NewX,NewY: Integer);
  Begin
     X := NewX; Y:=NewY
  end; {moveto}

  FUNCTION Point.WhereXPos: Integer;
  Begin
     WhereXPos := X
  end; {whereXpos}

  FUNCTION Point.WhereYPos: Integer;
  Begin
     WhereYPos := Y
  end; {WhereYPos}

  DESTRUCTOR Point.Done;
  Begin
     {abstract}
  end; {done}

  PROCEDURE Point.Show;
  Begin
     {abstract}
  end; {show}

  FUNCTION Point.Who_Am_I: StringPtr;
  Begin
     Who_Am_i:=Nil;
  end; {Who am I}

  FUNCTION Point.Describe(FNum: Integer; As: FormatSet): String;
  Const FNames : Array[Boolean,1..2] of String[3] =
                    (('',''),('X:','Y:'));
  Var S,S1: String;
      Stop,Num : Integer;
  Begin
     S:=Prefix[FNum=0];
     If Fnum>2 then Dec(FNum,2);
     If FNum=0 then Stop:=2 else Stop:=Fnum;
     For Num:=FNum to Stop do
        Case Num of
           1 : Begin
                  Str(WhereXPos,S1);
                  S:=S+FNames[As=[AsRecord],Num]+S1+
                     Pads[(Fnum<>Stop) and (Num<>Stop)];
               end;
           2 : Begin
                  Str(WhereYPos,S1);
                  S:=S+Fnames[As=[AsRecord],Num]+S1+
                     Pads[(Fnum<>Stop) and (Num<>Stop)];
               end;
        end; {case}
       Describe:=S+Suffix[FNum=0];
  end; {describe}

  FUNCTION Point.Find_Var( Identifier: String;
                           Var FNum: Integer): PointPtr;
  Const  FieldCount = 2;
         FieldNames : Array[1..FieldCount] of String[1] = ('X','Y');
  Var    FieldNum : Integer;
         NextWord : String;
  Begin
     NextWord:=Get_next_Word(Identifier);
     Find_Var:=@Self;
     FieldNum:=0;
     Repeat
           Inc(FieldNum)
     Until (FieldNames[FieldNum]=NextWord) or (FieldNum=FieldCount);
     If FieldNames[FieldNum]=NextWord then FNum:=FieldNum else
        If NextWord<>'' then Find_Var:=Nil;
  end; {find var}

  { Square Methods: }

  CONSTRUCTOR Square.Init(X1,Y1,X2,Y2: integer);
  Begin
     Point.Init(X1,Y1);
     BotRight.Init(X2,Y2);
  end; {init}

  DESTRUCTOR Square.Done;
  Begin
     Point.Done;
     BotRight.Done;
  end; {done}

  FUNCTION Square.Width : Integer;
  Begin
     Width := BotRight.WhereXPos-WhereXPos;
  end; {width}

  FUNCTION Square.Height: Integer;
  Begin
     Height := BotRight.WhereYPos-WhereYPos;
  end; {Height}

  PROCEDURE Square.Show;
  Type   BoxPos = (TopL,TopR,BotL,BotR,Top,Bot,LSide,RSide);
  Const  Boxchar: Array[TopL..RSide] of char =
                    ('┌','┐','└','┘','─','─','│','│');
  Var    I      : Integer;
         S      : String;
  Begin
     Window(WhereXPos,WhereYPos,WhereXPos+Width,WhereYPos+Height);
     ClrScr;
     Write(BoxChar[TopL]);                       {Top left corner}
     For I:=1 to Width-1 do Write(BoxChar[Top]); {Top of square}
     Write(BoxChar[TopR]);                       {Top right corner}
     For I:=2 to Height do  {Draw middle lines}
     Begin
        GotoXY(1,I);
        Write(BoxChar[LSide]);
        GotoXY(Width+1,I);
        Write(BoxChar[RSide]);
     end;
     GotoXY(1,Height+1);
     Write(BoxChar[BotL]);
     For I:=1 to Width-1 do Write(BoxChar[Bot]); {Square bottom}
     Window(1,1,80,25);
     Gotoxy(whereXPos+Width,WhereYPos+Height);
     Write(BoxChar[BotR]);
  end; {show}

  FUNCTION Square.Who_Am_I: StringPtr;
  Begin
     Who_Am_I:=Nil;
  end; {Who am I}

  FUNCTION Square.Describe(FNum: Integer; As: FormatSet): String;
  Const FName : Array[Boolean] of String[10] = ('','BOTRIGHT:');
  Var S : String;
  Begin
     S:=Prefix[FNum=0];
     If FNum<3 then S:=S+Point.Describe(FNum,As)+Pads[Fnum=0];
     If FNum in [0,3,4] then
        S:=S+FName[As=[AsRecord]]+BotRight.Describe(FNum,As);
     Describe:=S+Suffix[FNum=0];
  end; {describe}

  FUNCTION Square.Find_Var( Identifier: String;
                            Var FNum: Integer): PointPtr;
  Var  FieldNum : Integer;
       NextWord : String;
  Begin
     NextWord:=Get_next_Word(Identifier);
     Find_Var:=@Self;
     If NextWord = 'BOTRIGHT' then
        Find_Var:=BotRight.Find_Var(Identifier,FNum) else
        Find_Var:=Point.Find_Var(NextWord+Identifier,FNum);
  end; {find var}

  { TextWindow Methods: }

  CONSTRUCTOR TextWindow.Init(X1,Y1,X2,Y2: Integer; Header: String);
  Begin
     Square.Init(X1,Y1,X2,Y2);
     Heading:=Header;
  end; {init}

  DESTRUCTOR TextWindow.Done;
  Begin
     Square.Done;
  end; {done}

  PROCEDURE TextWindow.Show;
  Var I,X1 : Integer;
  Begin
     Square.Show;
     X1 := (Width div 2) - (Length(Heading) div 2);
     Gotoxy(WhereXPos+x1-1,WhereYPos); Write(' ',Heading,' ');
     For I:=1 to 5 do
     Begin
        Gotoxy(WhereXPos+2,WHereYPos+Succ(i));
        Write(Describe(I,[AsRecord]));
     end;
  end; {show}

  FUNCTION TextWindow.Who_Am_I: StringPtr;
  Begin
     Who_Am_I:=@Heading;
  end; {Who am I}

  FUNCTION TextWindow.Describe(FNum: Integer; As: FormatSet): String;
  Const Quote = Chr(39);
        FName : Array[Boolean] of String[10] = ('','HEADING:');
  Var S: String;
  Begin
     S:='';
     S:=S+Square.Describe(FNum,As);
     If (FNum=0) or (FNum=5) then
     Begin
        If Fnum=0 then S[Length(S)]:=',';
        S:=S+Fname[As=[AsRecord]]+Quote+Heading+Quote;
     end;
     Describe:=s+Suffix[FNum=0];
  end; {describe}

  FUNCTION TextWindow.Find_Var( Identifier: String;
                                Var FNum: Integer): PointPtr;
  Var FieldNum : Integer;
      NextWord : String;
  Begin
     NextWord:=Get_next_Word(Identifier);
     Find_Var:=@Self;
     If NextWord = 'HEADING' then FNum:=5 else
        Find_Var:=Square.Find_Var(NextWord+Identifier,FNum)
  end; {find var}

  { List Methods: }

  CONSTRUCTOR List.Init( Name: String);
  Begin
     ListName:=Name;
     Count   :=0;
  end; {init}

  DESTRUCTOR List.Done;
  Begin
     Point.Done;
  end; {done}

  FUNCTION List.Add_Element(Item: PointPtr): Integer;
  Begin
     If Count<MaxListItems then
     Begin
        Inc(Count);
        Elements[count]:=Item;
     end else Add_element:=0;
  end; {Add element}

  PROCEDURE List.Show;
  Begin
     {abstract}
  end; {show}

  FUNCTION List.Who_Am_I: StringPtr;
  Begin
     Who_Am_I:=@ListName;
  end; {Who am I}

  FUNCTION List.Describe(FNum: Integer; As: FormatSet): String;
  Var S,S1: String;
      Start,
      Stop,Num : Integer;
  Begin
     S:=Prefix[Fnum=0];
     If FNum=0 then Stop:=2 else Stop:=Fnum;
     For Num:=Start to Stop do
     Begin
        Case Num of
           1 : Begin
                  S1:=ListName;
                  If As=[AsRecord] then S1:='NAME:'+S1;
               end;
           2 : Str(Count,S1);
        end; {case}
        S:=S+S1+Pads[(Fnum<>0) and (Num<>Stop)];
     end;
     Describe:=S+Suffix[Fnum=0];
  end; {describe}

  FUNCTION List.Find_Var( Identifier: String;
                          Var FNum: Integer): PointPtr;
  Var  StrPtr      : StringPtr;
       NextWord    : String;
       APoint      : PointPtr;
       Listelement : integer;
  Begin
     Find_Var:=Nil;
     NextWord  := Get_Next_Word(Identifier);
     For ListElement:=1 to Count do
     Begin
        StrPtr := Elements[ListElement]^.Who_Am_I;
    If (StrPtr<>Nil) and (UpCase_String(StrPtr^)=NextWord) then
    Begin
           APoint:=Elements[ListElement];
           If (Identifier<>'') then
                Find_Var:=APoint^.Find_Var(Identifier,FNum)
           else Find_Var:=APoint;
        end;
     end
  end; {find var}

  { WatchObj Methods: }

  CONSTRUCTOR WatchObj.Init(Xpos,Ypos: Integer; Vars: PointPtr);
  Begin
     Point.Init(XPos,YPos);
     VarList:=Vars;
     TheVar :=Nil;
     Spec   :='';
  end; {init}

  DESTRUCTOR WatchObj.Done;
  Begin
     Point.Done
  end; {Done}

  FUNCTION WatchObj.Describe(FNum: Integer; As: FormatSet): String;
  Begin
     Describe:=TheVar^.Describe(FNum,As);
  end; { Describe }

  PROCEDURE WatchObj.Show;
  Var S : String;
  Begin
     If TheVar<>Nil then
          S:=Spec+': '+Describe(FieldNum,Format)
     else
          If SPec<>'' then
               S:=Spec+': Unknown identifier'
          else S:='';
     Gotoxy(WhereXPos,WhereYPos); ClrEol;
     Write(S);
  end; {Show}

 PROCEDURE WatchObj.Get_Format_Specifiers(Identifier: String);
 Var I : Integer;
     FormatStr: String;
 Begin
    I:=Pos(',',Identifier);
    Format:=[AsDefault];
    If I<>0 then
    Begin
       FormatStr:=Copy(Identifier,I+1,Length(Identifier));
       Delete(Identifier,I,Length(Identifier));
       If (Pos('r',FormatStr)<>0) or (Pos('R',FormatStr)<>0) then
          Format:=[AsRecord];
    end;
 end; {Get format specifiers}

FUNCTION WatchObj.Find_Var( Identifier: String;
                            Var FNum: Integer): PointPtr;
Begin
   TheVar:=Nil;
   FNum:=0;
   Get_Format_Specifiers(Identifier);
   Spec:=Identifier;
   If (VarList<>Nil) and (Identifier<>'') then
   Begin
      TheVar:=VarList^.Find_Var(Identifier,FNum);
      If TheVar<>Nil then FieldNum:=FNum;
   end;
end; {Find Var}

end. {Watch Unit}