Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/NUTUG11.ZIP/MISC.PAS

Pascal/Delphi Source File | 1987-11-21 | 13.3 KB | 413 lines

Unit Misc;

              {NORTHWESTERN UNIVERSITY TURBO USERS GROUP UTILITIES}

                         (** NUtility MISC ROUTINES **)

                            {(C) J. E. Hilliard 1986}

         {This is a set of miscellaneous utilities most of which deal
         with text handling.                                         }

Interface

Uses      Dos,
          Crt;

PROCEDURE Chirp;                       {A pleasantly soft audio signal.     }

PROCEDURE Honk;                        {An unpleasant audio signal.         }

FUNCTION UpCaseStr (InString  : String): String;
         {Converts all characters in 'InString' to upper case.       }

PROCEDURE TrimLine (Var StrT :  String);
         {Deletes leading and trailing spaces from input StrT.       }

FUNCTION FTrimLine (StrT : String) : String;
          {This is similar to TrimLine except that it is coded as a
           a function.                                            }

FUNCTION CtrLn (Line : String) : String;
         {Centers input 'Line' in a field of a width determined by
         the constant.                                           }

PROCEDURE NumberLock (ONorOFF : Boolean);
         {Turns NumLck key On or Off according to input.  WARNING: Be
         sure to reset to OFF before exiting program.               }

PROCEDURE BackSpace (Numb : byte);
         {Backspaces cursor 'Numb' characters.                       }

FUNCTION Query : Boolean;
         {This function simplifies the handling of queries to the user
         that require a Y/N response.  It appends  ' (Y/N)? : ' to the
         current line and waits for a valid response. Returns 'TRUE' if
         it is 'y' or 'Y'.                                            }

FUNCTION LJust (Line : String; F : byte): String;
         {Left justifies 'Line' in a field of length 'F'.            }

FUNCTION KeyCheck : char;
         {This function checks the keyboard buffer and returns: (1) #0
         if there is no entry. (2) The first character in the buffer
         if it is not a Turbo ESC pair. (3) The scan code plus 128 if
         it is an ESC pair. (Unfortunately, this scheme precludes the
         identification of certain CTRL and ALT key combinations. If
         this is important, other coding should be used.)

PROCEDURE Tab (Ind : byte);
         {Tabs to location 'Ind'. Since it uses the WhereX command it
         will not work on output to the printer unless the text is
         being simultaneously displayed on the screen.              }

Implementation


PROCEDURE Chirp;                       {A pleasantly soft audio signal.     }

Begin

  Sound(2000);
  Delay(8);
  NoSound;

End; {Chirp}


PROCEDURE Honk;                        {An unpleasant audio signal.         }

Begin

  write (#7);                          {^G - Bell                           }

End; {Honk}


FUNCTION UpCaseStr (InString  : String): String;

         {Converts all characters in 'InString' to upper case.       }


VAR J : byte;

Begin

  for J := 1 to length (InString) do
    InString[J] := UpCase ( InString[J] );
  UpCaseStr := InString;

end; {UpCaseStr}


PROCEDURE TrimLine (Var StrT :  String);

         {Deletes leading and trailing spaces from input StrT.       }

Begin

  if Length (StrT) = 0 then
    Exit;

  while (StrT[ length (StrT) ] = #32) and (length (StrT) > 0) do
    StrT[0] := pred (StrT[0]);         {Eliminate trailing blanks,          }

  while (StrT[1] = #32) and (length (StrT) > 0) do
    delete (StrT, 1, 1);

End; {TrimLine}


FUNCTION FTrimLine (StrT : String) : String;

          {This is similar to TrimLine except that it is coded as a
           a function.                                            }

Begin

  FTrimLine := '';
  if length (StrT) = 0 then
    Exit;                              {Nothing to trim!                    }
  while (StrT[ length (StrT) ] = #32) and (length (StrT) > 0) do
    StrT[0] := pred (StrT[0]);         {Eliminate trailing blanks,          }

  while (StrT[1] = #32) and (length (StrT) > 0) do
    delete (StrT, 1, 1);

  FTrimLine := StrT;

End; {FTrimLine (StrT : String) : String}


FUNCTION CtrLn (Line : String) : String;

         {Centers input 'Line' in a field of a width determined by
         the constant.                                           }

CONST

  Field = 80;                          {Change if desired.                  }

VAR

  K     : integer;
  Blank : String;

Begin

  CtrLn := Line;
  K := (Field - length (Line)) div 2;
  if K < 0 then
    Exit;
  FillChar (Blank[1], K, ' ');         {This is faster than using a loop to }
  Blank[0] := chr (K);                 {add spaces.                         }
  CtrLn := Blank + Line;

End; {CtrLn (Line : String) : String}


PROCEDURE NumberLock (ONorOFF : Boolean);

         {Turns NumLck key On or Off according to input.  WARNING: Be
         sure to reset to OFF before exiting program.               }

         {Location 40:17 is byte mapped to the following bits in hex:

                      80 - Ins on,
                      40 - Caps Lck.
                      20 - Num Lck,
                      10 - Scroll,
                       8 - Alt,
                       4 - Ctl,
                       2 - Left shift,
                       1 - Right shift.                                     }

VAR

  KeyBoardMode : byte absolute $40:$17;

Begin

  if ONorOFF = true
    then
      KeyBoardMode := $20              {Set NumLck ON.                      }
    else
      KeyBoardMode := $0;              {Set NumLck OFF.                     }

end; {NumberLock}


PROCEDURE BackSpace (Numb : byte);

         {Backspaces cursor 'Numb' characters.                       }

Begin

  GoToXY (WhereX - Numb, WhereY);

End; {BackSpace (Numb : byte)}


FUNCTION Query : Boolean;

         {This function simplifies the handling of queries to the user
         that require a Y/N response.  It appends  ' (Y/N)? : ' to the
         current line and waits for a valid response. Returns 'TRUE' if
         it is 'y' or 'Y'.                                            }

         {EXAMPLE:  write ('Do you wish to continue');
                    if Query
                      then
                        (Y response)
                      else
                        (N response);                                }

         {/The above illustrates one aspect of Pascal functions that
         the newcomer may find a little strange. Namely, that even an
         oblique reference to a function serves to execute it.      /}

VAR

  ch : char;

Begin

  Chirp; write (' (Y/N)? :  ');
  BackSpace (1);
  repeat
    ch := readkey;
    ch := UpCase (ch);
    if ord (ch) in [33..90] then       {Echo input.                         }
      begin
        write (ch);
        BackSpace (1);
      end;
  until ch in ['Y','N'];
  Query := (ch = 'Y');

End; {Query : Boolean}


FUNCTION LJust (Line : String; F : byte): String;

         {Left justifies 'Line' in a field of length 'F'.            }
VAR

  Blank : String;
  K     : byte;

Begin

  K := F - length (Line);
  FillChar (Blank[1], K, ' ');         {This is faster than using a loop to }
  Blank[0] := chr (K);                 {add spaces.                         }
  LJust := Line + Blank;

End; {LJust (Line : String; F : byte)}


FUNCTION KeyCheck : char;

         {This function checks the keyboard buffer and returns: (1) #0
         if there is no entry. (2) The first character in the buffer
         if it is not a Turbo ESC pair. (3) The scan code plus 128 if
         it is an ESC pair. (Unfortunately, this scheme precludes the
         identification of certain CTRL and ALT key combinations. If
         this is important, other coding should be used.)

         The buffer is cleared before exiting to allow for impatient
         users who pound the keys if the response is not immediate.  }

         (****************           NOTE            ****************)
         (* This function will not operate satisfactorily if output is
         being sent to the screen unless the compiler option {$C-} has
         been set.                                                  *)

         {/In the PC DOS system each key generates a scan code in
         addition to an ASCII code. The scan codes are used to distin-
         guish certain keys (such as the function and arrow keys). For
         these and other special keys, TURBO returns an ESC sequence
         (ie. #27 followed by a character.) These sequences are listed
         on pp. 341-3 of the V3 manual. The choice of an ESC to signal
         a special character is a bad one since it makes it necessary
         to resort to some trickery to distinguish between an ESC en-
         tered at the keyboard from that generated by TURBO. This
         problem could easily have been avoided by using the null
         character (#0) as a signal instead.                        /}

VAR

  ch  : char;

Begin

  KeyCheck := #0;                      {Default value.                      }
  if not KeyPressed then
    Exit;
  ch := ReadKey;
  KeyCheck := ch;
  if KeyPressed and (ch = #27) then    { #27 = ESC so this is a TURBO ESC   }
    begin                              {sequence or else the user is dood-  }
      ch := ReadKey;                   {ing on the keyboard.                }
      if ord (ch) < 128
        then
          KeyCheck := chr ( ord (ch) + 128 )
        else                           {Entry not allowed by coding system. }
          KeyCheck := #0;
    end; {if KeyPressed . .}
  while KeyPressed do                  {Make sure that buffer is clear.     }
    ch := ReadKey;

End; {KeyCheck : char}


PROCEDURE Tab (Ind : byte);

         {Tabs to location 'Ind'. Since it uses the WhereX command it
         will not work on output to the printer unless the text is
         being simultaneously displayed on the screen.              }

VAR  J : byte;

Begin

  for J := WhereX to Ind do
    write (#32);

end; {Tab}


(* FUNCTION SaveCOMFile (PathFileName : String) : Boolean;

             Note: This program does not compile It may or may
             not do what it claims with version 4.0 after it is altered
             to compile. Use it at your own risk

          {/This function saves the code segment of a TURBO Pascal pro-
          gram that is being run as a COM file. One application is to
          allow the user to save an 'installed' version of the program.
          NOTE: Any variables (such as video attributes) that will be
          changed by the user must be defined as typed constants so
          that they are stored in the code segment. The input 'Path-
          FileName' can optionally include a drive and/or directory
          path in addition to the file name. (Curiously, DOS does not
          apparently provide any means for a program to discover its
          own name.) The function returns 'FALSE' if an error is detec-
          ted. Because the file size is estimated in increments of 16
          bytes, the COM file saved by this routine may be up to 15
          bytes larger than the original file. However, this has no
          effect on the memory occupied when the file is loaded.     /}

          {             *********** WARNING ***********

          This routine must ONLY be run when the program has been load-
          ed as a COM file. A file saved when in memory mode will be-
          have erratically when loaded and may hang the computer. (This
          is because of a difference in the location assigned to CSeg
          in the two modes.)                                          }

VAR

  ComStart : byte absolute CSeg:$100;  {Addr. of the start of the program.  }
  ComSize  : integer;                  {Size of loaded program in 16-byte   }
  OutFile  : file;                     {paragraphs.                         }
  Check    : integer;                  {Error return.                       }
  Loc      : byte;                     {Loc and HoldStr used only by the    }
  HoldStr  : string[80];               {back up routine.                    }

Begin

  SaveCOMFile := false;                {Default return.                     }

          { Uncomment the next eight lines if back up is required. }
  (*
  HoldStr := PathFileName;
  Loc := Pos ('.', HoldStr);
  Delete (HoldStr, Loc, 4);            {Delete .COM.                        }
  HoldStr := HoldStr + '.CMB';         {Change extension if desired.        }
  Assign (OutFile, PathFileName);
  {$I-} ReName (OutFile, HoldStr); {$I+}
  if IOResult <> 0 then                {Error - probably file not found.    }
    Exit;
  *)(*                    { End of Backup routine. }

  ComSize := DSeg - CSeg - 16;         {The first 16 paras. is the PSP.     }
  Assign (OutFile, PathFileName);
  {$I-}
  ReWrite (OutFile, 16);               {Record size = 16 byte (1 para.)     }
  BlockWrite (OutFile, ComStart, ComSize, Check);
  {$I+}
  if (IOResult <> 0) or (Check <> ComSize)
    then                               {Error.                              }
      Exit;
  Close (OutFile);
  SaveComFile := true;

End; {SaveCOMFile}*)

Begin
End.