home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
o
/
opuniq.zip
/
WORDS.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1990-10-24
|
2KB
|
95 lines
{$S-,R-,V-,I-,B-,F+,O-,A-}
program Words;
{-Writes sorted list of unique words in a file using UniqueStringArray}
uses
OpString, OpRoot, OpTree, OpUnique;
const
WordDelims : CharSet = [#0..',', '.'..'/', ':'..'@', '['..'^', '{'..#127];
var
U : UniqueStringArray;
procedure Abort(Msg : string);
begin
writeln(Msg);
halt(1);
end;
procedure OutOfMemory;
begin
Abort('Insufficient memory');
end;
procedure Help;
begin
writeln('Usage: WORDS FileName [>OutputRedirection]');
halt;
end;
procedure Scan(FName : String);
{-Read the text file FName and add its words to the string array}
var
LPos : Word;
BPos : Word;
Index : Word;
L : String;
F : Text;
begin
assign(F, FName);
reset(F);
if IoResult <> 0 then
Abort(FName+' not found');
while not Eof(F) do begin
{Read next line from file}
ReadLn(F, L);
if IoResult <> 0 then
Abort('Error reading '+FName);
{Parse the string into words}
LPos := 1;
while LPos <= Length(L) do begin
{Find start of word}
while (LPos <= Length(L)) and (L[LPos] in WordDelims) do
inc(LPos);
if LPos <= Length(L) then begin
{Save beginning position}
BPos := LPos;
while (LPos <= Length(L)) and not(L[LPos] in WordDelims) do
inc(LPos);
{Add word to UniqueStringArray}
Index := U.AddString(copy(L, BPos, LPos-BPos));
if Index = 0 then
OutOfMemory;
end;
end;
end;
close(F);
if IoResult = 0 then ;
end;
procedure DumpAction(N : TreeNodePtr; T : TreePtr);
begin
writeln(IndexTreePtr(T)^.itSP^.GetString(IndexTreeNodePtr(N)^.itnIndex));
end;
procedure Dump;
{-Dump the UniqueStringArray in alpha order}
begin
U.GetTreePtr^.VisitNodesUp(DumpAction);
end;
begin
if not U.Init(5000, 65520) then
OutOfMemory;
if ParamCount = 0 then
Help;
Scan(ParamStr(1));
Dump;
end.