Power-Programmierung/CD1.mdf/pascal/library/dos/strings/rline/oview.pas

Pascal/Delphi Source File | 1989-10-10 | 6.3 KB | 267 lines

{$A+,B-,D+,E-,F-,I-,L+,N-,O-,R-,S-,V-}
{$M 16384,0,655360}

USES
  CRT, moveops, rline, Readers;

CONST
  BufferSize = 4096;  { Size for disk buffer. }

TYPE
  Vptr = ^Ofiles;
  Ofiles = Object(Reader)
    CONSTRUCTOR Init(FN : String;
              px1,py1,px2,py2 : integer);
    PROCEDURE ShowStatus; virtual;
    PROCEDURE Parse(ParseSt : string); virtual;
    PROCEDURE ReSize(px1,px2,px3,px4 : integer);
  END;

  OdeclareP = ^Odeclare;
  Odeclare = Object(Ofiles)
    CONSTRUCTOR Init(FN : String;
              px1,py1,px2,py2 : integer);
    PROCEDURE Parse(ParseSt : string); virtual;
  END;

  OmethodsP = ^Omethods;
  Omethods = Object(Ofiles)
    CONSTRUCTOR Init(FN : String;
              px1,py1,px2,py2 : integer);
    PROCEDURE Parse(ParseSt : string); virtual;
  END;

{ OFILES ====================================================================}

  CONSTRUCTOR Ofiles.Init(FN : String;
              px1,py1,px2,py2 : integer);
  BEGIN
    If not Reader.Init(FN,BufferSize,px1,py1,px2,py2)
    then fail;
    checkrferror;
    tofl;
    checkrferror;
  END;

  PROCEDURE Ofiles.ShowStatus;
  BEGIN
    gotoxy(1,2);
    write(FO.FileName);
    clreol;
    gotoxy(x1,y1-1);
    write('░░░░░░░░░░ Line ',IxnoY1, ' of ', TotalItems, ' ░░░░░░░░░░');
  END;

  PROCEDURE Ofiles.Parse(ParseSt : string); BEGIN END;

  PROCEDURE OFiles.ReSize(px1,px2,px3,px4 : integer);
  BEGIN
    Rectangle.Init(px1,px2,px3,px4);
    wrscr;
    showstatus;
  END;

{ Odeclare ====================================================================}

  CONSTRUCTOR Odeclare.Init(FN : String;
              px1,py1,px2,py2 : integer);
  BEGIN
    OFiles.Init(FN,px1,py1,px2,py2);
  END;

  PROCEDURE Odeclare.Parse(ParseSt : string);
  var
    firstix, oldix : longint;
    found : boolean;
    i : integer;
  BEGIN
    searchstring := 'OBJECT';
    casesensitive := false;
    found := false;
    REPEAT
      firstix := ixnoy1;
      REPEAT
    oldix := ixnoy1;
    searchforward;
    i := pos('=', dtaline(ixnoy1) );
    found := (ixnoy1 > oldix)
          and (i > 0)
          and (pos(':', dtaline(ixnoy1)) <> i-1);
      UNTIL (oldix = ixnoy1) or found;
      if not(found) and (firstix > 1)
      then ixnoy1 := 1;
      showstatus;
    UNTIL found or (firstix = 1);
  END;


{ Omethods ====================================================================}

  CONSTRUCTOR Omethods.Init(FN : String;
              px1,py1,px2,py2 : integer);
  BEGIN
    OFiles.Init(FN,px1,py1,px2,py2);
  END;

  PROCEDURE Omethods.Parse(ParseSt : string);
  var
    s : string;
    i : integer;
    ss : string[10];
    firstix,oldix : Longint;
    found : boolean;
  BEGIN
    s := ParseSt;
    ss := 'OBJECT';
    if InSensitiveMatch(ss,s) THEN BEGIN  { OBJECT found. }
      i := pos('=',s);                    { ' xxx = Object'}
      if i > 0 then BEGIN
    UpcaseString(S);                  { ' XXX '}
    s := copy(s,1,i-1);               { ' XXX '}
    while (length(s) > 0) and (s[length(s)] in [' ', ^I])
    do dec(s[0]);                     { ' XXX' }
    REPEAT
      i := pos(' ',s);
      if i = 0 then i := pos(^I,s);
      if i > 0 then delete(s,1,i);
    UNTIL i = 0;                      { 'XXX' }
    if length(s) > 0 then BEGIN
      s:= s + '.';
      if SearchString <> S THEN BEGIN
        SearchString := s;
        casesensitive := false;
        IxnoY1 := 1;
      END;
    END;
      END;
    END;

    REPEAT
      firstix := ixnoy1;
      REPEAT
    oldix := Ixnoy1;
    SearchForward;
    if oldix <> ixnoy1 then BEGIN
      s := DTAline(ixnoy1);
      UpcaseString(s);
      found := (pos('PROCEDURE',S) > 0) OR (pos('FUNCTION',s)>0)
         OR (pos('CONSTRUCTOR',S)>0) OR (pos('DESTRUCTOR',s)>0);
    END;
      UNTIL found or (ixnoy1 = oldix);
      if not found and (firstix > 1)
      then ixnoy1 := 1;
      showstatus;
    UNTIL found or (firstix = 1);
  END;

PROCEDURE ClrViewScr;
BEGIN
  window(1,3,80,25);
  clrscr;
  window(1,1,80,25);
END;


TYPE
  VRay = array[Boolean] of VPtr;

  PROCEDURE Perspective(var vs : vray; Horizontal : boolean);
  BEGIN
    ClrViewScr;
    CASE Horizontal of
      false: BEGIN
           vs[false]^.ReSize(1, 4, 38, 25);
           vs[true]^.ReSize(42, 4, 80, 25);
         END;
      true : BEGIN
           vs[false]^.ReSize(1, 4, 80, 11);
           vs[true]^.ReSize(1, 13, 80, 25);
         END;
    END;
  END;

  PROCEDURE Expand(var vs : VRay; cur : boolean);
  BEGIN
    ClrViewScr;
    case cur of
      false : BEGIN
        vs[false]^.ReSize(1, 4, 80, 23);
        vs[true]^.ReSize(1, 25, 80, 25);
          END;
      true : BEGIN
        vs[false]^.ReSize(1, 4, 80, 4);
        vs[true]^.ReSize(1, 6, 80, 25);
          END;
    END;
  END;

{ Main Program -------------------------------------------------------}
VAR
  Vs : VRay;
  cur, View, Expanded : boolean;
  c : char;
  fn : string;
BEGIN
  clrscr;
  if paramcount = 0 then BEGIN
    writeln('OVIEW FileName');
    writeln('  Scrolls through Objects in TP 5.5 source code.');
    halt;
  END;

  fn := paramstr(1);
  if pos('.',fn) = 0       { insert default PAS extension. }
  then fn := fn + '.PAS';

  vs[false] := New(OdeclareP, init(fn, 1, 4, 38, 25));
  vs[true] := New(OmethodsP, init(fn, 42, 4, 80, 25));
  IF (vs[false] = nil) or (vs[true] = nil) then begin
    Writeln('Not enough ram available');
    halt(1);
  END;

  gotoxy(1,1);
  Writeln(' [V]iew  [+/Enter] next object/method  [tab] next window  [E]xpand  [F1] help');

  vs[false]^.Parse('');
  vs[true]^.Parse(vs[false]^.DTAline(vs[false]^.IxnoY1));

  cur := false;
  view := false;
  expanded := false;
  REPEAT
    c := vs[cur]^.scrollselect;
    vs[cur]^.checkrferror;
    CASE c of
      ^M : vs[true]^.Parse(vs[false]^.DTAline(vs[false]^.IxnoY1));
      ^I : BEGIN
         cur := not cur;
         if expanded then Expand(vs,cur);
       END;
      '+': BEGIN
         vs[false]^.Parse('');
         with vs[true]^ do begin
           ixnoy1 := 1;
           Parse(vs[false]^.DTAline(vs[false]^.IxnoY1));
           if ixnoy1 = 1 then wrscr;
         end;
       END;
      'v',
      'V': BEGIN
         View := Not View;
         Expanded := false;
         Perspective(vs,View);
       END;
      'e',
      'E': BEGIN  { Expand. }
         Expanded := Not Expanded;
         IF Expanded
         THEN Expand(vs,cur)
         ELSE Perspective(vs,View);
           END;
    END;
  UNTIL c = #27;

  clrscr;
  for cur := false to true do Dispose(vs[cur],done);
END.