Category : Pascal Source Code
Archive   : RLINE-OP.ZIP
Filename : OVIEW.PAS
{$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.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/