home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / tpw / docdemos / tddemo.pas < prev    next >
Pascal/Delphi Source File  |  1991-05-20  |  5KB  |  196 lines

  1. {***********************************************************************
  2.  *  File: TDDEMO.PAS
  3.  *
  4.  *  Turbo Pascal Demonstration program for use with Turbo Debugger
  5.  *  Copyright (c) 1988, 1991 - Borland International.
  6.  *
  7.  *  Reads words from standard input, analyzes letter and word frequency.
  8.  *  Uses linked list to store command-line parameters on heap.
  9.  *
  10.  *  Uses the following data types:
  11.  *
  12.  *    Boolean,
  13.  *    Char, Byte,
  14.  *    Integer, Word,
  15.  *    LongInt,
  16.  *    Real (can't use 8087 type yet, change to extended)
  17.  *    String,
  18.  *    Array,
  19.  *    Record,
  20.  *    Set,
  21.  *    Pointer
  22.  ***********************************************************************}
  23. program TDDemo;
  24.  
  25. uses
  26.   WinCrt;              { text mode I/O library for Windows }
  27.  
  28. const
  29.   BufSize    = 128;    { length of line buffer }
  30.   MaxWordLen =  10;    { maximum word length allowed }
  31.  
  32. type
  33.   BufferStr = String[BufSize];
  34.  
  35.   LInfoRec = record
  36.     Count: Word;               { number of occurrences of this letter }
  37.     FirstLetter: Word;         { number of times as first letter of a }
  38.   end;
  39.  
  40. var
  41.   NumLines, NumWords: Word;                     { counters }
  42.   NumLetters: LongInt;
  43.   WordLenTable: array[1..MaxWordLen] of Word;   { info for each word }
  44.   LetterTable: array['A'..'Z'] of LInfoRec;     { info for each letter }
  45.   Buffer: BufferStr;
  46.  
  47. {***************************************************
  48.  * procedure ShowResults
  49.  ***************************************************}
  50. procedure ShowResults;
  51.  
  52. {+--------------------------------------------------
  53.  | procedure ShowLetterInfo
  54.  +--------------------------------------------------}
  55. procedure ShowLetterInfo(FromLet, ToLet: Char);
  56. { Dump letter information }
  57. var
  58.   ch: Char;
  59. begin
  60.   Writeln;
  61.   Write('Letter:     ');
  62.   for ch := FromLet to ToLet do                 { column titles }
  63.     Write(ch:5);
  64.   Writeln;
  65.  
  66.   Write('Frequency:  ');
  67.   for ch := FromLet to ToLet do                 { letter count }
  68.     Write(LetterTable[ch].Count:5);
  69.   Writeln;
  70.   Write('Word starts:');
  71.   for ch := FromLet to ToLet do                 { first letter count }
  72.     Write(LetterTable[ch].FirstLetter:5);
  73.   Writeln;
  74. end; { ShowLetterInfo }
  75.  
  76. {*** ShowResults starts here ***}
  77.  
  78. var
  79.   i: Integer;
  80.   AvgWords: Real;
  81.  
  82. begin { ShowResults }
  83.   if NumLines <> 0 then AvgWords := NumWords / NumLines
  84.   else AvgWords := 0;
  85.   Writeln;
  86.   Writeln(NumLetters, ' char(s) in ',
  87.     NumWords, ' word(s) in ',
  88.     NumLines, ' line(s)');
  89.   Writeln('Average of ', AvgWords:0:2, ' words per line');
  90.   Writeln;
  91.  
  92.   { Dump word count }
  93.   Write('Word length:');
  94.   for i := 1 to MaxWordLen do Write(i:4);
  95.   Writeln;
  96.  
  97.   Write('Frequency:  ');
  98.   for i := 1 to MaxWordLen do Write(WordLenTable[i]:4);
  99.   Writeln;
  100.  
  101.   { Dump letter counts }
  102.   ShowLetterInfo('A', 'M');
  103.   ShowLetterInfo('N', 'Z');
  104. end; { ShowResults }
  105.  
  106.  
  107. {***************************************************
  108.  * procedure Init
  109.  ***************************************************}
  110. procedure Init;
  111. begin
  112.   NumLines := 0;
  113.   NumWords := 0;
  114.   NumLetters := 0;
  115.   FillChar(LetterTable, SizeOf(LetterTable), 0);
  116.   FillChar(WordLenTable, SizeOf(WordLenTable), 0);
  117.   Writeln('Enter a string to process, an empty string quits.');
  118. end; { Init }
  119.  
  120. {***************************************************
  121.  * procedure ProcessLine
  122.  ***************************************************}
  123. procedure ProcessLine(var S: BufferStr);
  124.  
  125. {+--------------------------------------------------
  126.  | function IsLetter
  127.  +--------------------------------------------------}
  128. function IsLetter(ch: Char): Boolean;
  129. begin
  130.   IsLetter := UpCase(ch) in ['A'..'Z'];
  131. end; { IsLetter }
  132.  
  133.  
  134. {*** Process Line starts here ***}
  135.  
  136. var
  137.   i: Integer;
  138.   WordLen: Word;
  139.  
  140. begin { ProcessLine }
  141.   Inc(NumLines);
  142.   i := 1;
  143.   while i <= Length(S) do
  144.   begin
  145.     { Skip non-letters }
  146.     while (i <= Length(S)) and not IsLetter(S[i]) do
  147.       Inc(i);
  148.  
  149.     { Find end of word, bump letter & word counters }
  150.     WordLen := 0;
  151.     while (i <= Length(S)) and IsLetter(S[i]) do
  152.     begin
  153.       Inc(NumLetters);
  154.       Inc(LetterTable[UpCase(S[i])].Count);
  155.       if WordLen = 0 then                    { bump counter }
  156.     Inc(LetterTable[UpCase(S[i])].FirstLetter);
  157.       Inc(i);
  158.       Inc(WordLen);
  159.     end;
  160.  
  161.     { Bump word count info }
  162.     if WordLen > 0 then
  163.     begin
  164.       Inc(NumWords);
  165.       if WordLen <= MaxWordLen then
  166.     Inc(WordLenTable[WordLen]);
  167.     end;
  168.   end; { while }
  169. end; { ProcessLine }
  170.  
  171. {***************************************************
  172.  * function GetLine
  173.  ***************************************************}
  174. function GetLine: BufferStr;
  175. var
  176.   S: BufferStr;
  177. begin
  178.   Write('String: ');
  179.   Readln(S);
  180.   GetLine := S;
  181. end;
  182.  
  183.  
  184. {*** Program starts here ***}
  185.  
  186. begin { program }
  187.   Init;
  188.   Buffer := GetLine;
  189.   while Buffer <> '' do
  190.   begin
  191.     ProcessLine(Buffer);
  192.     Buffer := GetLine;
  193.   end;
  194.   ShowResults;
  195. end.
  196.