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 >
Pascal/Delphi Source File  |  1992-11-30  |  2KB  |  120 lines
  1.  
  2. {chapter1.pas}
  3.  
  4. {
  5.         copyright (c) 1981
  6.         by:     bell telephone laboratories, inc. and
  7.                 whitesmith's ltd.,
  8.  
  9.         this software is derived from the book
  10.                 "software tools in pascal", by
  11.                 brian w. kernighan and p. j. plauger
  12.                 addison-wesley, 1981
  13.                 isbn 0-201-10342-7
  14.  
  15.         right is hereby granted to freely distribute or duplicate this
  16.         software, providing distribution or duplication is not for profit
  17.         or other commercial gain and that this copyright notice remains
  18.         intact.
  19. }
  20.  
  21. procedure copy;
  22. var c:character;
  23. begin
  24.   while(getc(c)<>endfile)do
  25.     putc(c)
  26. end;
  27.  
  28.  
  29. procedure charcount;
  30. var
  31.   nc:integer;
  32.   c:character;
  33. begin
  34.   nc:=0;
  35.   while (getc(c)<>endfile)do
  36.      nc:=nc+1;
  37.   putdec(nc,1);
  38.   putc(newline)
  39. end;
  40.  
  41. procedure linecount;
  42. var
  43.   n1:integer;
  44.   c:character;
  45. begin
  46.   n1:=0;
  47.   while(getc(c)<>endfile)do
  48.     if(c=newline)then
  49.       n1:=n1+1;
  50.   putdec(n1,1);
  51.   putc(newline)
  52. end;
  53.  
  54. procedure wordcount;
  55. var
  56.   nw:integer;
  57.   c:character;
  58.   inword:boolean;
  59. begin
  60.   nw:=0;
  61.   inword:=false;
  62.   while(getc(c)<>endfile)do
  63.     if(c=blank)or(c=newline)or(c=tab) then
  64.       inword:=false
  65.     else if (not inword)then begin
  66.       inword:=true;
  67.       nw:=nw+1
  68.     end;
  69.   putdec(nw,1);
  70.   putc(newline)
  71. end;
  72.  
  73. procedure detab;
  74. const
  75.   maxline=1000;
  76. type
  77.   tabtype=array[1..maxline] of boolean;
  78. var
  79.   c:character;
  80.   col:integer;
  81.   tabstops:tabtype;
  82.  
  83. function tabpos(col:integer;var tabstops:tabtype)
  84.   :boolean;
  85. begin
  86.   if(col>maxline)then
  87.     tabpos:=true
  88.   else
  89.     tabpos:=tabstops[col]
  90. end;
  91.  
  92. procedure settabs(var tabstops:tabtype);
  93. const
  94.   tabspace=4;
  95. var
  96.   i:integer;
  97. begin
  98.   for i:=1 to maxline do
  99.     tabstops[i]:=(i mod tabspace = 1)
  100. end;
  101.  
  102. begin
  103.   settabs(tabstops);
  104.   col:=1;
  105.   while(getc(c)<>endfile)do
  106.     if(c=tab)then
  107.      repeat
  108.       putc(blank);
  109.       col:=col+1
  110.      until(tabpos(col,tabstops))
  111.     else if(c=newline)then begin
  112.       putc(newline);
  113.       col:=1
  114.     end
  115.     else begin
  116.       putc(c);
  117.       col:=col+1
  118.     end
  119. end;
  120.