home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / cpm86 / trbtol86.lbr / CHAPTER1.PQS / CHAPTER1.PAS
Pascal/Delphi Source File  |  1985-10-23  |  2KB  |  121 lines
  1.  
  2. {
  3.         Copyright (c) 1981
  4.         By:     Bell Telephone Laboratories, Inc. and
  5.                 Whitesmith's Ltd.,
  6.  
  7.         This software is derived from the book
  8.                 "Software Tools in Pascal", by
  9.                 Brian W. Kernighan and P. J. Plauger
  10.                 Addison-Wesley, 1981
  11.                 ISBN 0-201-10342-7
  12.  
  13.         Right is hereby granted to freely distribute or duplicate this
  14.         software, providing distribution or duplication is not for profit
  15.         or other commercial gain and that this copyright notice remains
  16.         intact.
  17. }
  18.  
  19. PROCEDURE COPY;
  20. VAR C:CHARACTER;
  21. BEGIN
  22.   WHILE(GETC(C)<>ENDFILE)DO
  23.     PUTC(C)
  24. END;
  25.  
  26.  
  27. PROCEDURE CHARCOUNT;
  28. VAR
  29.   NC:INTEGER;
  30.   C:CHARACTER;
  31. BEGIN
  32.   NC:=0;
  33.   WHILE (GETC(C)<>ENDFILE)DO
  34.      NC:=NC+1;
  35.   PUTDEC(NC,1);
  36.   PUTC(NEWLINE)
  37. END;
  38.  
  39. PROCEDURE LINECOUNT;
  40. VAR
  41.   N1:INTEGER;
  42.   C:CHARACTER;
  43. BEGIN
  44.   N1:=0;
  45.   WHILE(GETC(C)<>ENDFILE)DO
  46.     IF(C=NEWLINE)THEN
  47.       N1:=N1+1;
  48.   PUTDEC(N1,1);
  49.   PUTC(NEWLINE)
  50. END;
  51.  
  52. PROCEDURE WORDCOUNT;
  53. VAR
  54.   NW:INTEGER;
  55.   C:CHARACTER;
  56.   INWORD:BOOLEAN;
  57. BEGIN
  58.   NW:=0;
  59.   INWORD:=FALSE;
  60.   WHILE(GETC(C)<>ENDFILE)DO
  61.     IF(C=BLANK)OR(C=NEWLINE)OR(C=TAB) THEN
  62.       INWORD:=FALSE
  63.     ELSE IF (NOT INWORD)THEN BEGIN
  64.       INWORD:=TRUE;
  65.       NW:=NW+1
  66.     END;
  67.   PUTDEC(NW,1);
  68.   PUTC(NEWLINE)
  69. END;
  70.  
  71. PROCEDURE DETAB;
  72. CONST
  73.   MAXLINE=1000;
  74. TYPE
  75.   TABTYPE=ARRAY[1..MAXLINE] OF BOOLEAN;
  76. VAR
  77.   C:CHARACTER;
  78.   COL:INTEGER;
  79.   TABSTOPS:TABTYPE;
  80.  
  81. FUNCTION TABPOS(COL:INTEGER;VAR TABSTOPS:TABTYPE)
  82.   :BOOLEAN;
  83. BEGIN
  84.   IF(COL>MAXLINE)THEN
  85.     TABPOS:=TRUE
  86.   ELSE
  87.     TABPOS:=TABSTOPS[COL]
  88. END;
  89.  
  90. PROCEDURE SETTABS(VAR TABSTOPS:TABTYPE);
  91. CONST
  92.   TABSPACE=4;
  93. VAR
  94.   I:INTEGER;
  95. BEGIN
  96.   FOR I:=1 TO MAXLINE DO
  97.     TABSTOPS[I]:=(I MOD TABSPACE = 1)
  98. END;
  99.  
  100. BEGIN
  101.   SETTABS(TABSTOPS);
  102.   COL:=1;
  103.   WHILE(GETC(C)<>ENDFILE)DO
  104.     IF(C=TAB)THEN
  105.      REPEAT
  106.       PUTC(BLANK);
  107.       COL:=COL+1
  108.      UNTIL(TABPOS(COL,TABSTOPS))
  109.     ELSE IF(C=NEWLINE)THEN BEGIN
  110.       PUTC(NEWLINE);
  111.       COL:=1
  112.     END
  113.     ELSE BEGIN
  114.       PUTC(C);
  115.       COL:=COL+1
  116.     END
  117. END;
  118.  
  119.  
  120.  
  121.