               }v


%¤.¤       INKEY   INC 	 ,=

  ¤  h      POWER   INC  Jÿ

  	¤        STRING  INC ¨ Jƒ

  ¤  <      README  DOCÀ  ùl

  	¤  m     ÿ                               ÿ                               ÿ                               {=====================================================}
function InKey(wait:boolean; var special:boolean):char;
{=====================================================}
{
   Turbo Pascal equivalent of BASIC's INKEY$ function

   Written by:  Tryg Helseth
                Minneapolis, Minnesota

   Last Revision:  12/27/84

   This function gets the next character from the keyboard.  If a
   special key is detected (two characters sent), then the special
   flag is set to true and the second character returned.  The flag
   is false otherwise.

   If wait is true, then InKey will wait until a key has been pressed.
   A null value (#0) is returned if wait is false and no key was pressed.
}

var InChar : char;

begin
   special := false;
   if wait or KeyPressed then begin
      read(kbd,InChar);
    { test for special character }
      if KeyPressed then begin
         read(kbd,InChar);
         special := true
         end;
      InKey := InChar
      end {if}
   else
      InKey := #0
end; {INKEY}
{================================================}
function Power(Valu:real; Exponent:integer): real;
{================================================}
{
WRITTEN BY:     Tryg Helseth
                Minneapolis, Minnesota

                Revision:  1/2/85

PURPOSE:        Raise a floating point value to an integer exponent.
                Sucessive squaring of the input value gives the
                powers of 1, 2, 4, 8, ...  which are combined to
                give the desired power.

                WARNING:  overflow is not trapped; the program will
                abort with a run time error of 01 if overflow occurs.

PARAMETERS:

     INPUT:     Valu     = Value to be raised to a power.
                Exponent = desired power.

    OUTPUT:     none

FUNCTION VALUE: Power = Valu**Exponent

}

var     ThisPwr : integer;
          ptemp : real;
         negate : boolean;

begin
    { adjust for negative exponent }
    if (Exponent >= 0) then
       negate := false
    else begin
       Exponent := - Exponent;
       negate := true
    end;

    { initialize ptemp for odd or even power }
    if odd(Exponent) then
       ptemp := valu
    else
       ptemp := 1;

    { compute powers of 2 and higher }
    ThisPwr := 2;
    while ThisPwr <= Exponent do begin
       valu := sqr(valu);
       if (ThisPwr and Exponent) <> 0 then ptemp := ptemp * valu;
       ThisPwr := ThisPwr shl 1;
       end;

    { Adjust if negative, and assign value to function }
    if negate and (ptemp <> 0) then
       power := 1 / ptemp
    else
       power := ptemp
end;
{ Suplementry String functions and procedures for Turbo Pascal  }

(*
       Written by: Tryg Helseth
                   Minneapolis, Minnesota

    Last Revision: 1/4/85

USAGE NOTES:

  The following routines provide common string functions that are
  not supplied with Turbo Pascal.  Many are patterned (and named)
  after the General Electric Information Service COompany (GEISCO)
  FORTRAN 77 string routines; others mimic SNOBOL primatives.

  The general calling sequence is:

     OutString := Func(InpString[,Parms])

  where:

     OutString = the output or target string,
          Func = function name,
        InpStr = Input String,
       [Parms] = Additional parameter(s) used by some functions.

AVAILABLE FUNCTIONS:

    LoCase      Convert a single character to lower case.
    LowerCase   Convert a string to lower case.
    UpperCase   Convert a string to upper case.
    TrimL       Trim Left: remove leading spaces from a string.
    TrimR       Trim Right: remove trailing spaces from a string.
    PadL        Pad Left: Add leading spaces to give desired field length.
    PadR        Pad Right: Add trailing spaces to give desired field length.
    JustL       Left Justify a string within a desired field length.
    JustR       Right Justify a string within a desired field length.
    Center      Center a string within a desired field length.
    GetStr      Get String: Extracts a substring up to a specified delimiter.
    Break       Extracts a substring up to the first of several delimters.
    Span        Extracts a substring of delimiters up to a NON delimiter.

    Note: GetStr, Span, and Break, modify the input string.  The other
          functions do not modify any parameters.

AVAILABLE PROCEDURES:

    GString     Get String: Used by Span and Break functions.  It performs
                both functions and allows more control by the programmer.

    RealStr     Convert a value of type REAL to a string representation in
                any base from 2 to 36.

    RealVal     Convert a string representation of a number to a REAL value.
                The number may be in any base from 2 to 36.

TYPE DECLARATION:

  All strings are of the type, LString, which should be declared in the main
  program as:

      Type LString = string[n]

  where n is a constant in the range of 1 to 255.

  If you wish to use these functions with strings of different declared
  lengths, then you must use the compiler option, {$V-}.  If you choose
  to do this, be sure that the defined length of LString is greater than
  or equal to the longest string you will be using.

FUNCTION DECLARATIONS:   *)

{===========================================}
function LoCase(InChar: char): char; forward;
{===========================================}
{
Purpose:        Convert a single character to lower case.

Parameters:
     Input:     InChar = character to be converted.
    Output:     none

Function Value: LoCase = converted character.
}

{====================================================}
function LowerCase(InpStr: LString): LString; forward;
{====================================================}
{
Purpose:        Convert a string of characters to lower case.

Parameters:
     Input:     InpStr = string to be converted.
    Output:     none

Function Value: LowerCase = converted string.
}

{====================================================}
function UpperCase(InpStr: LString): LString; forward;
{====================================================}
{
Purpose:        Convert a string of characters to upper case.

Parameters:
     Input:     InpStr = string to be converted.
    Output:     none

Function Value: UpperCase = converted string.
}

{================================================}
function TrimL(InpStr: LString): LString; forward;
{================================================}
{
Purpose:        Trim Left: Remove leading spaces from a string.

Parameters:
     Input:     InpStr = string to be trimmed.
    Output:     none

Function Value: TrimL = trimmed string.
}

{================================================}
function TrimR(InpStr: LString): LString; forward;
{================================================}
{
Purpose:        Trim Right: Remove trailing spaces from a string.

Parameters:
     Input:     InpStr = string to be trimmed.
    Output:     none

Function Value: TrimR = trimmed string.
}

{==================================================================}
function PadL(InpStr: LString; FieldLen: integer): LString; forward;
{==================================================================}
{
Purpose:        Pad Left: Pad a string on the left with spaces to
                fill it to a desired field length.  Trailing spaces
                are not removed.
Parameters:
     Input:     InpStr = string to be padded.
    Output:     none

Function Value: PadL = padded string.
}

{==================================================================}
function PadR(InpStr: LString; FieldLen: integer): LString; forward;
{==================================================================}
{
Purpose:        Pad Right: Pad a string on the right with spaces to
                fill it to a desired field length.  Leading spaces
                are not removed.
Parameters:
     Input:     InpStr = string to be padded.
    Output:     none

Function Value: PadR = padded string.
}

{===================================================================}
function JustL(InpStr: LString; FieldLen: integer): LString; forward;
{===================================================================}
{
Purpose:        Left justify a string within a desired field length.
                First leading spaces are removed, then the string is
                padded with trailing spaces to the desired length.
Parameters:
     Input:     InpStr = string to be justified.
    Output:     none

Function Value: JustL = justified string.
}

{===================================================================}
function JustR(InpStr: LString; FieldLen: integer): LString; forward;
{===================================================================}
{
Purpose:        Right justify a string within a desired field length.
                First trailing spaces are removed, then leading spaces
                are inserted fill to the desired length.
Parameters:
     Input:     InpStr = string to be justified.
    Output:     none

Function Value: JustR = justified string.
}

{====================================================================}
function Center(InpStr: LString; FieldLen: integer): LString; forward;
{====================================================================}
{
Purpose:        Center a string within a desired field length.  First
                the string is stripped of leading and trailing spaces,
                then the resultant string is padded equally with
                leading and trailing spaces.
Parameters:
     Input:     InpStr = string to be justified.
    Output:     none

Function Value: Center = centered string.
}

{==================================================================}
function GetStr(var InpStr: LString; Delim: Char): LString; forward;
{==================================================================}
{
Purpose:       Strating at the first position of the input string,
               return a substring containing all characters up to
               (but not including) the fisrt occurence of the given
               delimiter.  If the delimiter is not found, then the
               entire input string is returned.  The substring and
               delimiter are then deleted from the input string.

Parameters:
     Input:     InpStr = string from which substring is removed.
                Delim  = delimiter to be used.
    Output:     InStr  = remainder of input string.

Function Value: GetStr = Extracted substring.
}

{=====================================================================}
function Break(var InpStr: LString; DelStr: LString): LString; forward;
{=====================================================================}
{
Purpose:       Emulates the SNOBOL BREAK function.  Operation is
               similar to GetStr except that several delimiters
               may be used.  The substring returns all characters
               up to the first of any delimiter in DelStr.  Unlike
               GetStr, the Delimiter found is NOT removed from
               the input string.

Parameters:
     Input:     InpStr = string from which substring is removed.
                DelStr = list of delimiters.
    Output:     InStr  = remainder of input string.

Function Value: Break  = Extracted substring (Break on delimiter).
}

{====================================================================}
function Span(var InpStr: LString; DelStr: LString): LString; forward;
{====================================================================}
{
Purpose:       Emulates the SNOBOL Span function.  Operation is
               is the reverse of Break; The input string is scanned
               for characters IN DelStr.  It returns a  substring
               containing ONLY delimiters found starting at the
               first position up the the first NON delimiter.  That
               character is NOT removed from the input string.

Parameters:
     Input:     InpStr = string from which substring is removed.
                DelStr = list of delimiters.
    Output:     InStr  = remainder of input string.

Function Value: Span   = Extracted substring (Span of delimiters).
}

{=======================================================================}
procedure GString(InpStr, DelStr: LString; span: boolean;
                  var cpos, dpos: integer; var OutStr: LString); forward;
{=======================================================================}
{
Purpose:       Emulates both the SPAN and BREAK functions of SNOBOL.

               SPAN:  If span is true, then starting from position, cpos,
               the input string is scanned for characters in the string,
               DelStr.  These characters are copied to the output string
               until either a character NOT in DelStr is found or the end
               of the string is reached.  Position pointer, cpos, is reset
               to point at the break character.  If the end of the string
               is reached, cpos is set to zero.

               BREAK: If span is false, then the input string is scanned
               for characters NOT in the string, DelStr.  The output string
               contains all characters up to the first delimiter.  Position
               pointer, cpos, is set to point at the delimiter found.  If a
               delimiter was not found, cpos is set to zero.

               Dpos is set to position in DelStr of the delimiter found.  If
               none found, dpos is set to zero.

Parameters:
     Input:     InpStr = string from which subs9ring is Copied.
                DelStr = delimiters to be used.
                span   = true = span, false = break.
                cpos   = starting position in input string.

    Output:     cpos   = position past found delimiter.
                dpos   = which delimiter was found.
                OutStr = substring copied from the input string.
}

{=================================================}
Procedure RealStr(Valu: Real; Base, Trail: integer;
                  var OutStr: LString); forward;
{=================================================}
{
Purpose:        Convert a real value to an equivalent string representation.
                The value can be represented in any base from 1 to 36 with
                a specified number of digits to the right of the radix point.
                Digits 10 thru 35 are represeted by the letters A thru Z.

Parameters:

     Input:     Valu   = Real value to be converted to a string.
                Base   = Desired base.
                Trail  = number of digits to the right of the radix point.

    Output:     OutStr = string representation.
}

{===========================================================}
Procedure RealVal(InpStr: LString; Base: integer;
                  Var Err: integer; Var Valu: real); forward;
{===========================================================}
{
Purpose:        Convert a string representation of a number to a real value.
                The value can be represented in any base from 1 to 36 and
                can have a fractional part.  Digits 10 thru 35 are represeted
                by the letters A thru Z respectively.  If an illegial
                character is encounterd, conversion halts and the error
                postion is reported through the variable, Err.

Parameters:

     Input:     InpStr = String representation to be converted to a real value.
                Base   = Base the value is represented in.

    Output:     Err    = position of illegial character; set to zero
                         if no error is encountered.
                Valu   = converted value.
}

{
FUNCTION BODIES:
}

{==============}
function LoCase;
{==============}
{ convert a character to lower case }
begin
   if InChar IN ['A'..'Z'] then
      LoCase := Chr(Ord(Inchar)+32)
   else
      LoCase := InChar
end;

{=================}
function LowerCase;
{=================}

{ convert a string to lower case characters }

var i : integer;

begin
   for i := 1 to Length(InpStr) do
       LowerCase[i] := LoCase(InpStr[i]);
   LowerCase[0] := InpStr[0]
end;

{=================}
function UpperCase;
{=================}

{ convert a string to upper case characters }

var i : integer;

begin
   for i := 1 to Length(InpStr) do
       UpperCase[i] := UpCase(InpStr[i]);
   UpperCase[0] := InpStr[0]
end;

{=============}
function TrimL;
{=============}

{ strip leading spaces from a string }

var i,len : integer;

begin
   len := length(InpStr);
   i := 1;
   while (i <= len) and (InpStr[i] = ' ') do
      i := i + 1;
   TrimL := Copy(InpStr,i,len-i+1)
end;

{=============}
function TrimR;
{=============}

{ strip trailing spaces from a string }

var i : integer;

begin
   i := length(InpStr);
   while (i >= 1) and (InpStr[i] = ' ') do
      i := i - 1;
   TrimR := Copy(InpStr,1,i)
end;

{============}
function PadL;
{============}

{ Pad string on left with spaces to fill to the desired field length }

var  STemp : LString;
         i : integer;

begin
   If FieldLen >= SizeOF(InpStr) then FieldLen := SizeOf(InpStr)-1;
   if length(InpStr) > FieldLen then
      PadL := Copy(InpStr,1,FieldLen)
   else begin
      STemp := InpStr;
      for i := Length(STemp)+1 to FieldLen do
         Insert(' ',STemp,1);
      PadL := STemp
      end
end;

{============}
function PadR;
{============}

{ Pad string on right with spaces to fill to the desired field length }

var  STemp : LString;
         i : integer;

begin
   If FieldLen >= SizeOF(InpStr) then FieldLen := SizeOf(InpStr)-1;
   if length(InpStr) > FieldLen then
      PadR := Copy(InpStr,1,FieldLen)
   else begin
      STemp := InpStr;
      for i := Length(STemp)+1 to FieldLen do
         STemp := STemp + ' ';
      PadR := STemp
      end
end;

{=============}
function JustL;
{=============}

{ Left justify the string within the given field length }

begin
   JustL := PadR(TrimL(InpStr),FieldLen)
end;

{=============}
function JustR;
{=============}

{ Right justify the string within the given field length }

begin
   JustR := PadL(TrimR(InpStr),FieldLen)
end;

{==============}
function Center;
{==============}

{ Center a string within a specified field length;  the string
  is padded on both sides with spaces }

var LeadSpaces : integer;
        STemp : LString;
begin
   { strip leading and trailing spaces; determine the
     Number of spaces needed to center the string }

   STemp := TrimR(TrimL(InpStr));
   LeadSpaces := (FieldLen - Length(STemp) + 1) div 2;

   { insert leading spaces then trailing spaces }
   Center := PadR(PadL(STemp,FieldLen-LeadSpaces),FieldLen)
end;

{==============}
function GetStr;
{==============}

{ Return a string containing all characters starting at the
  first position of the source string up to the first delimiter.
}

var i : integer;
begin
   i := Pos(Delim,InpStr);
   if i = 0 then begin
      GetStr := InpStr;
      InpStr := ''
      end
   else begin
      GetStr := Copy(InpStr,1,i-1);
      Delete(InpStr,1,i)
      end
end;

{=============}
function Break;
{=============}

{ Emulate SNOBOL BREAK function }

var cp, dp : integer;
    OutStr : LString;

begin
   cp := 1;
   GString(InpStr,DelStr,false,cp,dp,OutStr);
   Break := OutStr;
   if cp = 0 then
      InpStr := ''
   else
      Delete(InpStr,1,cp-1)
end;

{============}
function Span;
{============}

{ Emulate SNOBOL SPAN function }

var cp, dp : integer;
    OutStr : LString;

begin
   cp := 1;
   GString(InpStr,DelStr,true,cp,dp,OutStr);
   Span := OutStr;
   if cp = 0 then
      InpStr := ''
   else
      Delete(InpStr,1,cp-1)
end;

{================}
procedure GString;
{================}

{ Return a string containing all characters starting at position, cpos,
 of the source string up to the first first occurence of any of several
 delimiters.  The position of the found delimiter is returned as well
 as which delimiter.
}
var done : boolean;

begin
   OutStr := ''; dpos := 0;
   if cpos > 0 then begin
      done := false;
      while (cpos <= Length(InpStr)) and not done do begin
         dpos := pos(InpStr[cpos],DelStr);
         if span xor (dpos = 0) then begin
            OutStr := OutStr + InpStr[cpos];
            cpos := cpos + 1
            end
         else
            done := true
         end;
      if (span xor (dpos = 0)) or (cpos > length(InpStr)) then cpos := 0
      end
end;

{================}
procedure RealStr;
{================}

{ Convert a real value to a string }

var     i, digit, MaxLen : integer;
       IntValu, FracValu : real;
                    Sign : boolean;

{-----------------------------------}
function NewDigit(num:integer): char;
{-----------------------------------}

begin
   if num < 10 then
      NewDigit := chr(num + ord('0'))
   else
      NewDigit := chr(num + ord('A') - 10)
end;

begin
   MaxLen := SizeOf(OutStr);
   if Valu < 0 then begin
      Valu := - Valu;
      Sign := true
      end
   else
      Sign := false;
   IntValu := Int(Valu);
   FracValu := Frac(Valu);
   if Valu < 1 then
      OutStr := '0'
   else begin
      { convert Leading digits to a string }
      OutStr := '';
      While (IntValu >= 1) and (Length(OutStr) < MaxLen) do begin
         Valu := IntValu / Base;
         Digit := Trunc(Round(Frac(Valu)*Base));
         IntValu := Int(Valu);
         Insert(NewDigit(digit),OutStr,1);
         end
      end;
   if (Trail > 0) and ( length(OutStr) < MaxLen) then begin
      { convert trialing digits }
      OutStr := OutStr + '.';
      i := 1;
      While (Length(OutStr) < MaxLen) and (i <= Trail) do begin
         Valu := FracValu * Base;
         Digit := Trunc(Valu);
         FracValu := Frac(Valu);
         OutStr := OutStr + NewDigit(Digit);
         i := i + 1
         end
      end;
    if sign then Insert('-',OutStr,1);
end;

{================}
procedure RealVal;
{================}

{ convert a string to a real value }

var          i, digit : integer;
      GotRadixPoint,
      GotDigit,Negate : boolean;
               InChar : char;
              InvBase : real;
begin
   Valu := 0; Err := 0; negate := false; i := 0;
   InvBase := 1; GotRadixPoint := false;

   while (i < length(InpStr)) and (err = 0) do begin
      i := i + 1;
      GotDigit := false;
      InChar := UpCase(InpStr[i]);
      case InChar of
      '0'..'9': begin
                   digit := ord(InpStr[i]) - ord('0');
                   GotDigit := true
                   end;
      'A'..'Z': begin
                   digit := ord(InChar) - ord('A') + 10;
                   GotDigit := true
                   end;
          '-' : begin
                   if negate then
                      err := i
                   else
                      negate := true
                   end;
          '+' : if negate then err := i;
          '.' : if GotRadixPoint then
                      err := i
                   else
                      GotRadixPoint := true;
         else    err := i
         end  {case} ;
      if GotDigit then
         if digit >= base then
            err := i
         else
            if GotRadixPoint then begin
               InvBase := InvBase / base;
               Valu := Valu + InvBase * digit
               end
            else
               Valu := Valu * base + digit
      end; { while }
   if negate then valu := - valu;
end;
======================= Turbo Include Library ========================

The files in this library contain functions and procedures which are
an extension of Turbo Pascal routines.  These routines are written in
"pure" Turbo 2.0 (No Intr or DOS calls) so they should be compatible
with all operating systems.  You may include the file in your program
using the {$i filename.inc} command.

The files are:

INKEY.INC   INKEY$ function for Turbo Pascal.  It is designed
            for MS-DOS, and may need modification for other
            systems.

POWER.INC   Raise a REAL number to an INTEGER power (positive
            or negative).

STRING.INC  A collection of string routines to round out those
            provided with Turbo.

            Available string functions:

            LoCase     Convert a single character to lower case.
            LowerCase  Convert a string to lower case.
            UpperCase  Convert a string to upper case.
            TrimL      Trim Left: remove leading spaces from a string.
            TrimR      Trim Right: remove trailing spaces from a string.
            PadL       Pad Left: Add leading spaces to give a desired
                                 field length.
            PadR       Pad Right: Add trailing spaces to give a desired
                                  field length.
            JustL      Left Justify a string within a desired field length.
            JustR      Right Justify a string within a desired field length.
            Center     Center a string within a desired field length.
            GetStr     Get String: Extracts a substring up to a delimiter.
            Break      Extract a substring up to the first of several delimters.
            Span       Extract a substring of delimiters up to a NON delimiter.

            Available string procedures:

            GString     Get String: Used by Span and Break functions.  It
                        performs both functions with greater program control.

            RealStr     Convert a value of type REAL to a string representation
                        in any base from 2 to 36.

            RealVal     Convert a string representation of a number to a REAL
                        value.  The number may be in any base from 2 to 36.

Usage:  Documentation on how to use the functions and procedures is provided
        in the source listings.

Dedication:

        These files are dedicated to Gyro Gearloose, who invented for
        the pure joy of it.  His example gave me the strength to write
        and collect together these routines not knowing if they would
        ever be of use to anyone.

        (By the way, Gyro may have been thinking of computers when he said,
        "Nobody can make a machine so smart that some jerk won't be too dumb
        to run it".)

              Happy Computing -- may it never be of use to anyone!

                                Tryg Helseth
                           Minneapolis, Minnesota

                                  1/3/85
