[Back to TEXTFILE SWAG index] [Back to Main SWAG index] [Original]

    UNIT PoetryU;

    INTERFACE

    VAR
      Vowels,
      Conson  : SET OF CHAR;

    FUNCTION NumWords( S : STRING ) : INTEGER;
    FUNCTION GetWord( S : STRING; WhichWord : INTEGER ) : STRING;
    FUNCTION Word_Syll( S : STRING ) : INTEGER;
    FUNCTION Sent_Syll( S : STRING ) : INTEGER;
    FUNCTION UCase( S : STRING ) : STRING;

    IMPLEMENTATION

    FUNCTION UCase( S : STRING ) : STRING;
    VAR
      Count : INTEGER;

    Begin
      FOR Count := 1 TO Length( S ) DO
        S[ Count ] := UpCase( S[ Count ] );

      UCase := S;
    End;

    FUNCTION RightStr( S : STRING; Index : BYTE ) : STRING;
    Begin
      RightStr := Copy( S, Index, Length( S ) );
    End;

    { This function returns the number of words within a given string. }
    FUNCTION NumWords( S : STRING ) : INTEGER;
    VAR
      Words,
      Count : INTEGER;

    Begin
      Words := 0;
      Count := 0;

      S := UCase( S );

      WHILE Count <> Length( S ) DO
      Begin
        INC( Count );

        IF S[Count] IN ['A'..'Z'] THEN
        Begin
          INC( Words );

          WHILE (S[Count] IN ['A'..'Z', '''']) AND (Count < Length( S )) DO
            INC( Count );
        End;
      End;

      NumWords := Words;
    End;

    { This function will return a word (1st, 2nd, 3rd, etc) from a sentence.
      Note that it converts the word to uppercase. }
    FUNCTION GetWord( S : STRING; WhichWord : INTEGER ) : STRING;
    VAR
      WC,
      Count : INTEGER;
      Temp  : STRING;

    Begin
      WC    := 0;
      Count := 0;
      Temp  := '';

      IF WhichWord > NumWords( S ) THEN
      Begin
        GetWord := '';
        Exit;
      End;

      S := UCase( S );

      WHILE Count < Length( S ) DO
      Begin
        INC( Count );

        IF S[Count] IN ['A'..'Z'] THEN
        Begin
          INC( WC );

          IF WC = WhichWord THEN
            WHILE (S[Count] IN ['A'..'Z']) AND (Count <= Length( S )) DO
            Begin
              Temp := Temp + S[Count];
              INC( Count );
            End
          ELSE
            WHILE (S[Count] IN ['A'..'Z']) AND (Count <= Length( S )) DO
              INC( Count );
        End;
      End;

      GetWord := Temp;
    End;

    { This function will return the number of syllables in a given word.
      It is in no way a fool-proof function, but will work for a lot of words. }
    FUNCTION Word_Syll( S : STRING ) : INTEGER;
    VAR
      Count,
      SylCount : INTEGER;

    Begin
      { No syllables! }
      SylCount := 0;

      S := UCase( S );

      { If it starts with a vowel, there is a good chance an extra syllable is in
        there. }
      IF (S[1] IN Vowels) AND (Length( S ) > 3) THEN
        SylCount := 1;

      IF (Pos( 'IO', S ) > 0) THEN
        INC( SylCount );
      IF (Pos( 'EO', S ) > 0) THEN
        INC( SylCount );
      IF (Pos( 'IA', S ) > 0) THEN
        INC( SylCount );
      IF (Pos( 'ISM', S ) > 0) THEN
        INC( SylCount );
      IF ((Pos( 'UA', S ) > 0) AND (Pos( 'QUA', S ) = 0)) THEN
        INC( SylCount );
      IF (Pos( 'TION', S ) OR (Pos( 'SION', S )) <> 0) THEN
        DEC( SylCount );

      FOR Count := 1 TO (Length( S ) - 1) DO
        IF (S[Count] IN Conson) AND (S[Count + 1] IN Vowels) THEN
          INC( SylCount );

      IF (S[Length( S )] = 'E') AND (Pos( 'BLE', RightStr( S, 3 )) = 0) AND
         (Pos( 'IE',  RightStr( S, 2 )) = 0) AND
         (Pos( 'TLE', RightStr( S, 3 )) = 0) THEN
        DEC( SylCount );

      { A word must have at least 1 syllable!! }
      IF SylCount < 1 THEN
        SylCount := 1;

      Word_Syll := SylCount;
    End;

    { This function will count the number of syllables in a given sentence. }
    FUNCTION Sent_Syll( S : STRING ) : INTEGER;
    VAR
      Count,
      SylCount : INTEGER;
      Temp     : STRING;

    Begin
      SylCount := 0;

      FOR Count := 1 TO NumWords( S ) DO
        INC( SylCount, Word_Syll( GetWord( S, Count ) ) );

      Sent_Syll := SylCount;
    End;

    PROCEDURE InitVowels;
    Begin
      Vowels := ['A', 'E', 'I', 'O', 'U', 'Y'];
    End;

    PROCEDURE InitConson;
    VAR
      Ch : CHAR;

    Begin
      Conson := [];

      FOR Ch := 'A' TO 'Z' DO
        IF NOT (Ch IN Vowels) THEN
          Conson := Conson + [ Ch ];
    End;

    BEGIN
      InitVowels;
      InitConson;
    END.

    { -------------------------  DEMO ----------------------- }

    USES Crt, PoetryU;

    CONST
      TEST = 'These are a few interesting functions, man.';
     {TEST = 'antidisestablishmentarianism';}

    VAR
      AWord : STRING;

    BEGIN
      ClrScr;

      AWord := GetWord( TEST, NumWords( TEST ) );

      WriteLn( 'The last word is : ', AWord );
      WriteLn( '# of syllables   : ', Word_Syll( AWord ) );
      WriteLn( 'Total # of words : ', NumWords( TEST ) );
      WriteLn( 'Total syllables  : ', Sent_Syll( TEST ) );
    END.

[Back to TEXTFILE SWAG index] [Back to Main SWAG index] [Original]