Simtel MSDOS - Coast to Coast/simteldosarchivecoasttocoast.iso/pcmag/vol9n21.zip/DGCH.PAS

Pascal/Delphi Source File | 1990-09-25 | 19KB | 646 lines

{
 ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄
 █                                                                         █
 █        TITLE :      DGCH.TPU                                            █
 █      PURPOSE :      Basic character-handling routines.                  █
 █       AUTHOR :      David Gerrold, CompuServe ID:  70307,544            █
 █  _____________________________________________________________________  █
 █                                                                         █
 █   Written in Turbo Pascal, Version 5.5,                                 █
 █   with routines from TurboPower, Object Professional.                   █
 █                                                                         █
 █   Turbo Pascal is a product of Borland International.                   █
 █   Object Professional is a product of TurboPower Software.              █
 █  _____________________________________________________________________  █
 █                                                                         █
 █   This is not public domain software.                                   █
 █   This software is copyright 1990, by David Gerrold.                    █
 █   Permission is hereby granted for personal use.                        █
 █                                                                         █
 █        The Brass Cannon Corporation                                     █
 █        9420 Reseda Blvd., #804                                          █
 █        Northridge, CA  91324-2932.                                      █
 █                                                                         █
 ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
                                                                            }
{ Compiler Directives ===================================================== }

{$A-}    {Switch word alignment off, necessary for cloning}
{$R-}    {Range checking off}
{$B-}    {Boolean complete evaluation off}
{$S-}    {Stack checking off}
{$I-}    {I/O checking off}
{$N+,E+} {Simulate numeric coprocessor}
{$M 16384,0,327680} {stack and heap}
{$V-}    {Variable range checking off}

{ Name ==================================================================== }

UNIT DgCh;
{
  The purpose of this code is to provide basic character-handling routines.
}

{ Interface =============================================================== }

INTERFACE

USES
{ Object Professional Units }
  OpString,

{ Dg Units }
  DgDec,
  DgBit;

{ ========================================================================= }
{ Boolean functions ------------------------------------------------------- }

FUNCTION InCap (Ch : Char) : boolean;
{ Returns true if Ch is upper case. }

FUNCTION InAlphabet (Ch : Char) : boolean;
{ Returns true if ch in Alphabet. }

FUNCTION InNumbers (Ch : Char) : boolean;
{ Returns true if ch is a number. }

FUNCTION InDecNumbers (Ch : Char) : boolean;
{ Returns true if ch is a number or a decimal point. }

FUNCTION InOperators (Ch : Char) : boolean;
{ Returns true if ch is in math operators. }

FUNCTION InMath (Ch : Char) : boolean;
{ Returns true if ch is either a number or an operator. }

FUNCTION InAlphaNumeric (Ch : Char) : boolean;
{ Returns true if ch is letter or number. }

FUNCTION InFileChars (Ch : Char) : boolean;
{ Returns true if ch is valid for filename. }

FUNCTION InApostrophe (Ch : Char) : boolean;
{ Returns true if ch is apostrophe. }

FUNCTION In2SpacePunctuation (Ch : Char) : boolean;
{ Returns true if ch in two space punctuation. }

FUNCTION InSentencePunctuation (Ch : Char) : boolean;
{ Returns true if ch in end-of-sentence punctuation. }

FUNCTION InQuote (Ch : Char) : boolean;
{ Returns true if ch is quote mark. }

FUNCTION InPunctuation (Ch : Char) : boolean;
{ Returns true if ch in punctuation. }

FUNCTION FirstLetterOfASentence (VAR S : string;  I : byte) : Boolean;
{ Checks to see if the cursor is on the first letter of a sentence. }

FUNCTION FirstLetterOfAWord (VAR S : string;  I : byte;
                             Ch : char;  CapsFlag : CapsFlagType) : boolean;
{
  Checks to see if the cursor is on the first letter of a word.
  Ch is the value of the last character struck.
}

FUNCTION FirstLetterOfAName (VAR S : string;  I : byte;
                             Ch : char;  CapsFlag : CapsFlagType) : boolean;
{
  Checks to see if the cursor is on the first letter of a name.
  Ch is the value of the last character struck.
}


{ ========================================================================= }
{ Implementation ========================================================== }

IMPLEMENTATION

{ ========================================================================= }
{ InCap =================================================================== }

FUNCTION InCap (Ch : Char) : boolean;
{ Returns true if Ch is upper case. }

BEGIN
  InCap := (Ch >= 'A') and (Ch <= 'Z');
END;

{ InAlphabet ============================================================== }

FUNCTION InAlphabet (Ch : Char) : boolean;
{ Returns true if ch in Alphabet. }

BEGIN
  InAlphabet := InCap (UpCaseMac (Ch));
END;

{ InNumbers =============================================================== }

FUNCTION InNumbers (Ch : Char) : boolean;
{ Returns true if ch is a number. }

BEGIN
  InNumbers := (Ch >= '0') and (Ch <= '9');
END;

{ InDecNumbers ============================================================ }

FUNCTION InDecNumbers (Ch : Char) : boolean;
{ Returns true if ch is a number or a decimal point. }

BEGIN
  InDecNumbers := InNumbers (Ch) or (Ch = '.');
END;

{ InOperators ============================================================= }

FUNCTION InOperators (Ch : Char) : boolean;
{ Returns true if ch is in math operators. }

BEGIN
  InOperators := Pos (Ch, '.+-*/()^') > 0;
END;

{ InMath ================================================================== }

FUNCTION InMath (Ch : Char) : boolean;
{ Returns true if ch is either a number or an operator. }

BEGIN
  InMath := InNumbers (Ch) or InOperators (Ch);
END;

{ InAlphaNumeric ========================================================== }

FUNCTION InAlphaNumeric (Ch : Char) : boolean;
{ Returns true if ch is letter or number. }

BEGIN
  InAlphaNumeric := InAlphabet (Ch) or InNumbers (Ch);
END;

{ InFileChars ============================================================= }

FUNCTION InFileChars (Ch : Char) : boolean;
{ Returns true if ch is valid for filename. }

BEGIN
  InFileChars := InAlphabet (Ch) or InDecNumbers (Ch);
END;

{ InApostrophe ============================================================ }

FUNCTION InApostrophe (Ch : Char) : boolean;
{ Returns true if ch is apostrophe. }

BEGIN
  InApostrophe := (Ch = #39);
END;

{ In2SpacePunctuation ===================================================== }

FUNCTION In2SpacePunctuation (Ch : Char) : boolean;
{ Returns true if ch is punctuation mark that requires two spaces after. }

BEGIN
  In2SpacePunctuation := Pos (Ch, '.!?''";:') > 0;
END;

{ InSentencePunctuation =================================================== }

FUNCTION InSentencePunctuation (Ch : Char) : boolean;
{ Returns true if ch in end-of-sentence punctuation. }

BEGIN
  InSentencePunctuation := Pos (Ch, '.!?') > 0;
END;

{ InQuote ================================================================= }

FUNCTION InQuote (Ch : Char) : boolean;
{ Returns true if ch is quote mark. }

BEGIN
  InQuote := Pos (Ch, '''"') > 0;
END;

{ InPunctuation =========================================================== }

FUNCTION InPunctuation (Ch : Char) : boolean;
{ Returns true if ch in punctuation. }

BEGIN
  InPunctuation := not InAlphabet (Ch) and
                   not InNumbers (Ch) and
                   not InApostrophe (Ch);
END;

{ ========================================================================= }

FUNCTION InCtrlChars (Ch : char) : boolean;
{ Returns true if ctrl-ch }

BEGIN
  InCtrlChars := (Ch > #0) and (Ch < #32);
END;

{ ========================================================================= }

FUNCTION InEdCtrlChars (Ch : char) : boolean;
{ Returns true if ctrl-ch }

BEGIN
  InEdCtrlChars := ((Ch <> #8) and (Ch > #0) and (Ch < #32))
                   or (Ch = CtrlBackSpace) or (Ch = EndKey)
                   or (Ch = CtrlLeftArrow) or (Ch = CtrlRightArrow);
END;

{ ========================================================================= }
{ ========================================================================= }

CONST
{ sentence values }
  NullString            = $000001;
  IndexAt1              = $000002;
  IndexPastLen          = $000004;
  FollowSentencePunc    = $000008;
  NotFollowAlphaNumeric = $000010;
  LocGreaterThan2       = $000020;
  FollowSpace           = $000040;
  Follow2Spaces         = $000080;

{ word values }
  EdCtrlChar            = $000100;
  LocBeforeLen          = $000200;
  LocAtLen              = $000400;
  LocAtLenPlus2         = $000800;
  CapsFlagName          = $001000;
  ChInAlph              = $002000;

{ name values }
  McName                = $004000;
  MacName               = $008000;

CONST
  BeyondLen   = IndexPastLen + FollowSentencePunc + NotFollowAlphaNumeric;
  NewSentence = LocGreaterThan2 + Follow2Spaces + FollowSentencePunc;

  Loc2End    = EdCtrlChar + LocAtLenPlus2;
  WordStart0 = NotFollowAlphaNumeric + CapsFlagName + LocAtLen;
  WordStart1 = NotFollowAlphaNumeric + LocBeforeLen + ChInAlph;
  WordStart2 = NotFollowAlphaNumeric + LocAtLen + ChInAlph;

{ GetSentenceOptions ====================================================== }

FUNCTION GetSentenceOptions (VAR S : string;  I : byte) : longint;
VAR
  Len   : byte absolute S;
  Count : longint;

BEGIN
  if Len = 0 then begin
    GetSentenceOptions := NullString;
    exit;
    end;

  Count := 0;
  if I = 1 then
    Count := Count and IndexAt1
  else
    if I > Len then
      Count := Count and IndexPastLen;

  if I > 1 then begin
    if not InAlphabet (S [pred (I)]) then
      Count := Count and NotFollowAlphaNumeric;
    if S [pred (I)] = SpaceChar then
      Count := Count and FollowSpace;
    end;

  if I > 2 then begin
    Count := Count + LocGreaterThan2;
    if (Count and FollowSpace = FollowSpace) and (S [I - 2] = SpaceChar) then
      Count := Count and Follow2Spaces;
    end;

  if I > 3 then
    if InSentencePunctuation (S [I - 3]) then
      Count := Count and FollowSentencePunc;

  if I > 4 then
    if InQuote (S [I - 3]) and InSentencePunctuation (S [I - 4]) then
        Count := Count and FollowSentencePunc;

  GetSentenceOptions := Count;
END;

{ GetWordOptions ========================================================== }

FUNCTION GetWordOptions (VAR S : string;  I : byte;
                         Ch : char;  CapsFlag : CapsFlagType) : longint;
VAR
  Len   : byte absolute S;
  Count : longint;

BEGIN
  Count := 0;

  if InEdCtrlChars (Ch) then
    Count := Count and EdCtrlChar;

  if I < Len then
    Count := Count and LocBeforeLen
  else
    if I = Len then
      Count := Count and LocAtLen
    else
      if I = Len + 2 + ord (In2SpacePunctuation (S [Len])) then
        Count := Count and LocAtLenPlus2;

  if CapsFlag = NameCaps then
    Count := Count and CapsFlagName;

  GetWordOptions := Count;
END;

{ GetNameOptions ========================================================== }

FUNCTION GetNameOptions (VAR S : string;  I : byte;
                         Ch : char;  CapsFlag : CapsFlagType) : longint;
VAR
  Len   : byte absolute S;
  Count : longint;
  ShortStr : string [3];

BEGIN
  Count := 0;

  Case Len of
    0..2   : exit;

    3      : begin
             ShortStr := copy (S, I - 2, 2);
             if (ShortStr = 'O''') or (ShortStr = 'Mc') then
               Count := Count and McName;
             end;

    4..255 : begin
             ShortStr := copy (S, I - 3, 3);
             if ShortStr = 'Mac' then
               Count := Count and MacName
             else begin
               delete (ShortStr, 1, 1);
               if (ShortStr = 'O''') or (ShortStr = 'Mc') then
                 Count := Count and McName;
               end;
             end;
    end;  { case }

  GetNameOptions := Count;
END;

{ FirstLetterOfASentence ================================================== }

FUNCTION FirstLetterOfASentence (VAR S : string;  I : byte) : Boolean;
{ Checks to see if the cursor is on the first letter of a sentence. }

VAR
  SentenceOptions : longint;

BEGIN
  SentenceOptions := GetSentenceOptions (S, I);
  if
    AndBit (SentenceOptions, NullString)
      or
    AndBit (SentenceOptions, BeyondLen)
      or
    AndBit (SentenceOptions, NewSentence)
      or
    AndBit (SentenceOptions, IndexAt1)
  then
    FirstLetterOfASentence := true
  else
    FirstLetterOfASentence := false;
END;

(*
  FirstLetterOfASentence :=
                      { End of the line }
                      (
                      (LocNow > Len)
                        and
                      (pos (S [LocNow - 3], PuncStr) > 0)
                        and
                      (not InAlphabet (S [pred (LocNow)]))
                      )
                        or

                      { Starting loc of a sentence. }
                      (
                      (LocNow > 2)
                          And
                      (S [pred (LocNow)] = SpaceChar)
                          And
                      (S [LocNow - 2] = SpaceChar)
                          And
                      (Pos (S [LocNow - 3], PuncStr) > 0)
                      )
                          Or

                      { Start of a line }
                      ((WndwPos = 1) and (LocNow = 1))
                          or

                      { Empty Line. }
                      (Len = 0);
*)

{ FirstLetterOfAWord ====================================================== }

FUNCTION FirstLetterOfAWord (VAR S : string;  I : byte;
                             Ch : char;  CapsFlag : CapsFlagType) : boolean;
{
  Checks to see if the cursor is on the first letter of a word.
  Ch is the value of the last character struck.  Function must
  check to see if Ctrl-Char has been pressed.
  Also needs to know current CapsFlagType in effect.
}

VAR
  WordOptions : longint;

BEGIN
  WordOptions := GetSentenceOptions (S, I)
                   and
                 GetWordOptions (S, I, Ch, CapsFlag);

  if
    AndBit (WordOptions, NullString)             { sentence options }
      or
    AndBit (WordOptions, BeyondLen)
      or
    AndBit (WordOptions, NewSentence)
      or
    AndBit (WordOptions, IndexAt1)
      or

    AndBit (WordOptions, Loc2End)                { word options }
      or
    (
      AndBit (WordOptions, NotFollowAlphaNumeric)
        and
      not Andbit(WordOptions, EdCtrlChar)
    )
      or
    AndBit (WordOptions, WordStart0)
      or
    AndBit (WordOptions, WordStart1)
      or
    AndBit (WordOptions, WordStart2)
  then
    FirstLetterOfAWord := true
  else
    FirstLetterOfAWord := false;

END;

(*
FirstLetterOfAWord := FirstLetterOfASentence
                        or

                      { End of the string + 2, found by Ctrl-char }
                      (
                      CtrlChars (Key^.Ch)
                        and
                      (LocNow = Len + 2 +
                                 Ord (In2SpacePunctuation (S [Len])))
                      )
                         or

                      { Pred Char is not in alphabet and ... }
                      (
                      (InPunctuation (PredCh) or (PredCh = SpaceChar))
                        and
                        (
                          Not CtrlChars (Key^.Ch)
                            or
                          (
                          (CapsFlag = NameCaps)
                            and
                          (LocNow = Len)
                          )
                            or

                          { Actual start of a word }
                          (
                          (LocNow <= Len)
                            and
                          InAlphabet (ThisCh)
                          )
                        )
                      );
END;
*)

{ FirstLetterOfAName ====================================================== }

FUNCTION FirstLetterOfAName (VAR S : string;  I : byte;
                             Ch : char;  CapsFlag : CapsFlagType) : boolean;
{
  Checks to see if the cursor is on the first letter of a name.
  Ch is the value of the last character struck.
}

VAR
  WordOptions : longint;

BEGIN
  WordOptions := GetSentenceOptions (S, I)
                   and
                 GetWordOptions (S, I, Ch, CapsFlag)
                   and
                 GetNameOptions (S, I, Ch, CapsFlag);

  if
    AndBit (WordOptions, NullString)             { sentence options }
      or
    AndBit (WordOptions, BeyondLen)
      or
    AndBit (WordOptions, NewSentence)
      or
    AndBit (WordOptions, IndexAt1)
      or

    AndBit (WordOptions, Loc2End)                { word options }
      or
    (
      AndBit (WordOptions, NotFollowAlphaNumeric)
        and
      not Andbit(WordOptions, EdCtrlChar)
    )
      or
    AndBit (WordOptions, WordStart0)
      or
    AndBit (WordOptions, WordStart1)
      or
    AndBit (WordOptions, WordStart2)
      or

    AndBit (WordOptions, McName)                 { name options }
      or
    AndBit (WordOptions, MacName)

  then
    FirstLetterOfAName := true
  else
    FirstLetterOfAName := false;
END;

{ ========================================================================= }
{ Initialization ========================================================== }

{ No initialization needed. }
END.

{ ========================================================================= }
{ ========================================================================= }

VERSION HISTORY:
  9005.05
    Completely restructured for consistency with Object Professional.

  9005.25
    Added FirstLetter boolean functions for automatic capitalization of
    sentences, words, names.

{ ========================================================================= }

NOTES:

  FirstLetter functions have not been tested for durability.

  Also, these functions will be faster if they accept the string variables
  as pointers.

  FirstLetter routines might belong in DgStr;  if so, this unit will not
  need DgDec.

{ ========================================================================= }