Power-Programmierung/CD1.mdf/pascal/library/dos/tug__002/trig.pas

Pascal/Delphi Source File | 1988-08-14 | 16.8 KB | 537 lines

{TUG PDS CERT 1.01 (Pascal)

==========================================================================

                  TUG PUBLIC DOMAIN SOFTWARE CERTIFICATION

The Turbo User Group (TUG) is recognized by Borland International as the
official support organization for Turbo languages.  This file has been
compiled and verified by the TUG library staff.  We are reasonably certain
that the information contained in this file is public domain material, but
it is also subject to any restrictions applied by its author.

This diskette contains PROGRAMS and/or DATA determined to be in the PUBLIC
DOMAIN, provided as a service of TUG for the use of its members.  The
Turbo User Group will not be liable for any damages, including any lost
profits, lost savings or other incidental or consequential damages arising
out of the use of or inability to use the contents, even if TUG has been
advised of the possibility of such damages, or for any claim by any
other party.

To the best of our knowledge, the routines in this file compile and function
properly in accordance with the information described below.

If you discover an error in this file, we would appreciate it if you would
report it to us.  To report bugs, or to request information on membership
in TUG, please contact us at:

             Turbo User Group
             PO Box 1510
             Poulsbo, Washington USA  98370

--------------------------------------------------------------------------
                       F i l e    I n f o r m a t i o n

* DESCRIPTION
Supplies missing trigonometric functions for Turbo Pascal 4.0. Also
provides hyperbolic, logarithmic, power, and root functions. All trig
functions accessibile by radians, decimal degrees, degrees-minutes-seconds
and a global DegreeType. Author: Hugo Hemmerich.

* ASSOCIATED FILES

* CHECKED BY
DRM - 08/14/88

* KEYWORDS
TURBO PASCAL V4.0 PROGRAM TRIG MATH

==========================================================================
}
unit Trig;

(*  TRIG  -  Supplies missing trigonometric functions for Turbo Pascal 4.0
 *           Also provides hyperbolic, logarithmic, power, and root functions.
 *           All trig functions accessible by radians, decimal degrees,
 *           degrees-minutes-seconds, and a global DegreeType.  Conversions
 *           between these are supplied.
 *
 *  Written November 23, 1987 by Hugo Hemmerich, Refined Technologies.
 *  All code granted to the public domain.
 *
 *  Questions and comments to CompuServe account number 72376,3505
 *)

interface

type
  DegreeType =  record
                  Degrees, Minutes, Seconds : real;
                end;
const
  Infinity = 9.9999999999E+37;

{  Radians  }
{ sin, cos, and arctan are predefined }

function Tan( Radians : real ) : real;
function ArcSin( InValue : real ) : real;
function ArcCos( InValue : real ) : real;

{  Degrees, expressed as a real number  }

function DegreesToRadians( Degrees : real ) : real;
function RadiansToDegrees( Radians : real ) : real;
function Sin_Degree( Degrees : real ) : real;
function Cos_Degree( Degrees : real ) : real;
function Tan_Degree( Degrees : real ) : real;
function ArcSin_Degree( Degrees : real ) : real;
function ArcCos_Degree( Degrees : real ) : real;
function ArcTan_Degree( Degrees : real ) : real;

{  Degrees, in Degrees, Minutes, and Seconds, as real numbers  }

function DegreePartsToDegrees( Degrees, Minutes, Seconds : real ) : real;
function DegreePartsToRadians( Degrees, Minutes, Seconds : real ) : real;
procedure DegreesToDegreeParts( DegreesIn : real;
                                var Degrees, Minutes, Seconds : real );
procedure RadiansToDegreeParts( Radians : real;
                                var Degrees, Minutes, Seconds : real );
function Sin_DegreeParts( Degrees, Minutes, Seconds : real ) : real;
function Cos_DegreeParts( Degrees, Minutes, Seconds : real ) : real;
function Tan_DegreeParts( Degrees, Minutes, Seconds : real ) : real;
function ArcSin_DegreeParts( Degrees, Minutes, Seconds : real ) : real;
function ArcCos_DegreeParts( Degrees, Minutes, Seconds : real ) : real;
function ArcTan_DegreeParts( Degrees, Minutes, Seconds : real ) : real;

{  Degrees, expressed as DegreeType ( reals in record ) }

function DegreeTypeToDegrees( DegreeVar : DegreeType ) : real;
function DegreeTypeToRadians( DegreeVar : DegreeType ) : real;
procedure DegreeTypeToDegreeParts( DegreeVar : DegreeType;
                                   var Degrees, Minutes, Seconds : real );
procedure DegreesToDegreeType( Degrees : real; var DegreeVar : DegreeType );
procedure RadiansToDegreeType( Radians : real; var DegreeVar : DegreeType );
procedure DegreePartsToDegreeType( Degrees, Minutes, Seconds : real;
                                   var DegreeVar : DegreeType );
function Sin_DegreeType( DegreeVar : DegreeType ) : real;
function Cos_DegreeType( DegreeVar : DegreeType ) : real;
function Tan_DegreeType( DegreeVar : DegreeType ) : real;
function ArcSin_DegreeType( DegreeVar : DegreeType ) : real;
function ArcCos_DegreeType( DegreeVar : DegreeType ) : real;
function ArcTan_DegreeType( DegreeVar : DegreeType ) : real;

{  Hyperbolic functions  }

function Sinh( Invalue : real ) : real;
function Cosh( Invalue : real ) : real;
function Tanh( Invalue : real ) : real;
function Coth( Invalue : real ) : real;
function Sech( Invalue : real ) : real;
function Csch( Invalue : real ) : real;
function ArcSinh( Invalue : real ) : real;
function ArcCosh( Invalue : real ) : real;
function ArcTanh( Invalue : real ) : real;
function ArcCoth( Invalue : real ) : real;
function ArcSech( Invalue : real ) : real;
function ArcCsch( Invalue : real ) : real;

{  Logarithms, Powers, and Roots  }

{ e to the x  is  exp() }
{ natural log is  ln()  }
function Log10( InNumber : real ) : real;
function Log( Base, InNumber : real ) : real;  { log of any base }
function Power( InNumber, Exponent : real ) : real;
function Root( InNumber, TheRoot : real ) : real;

{----------------------------------------------------------------------}
implementation

const
  RadiansPerDegree =  0.017453292520;
  DegreesPerRadian = 57.295779513;
  MinutesPerDegree =   60.0;
  SecondsPerDegree = 3600.0;
  SecondsPerMinute = 60.0;
  LnOf10 = 2.3025850930;

{-----------}
{  Radians  }
{-----------}

{ sin, cos, and arctan are predefined }

function Tan { ( Radians : real ) : real };
  { note: returns Infinity where appropriate }
  var
    CosineVal : real;
    TangentVal : real;
  begin
  CosineVal := cos( Radians );
  if CosineVal = 0.0 then
    Tan := Infinity
  else
    begin
    TangentVal := sin( Radians ) / CosineVal;
    if ( TangentVal < -Infinity ) or ( TangentVal > Infinity ) then
      Tan := Infinity
    else
      Tan := TangentVal;
    end;
  end;

function ArcSin{ ( InValue : real ) : real };
  { notes: 1) exceeding input range of -1 through +1 will cause runtime error }
  {        2) only returns principal values                                   }
  {             ( -pi/2 through pi/2 radians ) ( -90 through +90 degrees )    }
  begin
  if abs( InValue ) = 1.0 then
    ArcSin := pi / 2.0
  else
    ArcSin := arctan( InValue / sqrt( 1 - InValue * InValue ) );
  end;

function ArcCos{ ( InValue : real ) : real };
  { notes: 1) exceeding input range of -1 through +1 will cause runtime error }
  {        2) only returns principal values                                   }
  {             ( 0 through pi radians ) ( 0 through +180 degrees )           }
  var
    Result : real;
  begin
  if InValue = 0.0 then
    ArcCos := pi / 2.0
  else
    begin
    Result := arctan( sqrt( 1 - InValue * InValue ) / InValue );
    if InValue < 0.0 then
      ArcCos := Result + pi
    else
      ArcCos := Result;
    end;
  end;

{---------------------------------------}
{  Degrees, expressed as a real number  }
{---------------------------------------}

function DegreesToRadians{ ( Degrees : real ) : real };
  begin
  DegreesToRadians := Degrees * RadiansPerDegree;
  end;

function RadiansToDegrees{ ( Radians : real ) : real };
  begin
  RadiansToDegrees := Radians * DegreesPerRadian;
  end;

function Sin_Degree{ ( Degrees : real ) : real };
  begin
  Sin_Degree := sin( DegreesToRadians( Degrees ) );
  end;

function Cos_Degree{ ( Degrees : real ) : real };
  begin
  Cos_Degree := cos( DegreesToRadians( Degrees ) );
  end;

function Tan_Degree{ ( Degrees : real ) : real };
  begin
  Tan_Degree := Tan( DegreesToRadians( Degrees ) );
  end;

function ArcSin_Degree{ ( Degrees : real ) : real };
  begin
  ArcSin_Degree := ArcSin( DegreesToRadians( Degrees ) );
  end;

function ArcCos_Degree{ ( Degrees : real ) : real };
  begin
  ArcCos_Degree := ArcCos( DegreesToRadians( Degrees ) );
  end;

function ArcTan_Degree{ ( Degrees : real ) : real };
  begin
  ArcTan_Degree := arctan( DegreesToRadians( Degrees ) );
  end;

{--------------------------------------------------------------}
{  Degrees, in Degrees, Minutes, and Seconds, as real numbers  }
{--------------------------------------------------------------}

function DegreePartsToDegrees{ ( Degrees, Minutes, Seconds : real ) : real };
  begin
  DegreePartsToDegrees := Degrees + ( Minutes / MinutesPerDegree ) +
                                       ( Seconds / SecondsPerDegree );
  end;

function DegreePartsToRadians{ ( Degrees, Minutes, Seconds : real ) : real };
  begin
  DegreePartsToRadians := DegreesToRadians( DegreePartsToDegrees( Degrees,
                                                        Minutes, Seconds ) );
  end;

procedure DegreesToDegreeParts{ ( DegreesIn : real;
                                  var Degrees, Minutes, Seconds : real ) };
  begin
  Degrees := int( DegreesIn );
  Minutes := ( DegreesIn - Degrees ) * MinutesPerDegree;
  Seconds := frac( Minutes );
  Minutes := int( Minutes );
  Seconds := Seconds * SecondsPerMinute;
  end;

procedure RadiansToDegreeParts{ ( Radians : real;
                                  var Degrees, Minutes, Seconds : real ) };
  begin
  DegreesToDegreeParts( RadiansToDegrees( Radians ),
                          Degrees, Minutes, Seconds );
  end;

function Sin_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };
  begin
  Sin_DegreeParts := sin( DegreePartsToRadians( Degrees, Minutes, Seconds ) );
  end;

function Cos_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };
  begin
  Cos_DegreeParts := cos( DegreePartsToRadians( Degrees, Minutes, Seconds ) );
  end;

function Tan_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };
  begin
  Tan_DegreeParts := Tan( DegreePartsToRadians( Degrees, Minutes, Seconds ) );
  end;

function ArcSin_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };
  begin
  ArcSin_DegreeParts := ArcSin( DegreePartsToRadians( Degrees,
                                                      Minutes, Seconds ) );
  end;

function ArcCos_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };
  begin
  ArcCos_DegreeParts := ArcCos( DegreePartsToRadians( Degrees,
                                                      Minutes, Seconds ) );
  end;

function ArcTan_DegreeParts{ ( Degrees, Minutes, Seconds : real ) : real };
  begin
  ArcTan_DegreeParts := arctan( DegreePartsToRadians( Degrees,
                                                      Minutes, Seconds ) );
  end;

{-------------------------------------------------------}
{  Degrees, expressed as DegreeType ( reals in record ) }
{-------------------------------------------------------}

function DegreeTypeToDegrees{ ( DegreeVar : DegreeType ) : real };
  begin
  DegreeTypeToDegrees := DegreePartsToDegrees( DegreeVar.Degrees,
                                       DegreeVar.Minutes, DegreeVar.Seconds );
  end;

function DegreeTypeToRadians{ ( DegreeVar : DegreeType ) : real };
  begin
  DegreeTypeToRadians := DegreesToRadians( DegreeTypeToDegrees( DegreeVar ) );
  end;

procedure DegreeTypeToDegreeParts{ ( DegreeVar : DegreeType;
                                     var Degrees, Minutes, Seconds : real ) };
  begin
  Degrees := DegreeVar.Degrees;
  Minutes := DegreeVar.Minutes;
  Seconds := DegreeVar.Seconds;
  end;

procedure DegreesToDegreeType{ ( Degrees : real; var DegreeVar : DegreeType )};
  begin
  DegreesToDegreeParts( Degrees, DegreeVar.Degrees,
                        DegreeVar.Minutes, DegreeVar.Seconds );
  end;

procedure RadiansToDegreeType{ ( Radians : real; var DegreeVar : DegreeType )};
  begin
  DegreesToDegreeParts( RadiansToDegrees( Radians ), DegreeVar.Degrees,
                        DegreeVar.Minutes, DegreeVar.Seconds );
  end;

procedure DegreePartsToDegreeType{ ( Degrees, Minutes, Seconds : real;
                                     var DegreeVar : DegreeType ) };
  begin
  DegreeVar.Degrees := Degrees;
  DegreeVar.Minutes := Minutes;
  DegreeVar.Seconds := Seconds;
  end;

function Sin_DegreeType{ ( DegreeVar : DegreeType ) : real };
  begin
  Sin_DegreeType := sin( DegreeTypeToRadians( DegreeVar ) );
  end;

function Cos_DegreeType{ ( DegreeVar : DegreeType ) : real };
  begin
  Cos_DegreeType := cos( DegreeTypeToRadians( DegreeVar ) );
  end;

function Tan_DegreeType{ ( DegreeVar : DegreeType ) : real };
  begin
  Tan_DegreeType := Tan( DegreeTypeToRadians( DegreeVar ) );
  end;

function ArcSin_DegreeType{ ( DegreeVar : DegreeType ) : real };
  begin
  ArcSin_DegreeType := ArcSin( DegreeTypeToRadians( DegreeVar ) );
  end;

function ArcCos_DegreeType{ ( DegreeVar : DegreeType ) : real };
  begin
  ArcCos_DegreeType := ArcCos( DegreeTypeToRadians( DegreeVar ) );
  end;

function ArcTan_DegreeType{ ( DegreeVar : DegreeType ) : real };
  begin
  ArcTan_DegreeType := arctan( DegreeTypeToRadians( DegreeVar ) );
  end;

{------------------------}
{  Hyperbolic functions  }
{------------------------}

function Sinh{ ( Invalue : real ) : real };
  const
    MaxValue = 88.029691931;  { exceeds standard turbo precision }
  var
    Sign : real;
  begin
  Sign := 1.0;
  if Invalue < 0 then
    begin
    Sign := -1.0;
    Invalue := -Invalue;
    end;
  if Invalue > MaxValue then
    Sinh := Infinity
  else
    Sinh := ( exp( Invalue ) - exp( -Invalue ) ) / 2.0 * Sign;
  end;

function Cosh{ ( Invalue : real ) : real };
  const
    MaxValue = 88.029691931;  { exceeds standard turbo precision }
  begin
  Invalue := abs( Invalue );
  if Invalue > MaxValue then
    Cosh := Infinity
  else
    Cosh := ( exp( Invalue ) + exp( -Invalue ) ) / 2.0;
  end;

function Tanh{ ( Invalue : real ) : real };
  begin
  Tanh := Sinh( Invalue ) / Cosh( Invalue );
  end;

function Coth{ ( Invalue : real ) : real };
  begin
  Coth := Cosh( Invalue ) / Sinh( Invalue );
  end;

function Sech{ ( Invalue : real ) : real };
  begin
  Sech := 1.0 / Cosh( Invalue );
  end;

function Csch{ ( Invalue : real ) : real };
  begin
  Csch := 1.0 / Sinh( Invalue );
  end;

function ArcSinh{ ( Invalue : real ) : real };
  var
    Sign : real;
  begin
  Sign := 1.0;
  if Invalue < 0 then
    begin
    Sign := -1.0;
    Invalue := -Invalue;
    end;
  ArcSinh := ln( Invalue + sqrt( Invalue*Invalue + 1 ) ) * Sign;
  end;

function ArcCosh{ ( Invalue : real ) : real };
  var
    Sign : real;
  begin
  Sign := 1.0;
  if Invalue < 0 then
    begin
    Sign := -1.0;
    Invalue := -Invalue;
    end;
  ArcCosh := ln( Invalue + sqrt( Invalue*Invalue - 1 ) ) * Sign;
  end;

function ArcTanh{ ( Invalue : real ) : real };
  var
    Sign : real;
  begin
  Sign := 1.0;
  if Invalue < 0 then
    begin
    Sign := -1.0;
    Invalue := -Invalue;
    end;
  ArcTanh := ln( ( 1 + Invalue ) / ( 1 - Invalue ) ) / 2.0 * Sign;
  end;

function ArcCoth{ ( Invalue : real ) : real };
  begin
  ArcCoth := ArcTanh( 1.0 / Invalue );
  end;

function ArcSech{ ( Invalue : real ) : real };
  begin
  ArcSech := ArcCosh( 1.0 / Invalue );
  end;

function ArcCsch{ ( Invalue : real ) : real };
  begin
  ArcCsch := ArcSinh( 1.0 / Invalue );
  end;

{---------------------------------}
{  Logarithms, Powers, and Roots  }
{---------------------------------}

{ e to the x  is  exp() }
{ natural log is  ln()  }

function Log10{ ( InNumber : real ) : real };
  begin
  Log10 := ln( InNumber ) / LnOf10;
  end;

function Log{ ( Base, InNumber : real ) : real };  { log of any base }
  begin
  Log := ln( InNumber ) / ln( Base );
  end;

function Power{ ( InNumber, Exponent : real ) : real };
  begin
  if InNumber > 0.0 then
    Power := exp( Exponent * ln( InNumber ) )
  else if InNumber = 0.0 then
    Power := 1.0
  else { force runtime error }
    Power := InNumber / 0.0;
  end;

function Root{ ( InNumber, TheRoot : real ) : real };
  begin
  Root := Power( InNumber, ( 1.0 / TheRoot ) );
  end;

end. { unit Trig }