home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
ENTERPRS
/
CPM
/
UTILS
/
S
/
TUTOR.ARC
/
CHAPTER1.PAS
next >
Wrap
Pascal/Delphi Source File
|
1992-11-30
|
2KB
|
120 lines
{chapter1.pas}
{
copyright (c) 1981
by: bell telephone laboratories, inc. and
whitesmith's ltd.,
this software is derived from the book
"software tools in pascal", by
brian w. kernighan and p. j. plauger
addison-wesley, 1981
isbn 0-201-10342-7
right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commercial gain and that this copyright notice remains
intact.
}
procedure copy;
var c:character;
begin
while(getc(c)<>endfile)do
putc(c)
end;
procedure charcount;
var
nc:integer;
c:character;
begin
nc:=0;
while (getc(c)<>endfile)do
nc:=nc+1;
putdec(nc,1);
putc(newline)
end;
procedure linecount;
var
n1:integer;
c:character;
begin
n1:=0;
while(getc(c)<>endfile)do
if(c=newline)then
n1:=n1+1;
putdec(n1,1);
putc(newline)
end;
procedure wordcount;
var
nw:integer;
c:character;
inword:boolean;
begin
nw:=0;
inword:=false;
while(getc(c)<>endfile)do
if(c=blank)or(c=newline)or(c=tab) then
inword:=false
else if (not inword)then begin
inword:=true;
nw:=nw+1
end;
putdec(nw,1);
putc(newline)
end;
procedure detab;
const
maxline=1000;
type
tabtype=array[1..maxline] of boolean;
var
c:character;
col:integer;
tabstops:tabtype;
function tabpos(col:integer;var tabstops:tabtype)
:boolean;
begin
if(col>maxline)then
tabpos:=true
else
tabpos:=tabstops[col]
end;
procedure settabs(var tabstops:tabtype);
const
tabspace=4;
var
i:integer;
begin
for i:=1 to maxline do
tabstops[i]:=(i mod tabspace = 1)
end;
begin
settabs(tabstops);
col:=1;
while(getc(c)<>endfile)do
if(c=tab)then
repeat
putc(blank);
col:=col+1
until(tabpos(col,tabstops))
else if(c=newline)then begin
putc(newline);
col:=1
end
else begin
putc(c);
col:=col+1
end
end;