From 97d5d8386b3c549710edf290e7db3a6f51c7dd2c Mon Sep 17 00:00:00 2001 From: Martin Vogel Date: Mon, 23 Jul 2001 16:38:00 +0000 Subject: [PATCH] 2001-07-23 18:40 MEST Martin Vogel --- harbour/ChangeLog | 34 + harbour/contrib/libct/Makefile | 4 + harbour/contrib/libct/ascpos.c | 6 +- harbour/contrib/libct/atadjust.c | 4 +- harbour/contrib/libct/atnum.c | 6 +- harbour/contrib/libct/charlist.c | 20 +- harbour/contrib/libct/charswap.c | 10 +- harbour/contrib/libct/ct.c | 20 +- harbour/contrib/libct/ct.h | 4 +- harbour/contrib/libct/cterror.ch | 38 +- harbour/contrib/libct/ctflist.txt | 58 +- harbour/contrib/libct/ctmath.h | 4 + harbour/contrib/libct/finan.c | 627 +++++++++++++ harbour/contrib/libct/makefile.bc | 20 + harbour/contrib/libct/makefile.vc | 8 + harbour/contrib/libct/math.c | 483 ++++++++++ harbour/contrib/libct/num1.c | 266 ++++++ harbour/contrib/libct/tests/Makefile | 4 + harbour/contrib/libct/tests/finan.prg | 111 +++ harbour/contrib/libct/tests/math.prg | 178 ++++ harbour/contrib/libct/tests/num1.prg | 106 +++ harbour/contrib/libct/tests/trig.prg | 267 ++++++ harbour/contrib/libct/token1.c | 25 +- harbour/contrib/libct/trig.c | 1194 +++++++++++++++++++++++++ 24 files changed, 3403 insertions(+), 94 deletions(-) create mode 100644 harbour/contrib/libct/finan.c create mode 100644 harbour/contrib/libct/math.c create mode 100644 harbour/contrib/libct/num1.c create mode 100644 harbour/contrib/libct/tests/finan.prg create mode 100644 harbour/contrib/libct/tests/math.prg create mode 100644 harbour/contrib/libct/tests/num1.prg create mode 100644 harbour/contrib/libct/tests/trig.prg create mode 100644 harbour/contrib/libct/trig.c diff --git a/harbour/ChangeLog b/harbour/ChangeLog index bcf5b6e213..0083880f79 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,37 @@ +2001-07-23 18:40 MEST Martin Vogel + + + contrib/libct/finan.c + + contrib/libct/math.c + + contrib/libct/num1.c + + contrib/libct/trig.c + + contrib/libct/tests/finan.prg + + contrib/libct/tests/math.prg + + contrib/libct/tests/num1.prg + + contrib/libct/tests/trig.prg + + mathematical functions provided by Alejandro de Garate + + Documentation (and some minor changes) added by me + + * contrib/libct/ascpos.c + * contrib/libct/atadjust.c + * contrib/libct/atnum.c + * contrib/libct/charlist.c + * contrib/libct/charswap.c + * contrib/libct/ct.c + * contrib/libct/ct.h + * contrib/libct/cterror.ch + * contrib/libct/ctmath.h + * contrib/libct/token1.c + * some minor changes to remove warnings reported by Maurilio Longo + * changed USHORT to ULONG in variable parameter functions + * fixed $SEEALSO$ bug in documentation + + * contrib/libct/ctflist.txt + * contrib/libct/Makefile + * contrib/libct/makefile.bc + * contrib/libct/makefile.vc + * contrib/libct/tests/Makefile + * changes according to new files and function stati + 2001-07-23 04:20 UTC-0800 Ron Pinkas * contrib/dot/pp.prg ! Various refinments in matching and outputing due to new observations about Clipper. diff --git a/harbour/contrib/libct/Makefile b/harbour/contrib/libct/Makefile index 72575fb05c..a8281fb6f7 100644 --- a/harbour/contrib/libct/Makefile +++ b/harbour/contrib/libct/Makefile @@ -29,7 +29,11 @@ C_SOURCES = \ ctcolton.c \ ctcrypt.c \ ctposupp.c \ + finan.c \ + math.c \ + num1.c \ token1.c \ + trig.c \ wordrepl.c \ PRG_SOURCES= \ diff --git a/harbour/contrib/libct/ascpos.c b/harbour/contrib/libct/ascpos.c index 894d59ff1c..408a3335ec 100644 --- a/harbour/contrib/libct/ascpos.c +++ b/harbour/contrib/libct/ascpos.c @@ -87,7 +87,7 @@ static void do_ascpos (int iSwitch) { if (iSwitch == DO_ASCPOS_VALPOS) { - if (isdigit (pcString[sPos-1])) + if (isdigit ((size_t)pcString[sPos-1])) hb_retnl (pcString[sPos-1]-48); else hb_retnl (0); @@ -162,7 +162,7 @@ static void do_ascpos (int iSwitch) * $PLATFORMS$ * All * $FILES$ - * Source is asciisum.c, library is ct3. + * Source is asciisum.c, library is libct. * $SEEALSO$ * VALPOS() * $END$ @@ -213,7 +213,7 @@ HB_FUNC (ASCPOS) * $PLATFORMS$ * All * $FILES$ - * Source is asciisum.c, library is ct3. + * Source is asciisum.c, library is libct. * $SEEALSO$ * ASCPOS() * $END$ diff --git a/harbour/contrib/libct/atadjust.c b/harbour/contrib/libct/atadjust.c index ad6984f4c3..7754dc097b 100644 --- a/harbour/contrib/libct/atadjust.c +++ b/harbour/contrib/libct/atadjust.c @@ -94,7 +94,7 @@ * $FILES$ * Source is atadjust.c, library is ct3. * $SEEALSO$ - * SETATLIKE() CSETATMUPA() + * SETATLIKE(),CSETATMUPA() * $END$ */ @@ -116,7 +116,7 @@ HB_FUNC (ATADJUST) char cAtLike = ct_getatlikechar(); size_t sIgnore, sMatchStrLen; ULONG ulCounter; - char *pc; + char *pc = NULL; char cFillChar; char *pcRetStr, *pcCheckFill; diff --git a/harbour/contrib/libct/atnum.c b/harbour/contrib/libct/atnum.c index 9b2f3bfe67..9f630f74ff 100644 --- a/harbour/contrib/libct/atnum.c +++ b/harbour/contrib/libct/atnum.c @@ -81,7 +81,7 @@ static void do_atnum (int iSwitch) char cAtLike = ct_getatlikechar(); size_t sIgnore, sMatchStrLen; ULONG ulCounter; - char *pc; + char *pc = NULL; /* eventually ignore some characters */ if (ISNUM (4)) @@ -406,9 +406,9 @@ static void do_atnum (int iSwitch) * $PLATFORMS$ * All * $FILES$ - * Source is atnum.c, library is ct3. + * Source is atnum.c, library is libct. * $SEEALSO$ - * ATNUM() BEFORATNUM() CSETATMUPA() SETATLIKE() + * ATNUM(),BEFORATNUM(),CSETATMUPA(),SETATLIKE() * $END$ */ diff --git a/harbour/contrib/libct/charlist.c b/harbour/contrib/libct/charlist.c index 8f5db289d5..576dd25d54 100644 --- a/harbour/contrib/libct/charlist.c +++ b/harbour/contrib/libct/charlist.c @@ -103,10 +103,10 @@ static void do_list (int iSwitch) for (sCnt = 0; sCnt < sStrLen; sCnt++) { - if (asCharCnt[pcString[sCnt]] == 0) + if (asCharCnt[(size_t)(pcString[sCnt])] == 0) { pcRet[sRetStrLen++] = pcString[sCnt]; - asCharCnt[pcString[sCnt]] = 1; + asCharCnt[(size_t)(pcString[sCnt])] = 1; } } @@ -224,9 +224,9 @@ static void do_list (int iSwitch) * $PLATFORMS$ * All * $FILES$ - * Source is charlist.c, library is ct3. + * Source is charlist.c, library is libct. * $SEEALSO$ - * CHARNOLIST() CHARSLIST() CHARHIST() + * CHARNOLIST(),CHARSLIST(),CHARHIST() * $END$ */ @@ -272,9 +272,9 @@ HB_FUNC (CHARLIST) * $PLATFORMS$ * All * $FILES$ - * Source is charlist.c, library is ct3. + * Source is charlist.c, library is libct. * $SEEALSO$ - * CHARNOLIST() CHARLIST() CHARHIST() + * CHARNOLIST(),CHARLIST(),CHARHIST() * $END$ */ @@ -319,9 +319,9 @@ HB_FUNC (CHARSLIST) * $PLATFORMS$ * All * $FILES$ - * Source is charlist.c, library is ct3. + * Source is charlist.c, library is libct. * $SEEALSO$ - * CHARLIST() CHARSLIST() CHARHIST() + * CHARLIST(),CHARSLIST(),CHARHIST() * $END$ */ @@ -367,9 +367,9 @@ HB_FUNC (CHARNOLIST) * $PLATFORMS$ * All * $FILES$ - * Source is charlist.c, library is ct3. + * Source is charlist.c, library is libct. * $SEEALSO$ - * CHARLIST() CHARNOLIST() CHARSLIST() + * CHARLIST(),CHARNOLIST(),CHARSLIST() * $END$ */ diff --git a/harbour/contrib/libct/charswap.c b/harbour/contrib/libct/charswap.c index 39c03756ed..0a2b063643 100644 --- a/harbour/contrib/libct/charswap.c +++ b/harbour/contrib/libct/charswap.c @@ -81,7 +81,7 @@ static void do_charswap (int iSwitch) char *pcRet; size_t sRetIndex = 0; int iShift, iMod; - char *pcSub, *pc; + char *pcSub; if (iSwitch == DO_CHARSWAP_WORDSWAP) { @@ -241,9 +241,9 @@ static void do_charswap (int iSwitch) * $PLATFORMS$ * All * $FILES$ - * Source is charswap.c, library is ct3. + * Source is charswap.c, library is libct. * $SEEALSO$ - * WORDSWAP() CSETREF() + * WORDSWAP(),CSETREF() * $END$ */ @@ -294,9 +294,9 @@ HB_FUNC (CHARSWAP) * $PLATFORMS$ * All * $FILES$ - * Source is charswap.c, library is ct3. + * Source is charswap.c, library is libct. * $SEEALSO$ - * CHARSWAP() CSETREF() + * CHARSWAP(),CSETREF() * $END$ */ diff --git a/harbour/contrib/libct/ct.c b/harbour/contrib/libct/ct.c index 2d76006167..a7e0ffa7d7 100644 --- a/harbour/contrib/libct/ct.c +++ b/harbour/contrib/libct/ct.c @@ -61,17 +61,17 @@ - function adapted from errorapi.c */ USHORT ct_error (USHORT uiSeverity, ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation, USHORT uiOsCode, - USHORT uiFlags, USHORT uiArgCount, ...) + USHORT uiFlags, ULONG uiArgCount, ...) { USHORT uiAction; PHB_ITEM pError; - PHB_ITEM pArray, pArg; + PHB_ITEM pArray; va_list va; - USHORT uiArgPos; + ULONG uiArgPos; BOOL bRelease = TRUE; - HB_TRACE(HB_TR_DEBUG, ("ct_error (%hu, %lu, %lu, %s, %s, %hu, %hu, %hu", + HB_TRACE(HB_TR_DEBUG, ("ct_error (%hu, %lu, %lu, %s, %s, %hu, %hu, %lu", uiSeverity, ulGenCode, ulSubCode, szDescription, szOperation, uiOsCode, uiFlags, uiArgCount)); @@ -118,16 +118,16 @@ USHORT ct_error (USHORT uiSeverity, ULONG ulGenCode, ULONG ulSubCode, - function adapted from errorapi.c */ PHB_ITEM ct_error_subst (USHORT uiSeverity, ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation, USHORT uiOsCode, - USHORT uiFlags, USHORT uiArgCount, ...) + USHORT uiFlags, ULONG uiArgCount, ...) { PHB_ITEM pRetVal; PHB_ITEM pError; PHB_ITEM pArray; va_list va; - USHORT uiArgPos; + ULONG uiArgPos; - HB_TRACE(HB_TR_DEBUG, ("ct_error_subst (%hu, %lu, %lu, %s, %s, %hu, %hu, %hu", + HB_TRACE(HB_TR_DEBUG, ("ct_error_subst (%hu, %lu, %lu, %s, %s, %hu, %hu, %lu", uiSeverity, ulGenCode, ulSubCode, szDescription, szOperation, uiOsCode, uiFlags, uiArgCount)); @@ -214,7 +214,7 @@ int ct_getargerrormode (void) * $PLATFORMS$ * All * $FILES$ - * Source is ct.c, library is ct3. + * Source is ct.c, library is libct. * $SEEALSO$ * $END$ */ @@ -288,7 +288,7 @@ static int s_initialized = 0; /* TODO: make this thread safe */ * $PLATFORMS$ * All * $FILES$ - * Source is ct.c, library is ct3. + * Source is ct.c, library is libct. * $SEEALSO$ * $END$ */ @@ -344,7 +344,7 @@ HB_FUNC (CTINIT) * $PLATFORMS$ * All * $FILES$ - * Source is ct.c, library is ct3. + * Source is ct.c, library is libct. * $SEEALSO$ * $END$ */ diff --git a/harbour/contrib/libct/ct.h b/harbour/contrib/libct/ct.h index 917a28cff6..804d91e0f2 100644 --- a/harbour/contrib/libct/ct.h +++ b/harbour/contrib/libct/ct.h @@ -73,11 +73,11 @@ /* CT subsystem error throwing functions */ extern USHORT ct_error (USHORT uiSeverity, ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation, USHORT uiOsCode, - USHORT uiFlags, USHORT uiArgCount, ...); + USHORT uiFlags, ULONG uiArgCount, ...); extern PHB_ITEM ct_error_subst (USHORT uiSeverity, ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation, USHORT uiOsCode, - USHORT uiFlags, USHORT uiArgCount, ...); + USHORT uiFlags, ULONG uiArgCount, ...); /* set argument error behaviour */ extern void ct_setargerrormode (int iMode); diff --git a/harbour/contrib/libct/cterror.ch b/harbour/contrib/libct/cterror.ch index b1e31b637c..7f3f73e50e 100644 --- a/harbour/contrib/libct/cterror.ch +++ b/harbour/contrib/libct/cterror.ch @@ -666,25 +666,25 @@ #define CT_ERROR_COS 7463 #define CT_ERROR_COT 7473 #define CT_ERROR_DTOR 7483 -#define CT_ERROR_EXPA 7493 -#define CT_ERROR_FACT 7502 -#define CT_ERROR_FLOOR 7512 -#define CT_ERROR_FV 7523 -#define CT_ERROR_GETPREC 7532 -#define CT_ERROR_LOG10 7543 -#define CT_ERROR_LOGA 7553 -#define CT_ERROR_PAYMENT 7563 -#define CT_ERROR_PERIODS 7572 -#define CT_ERROR_PI 7583 -#define CT_ERROR_PV 7593 -#define CT_ERROR_RATE 7603 -#define CT_ERROR_ROOT 7613 -#define CT_ERROR_RTOD 7623 -#define CT_ERROR_SETMATHERR 7632 -#define CT_ERROR_SETPREC 7642 -#define CT_ERROR_SIGN 7652 -#define CT_ERROR_SIN 7663 -#define CT_ERROR_TAN 7673 +#define CT_ERROR_FACT 7492 +#define CT_ERROR_FLOOR 7502 +#define CT_ERROR_FV 7513 +#define CT_ERROR_GETPREC 7522 +#define CT_ERROR_LOG10 7533 +#define CT_ERROR_PAYMENT 7543 +#define CT_ERROR_PERIODS 7552 +#define CT_ERROR_PI 7563 +#define CT_ERROR_PV 7573 +#define CT_ERROR_RATE 7583 +#define CT_ERROR_RTOD 7593 +#define CT_ERROR_SETMATHERR 7602 +#define CT_ERROR_SETPREC 7612 +#define CT_ERROR_SIGN 7622 +#define CT_ERROR_SIN 7633 +#define CT_ERROR_TAN 7643 +#define CT_ERROR_SINH 7653 +#define CT_ERROR_COSH 7663 +#define CT_ERROR_TANH 7773 /* peek and poke functions */ #define CT_ERROR_INBYTE 7810 /* TODO: change last digit */ diff --git a/harbour/contrib/libct/ctflist.txt b/harbour/contrib/libct/ctflist.txt index 87359d4143..bea10d9864 100644 --- a/harbour/contrib/libct/ctflist.txt +++ b/harbour/contrib/libct/ctflist.txt @@ -269,15 +269,15 @@ WORDTOCHAR ;N; ;=============================== ; BITTOC ;N; -CELSIUS ;N; +CELSIUS ;R; CLEARBIT ;N; CTOBIT ;N; CTOF ;N; CTON ;N; EXPONENT ;N; -FAHRENHEIT ;N; +FAHRENHEIT ;R; FTOC ;N; -INFINITY ;N; +INFINITY ;R; INTNEG ;N; INTPOS ;N; ISBIT ;N; @@ -590,33 +590,33 @@ XTOC ;N; ;3.4 math functions ;================== ; -ACOS ;N; -ASIN ;N; -ATAN ;N; -ATN2 ;N; -CEILING ;N; -COS ;N; -COT ;N; -DTOR ;N; -EXPA ;N; !NEW! -FACT ;N; -FLOOR ;N; -FV ;N; -GETPREC ;N; -LOGA ;N; !NEW! -LOG10 ;N; -PAYMENT ;N; -PERIODS ;N; -PI ;N; -PV ;N; -RATE ;N; -ROOT ;N; !NEW! -RTOD ;N; +ACOS ;R; +ASIN ;R; +ATAN ;R; +ATN2 ;R; +CEILING ;R; +COS ;R; +COSH ;R; !NEW! +COT ;R; +DTOR ;R; +FACT ;R; +FLOOR ;R; +FV ;R; +GETPREC ;R; +LOG10 ;R; +PAYMENT ;R; +PERIODS ;R; +PI ;R; +PV ;R; +RATE ;R; +RTOD ;R; SETMATHERR ;R; !NEW! -SETPREC ;N; -SIGN ;N; -SIN ;N; -TAN ;N; +SETPREC ;R; +SIGN ;R; +SIN ;R; +SINH ;R; !NEW! +TAN ;R; +TANH ;R; !NEW! ; ; ;3.5 peek and poke functions diff --git a/harbour/contrib/libct/ctmath.h b/harbour/contrib/libct/ctmath.h index 3a912c7e06..52982d2511 100644 --- a/harbour/contrib/libct/ctmath.h +++ b/harbour/contrib/libct/ctmath.h @@ -91,6 +91,10 @@ extern int ct_matherr (HB_MATH_EXCEPTION * pexc); extern void ct_setprecision (int iPrecision); extern int ct_getprecision(); +#define CT_PI 3.14159265358979323846 +#define CT_PI_2 1.57079632679489661923 +#define CT_PI_RAD 0.0174532925199432957692 /* 3.14159265358979323846 / 180.0 */ + #endif /* CTMATH_H */ diff --git a/harbour/contrib/libct/finan.c b/harbour/contrib/libct/finan.c new file mode 100644 index 0000000000..a77baca5f5 --- /dev/null +++ b/harbour/contrib/libct/finan.c @@ -0,0 +1,627 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 Financial functions + * - PV + * - FV + * - PAYMENT + * - PERIODS + * - RATE + * + * NOTE: All these functions were builded using Borland C++ 5.5 (free version) + * + * Copyright 2001 Alejandro de Garate + * + * Documentation and changes concerning error handling Copyright 2001 + * IntTec GmbH, Freiburg, Germany, Author: Martin Vogel + * + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + +#include "ct.h" + + +/* $DOC$ + * $FUNCNAME$ + * FV() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Future value of a capital + * $SYNTAX$ + * FV (nDeposit, nInterest, nPeriods) --> nFutureValue + * $ARGUMENTS$ + * amount of money invested per period + * rate of interest per period, 1 == 100% + * period count + * $RETURNS$ + * Total value of the capital after of + * paying and interest being + * paid every period and added to the capital (resulting + * in compound interest) + * $DESCRIPTION$ + * FV() calculates the value of a capital after periods. + * Starting with a value of 0, every period, + * (Dollars, Euros, Yens, ...) and an interest of for the + * current capital are added for the capital (=Percent/100). + * Thus, one gets the non-linear effects of compound interests: + * value in period 0 = 0 + * value in period 1 = ((value in period 0)*(1+/100)) + + * value in period 2 = ((value in period 1)*(1+/100)) + + * etc.... + * value in period = ((value in period -1)*(1+/100))< + + * = * sum from i=0 to -1 over (1+/100)^i + * = * ((1+/100)^n-1) / (/100) + * $EXAMPLES$ + * // Payment of 1000 per year for 10 years at a interest rate + * // of 5 per cent per year + * + * ? fv (1000, 0.05, 10) --> 12577.893 + * $TESTS$ + * fv (1000, 0.00, 10) == 10000.0 + * fv (1000, 0.05, 10) == 12577.893 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * FV() is compatible with CT3's FV(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is finan.c, library is libct. + * $SEEALSO$ + * PV(),PAYMENT(),PERIODS(),RATE() + * $END$ + */ + +HB_FUNC( FV ) +{ + if( ISNUM(1) && ISNUM(2) && ISNUM(3) ) + { + double dPayment = hb_parnd(1); + double dRate = hb_parnd(2); + double dTime = hb_parnd(3); + double dResult; + + ct_matherrbegin(); + + if (dRate == 0.0) + { + /* NOTE: CT3 crashes with dRate == 0.0 */ + dResult = dPayment*dTime; + } + else + { + dResult = dPayment*(pow (1.0+dRate, dTime)-1.0)/dRate; + } + + ct_matherrend(); + + hb_retnd (dResult); + + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_FV, + NULL, "FV", 0, EF_CANSUBSTITUTE, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * PV() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Present value of a loan + * $SYNTAX$ + * PV (nPayment, nInterest, nPeriods) --> nPresentValue + * $ARGUMENTS$ + * amount of money paid back per period + * rate of interest per period, 1 == 100% + * period count + * $RETURNS$ + * Present value of a loan when one is paying back + * per period at a rate of interest of + * per period + * $DESCRIPTION$ + * PV() calculates the present value of a loan that is paid back + * in payments of (Dollars, Euros, Yens,...) + * while the rate of interest is per period: + * debt in period 0 = + * debt in period 1 = ((debt in period 0)-)*(1+/100) + * debt in period 2 = ((debt in period 1)-)*(1+/100) + * etc... + * debt in period = ((debt in period -1)-)*(1+/100) + * -> has to be 0, so + * = *(1-(1+/100)^(-n))/(/100) + * $EXAMPLES$ + * // You can afford to pay back 100 Dollars per month for 5 years + * // at a interest rate of 0.5% per month (6% per year), so instead + * // of 6000 Dollars (the amount you will pay back) the bank will pay + * // you + * + * ? pv (100, 0.005, 60) --> 5172.56 + * $TESTS$ + * pv (100, 0.0, 60) == 6000.0 + * pv (100, 0.005, 60) == 5172.56 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * PV() is compatible with CT3's PV(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is finan.c, library is libct. + * $SEEALSO$ + * FV(),PAYMENT(),PERIODS(),RATE() + * $END$ + */ + +HB_FUNC( PV ) +{ + if( ISNUM(1) && ISNUM(2) && ISNUM(3) ) + { + double dPayment = hb_parnd(1); + double dRate = hb_parnd(2); + double dTime = hb_parnd(3); + double dResult; + + ct_matherrbegin(); + + if (dRate == 0.0) + { + /* NOTE: CT3 crashes with dRate == 0.0 */ + dResult = dPayment*dTime; + } + else + { + dResult = dPayment*(1.0-pow (1.0+dRate, -dTime))/dRate; + } + + ct_matherrend(); + + hb_retnd (dResult); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_PV, + NULL, "PV", 0, EF_CANSUBSTITUTE, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * PAYMENT() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Payments for a loan + * $SYNTAX$ + * PAYMENT (nLoan, nInterest, nPeriods) --> nPayment + * $ARGUMENTS$ + * amount of money you get from the bank + * rate of interest per period, 1 == 100% + * period count + * $RETURNS$ + * Periodical payment one has to make to pay the + * loan back + * $DESCRIPTION$ + * PAYMENT() calculates the payment one has to make periodically + * to pay back a loan within periods and for a + * rate of interest per period. + * debt in period 0 = + * debt in period 1 = ((debt in period 0)-)*(1+/100) + * debt in period 2 = ((debt in period 1)-)*(1+/100) + * etc... + * debt in period = ((debt in period -1)-)*(1+/100) + * -> has to be 0, so + * = *(/100)/(1-(1+/100)^(-n)) + * $EXAMPLES$ + * // You get a loan of 5172.56 at a interest rate of 0.5% per + * // month (6% per year). + * // For 5 years, you have to pay back every month + * + * ? payment (5172.56, 0.005, 60) --> 100.00 + * $TESTS$ + * payment (5172.56, 0.0, 60) == 86.21 + * payment (5172.56, 0.005, 60) == 100.00 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * PAYMENT() is compatible with CT3's PAYMENT(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is finan.c, library is libct. + * $SEEALSO$ + * PV(),FV(),PERIODS(),RATE() + * $END$ + */ + +HB_FUNC( PAYMENT ) +{ + if( ISNUM(1) && ISNUM(2) && ISNUM(3) ) + { + double dCapital = hb_parnd(1); + double dRate = hb_parnd(2); + double dTime = hb_parnd(3); + double dResult; + + if (dRate == 0.0) + { + /* NOTE: CT3 crashes with dRate == 0.0 */ + if (dTime == 0.0) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_PAYMENT, + NULL, "PAYMENT", 0, EF_CANDEFAULT, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + }; + hb_retnd (0.0); + return; + } + ct_matherrbegin(); + dResult = dCapital/dTime; + ct_matherrend(); + } + else + { + ct_matherrbegin(); + dResult = dCapital*dRate/(1.0-pow (1.0+dRate, -dTime)); + ct_matherrend(); + } + + hb_retnd (dResult); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_PAYMENT, + NULL, "PAYMENT", 0, EF_CANSUBSTITUTE, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * PERIODS() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Number of periods for a loan + * $SYNTAX$ + * PERIODS (nLoan, nPayment, nInterest) --> nPeriods + * $ARGUMENTS$ + * amount of money you get from the bank + * amount of money you pay back per period + * rate of interest per period, 1 == 100% + * $RETURNS$ + * number of periods you need to pay the loan back + * $DESCRIPTION$ + * PERIODS() calculates the number of periods one needs to pay back + * a loan of with periodical payments of and for a + * rate of interest per period. + * debt in period 0 = + * debt in period 1 = ((debt in period 0)-)*(1+/100) + * debt in period 2 = ((debt in period 1)-)*(1+/100) + * etc... + * debt in period = ((debt in period -1)-)*(1+/100) + * -> has to be 0, so + * = -log(1-*(/100)/)/log(1+/100)) + * + * Note, however that in the case of nPayment <= *(/100), + * one would need infinite time to pay the loan back. The functions does + * then return -1. + * $EXAMPLES$ + * // You get a loan of 5172.56 at a interest rate of 0.5% per + * // month (6% per year). + * // You can afford to pay 100 back every month, so you need + * + * ? periods (5172.56, 100, 0.005) --> 60.0 + * + * // months to cancel the loan. + * $TESTS$ + * periods (5172.56, 100, 0.005) == 60.0 + * periods (5172.56, 100, 0.0) == 51.7256 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * PERIODS() is compatible with CT3's PERIODS(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is finan.c, library is libct. + * $SEEALSO$ + * PV(),FV(),PAYMENT(),RATE() + * $END$ + */ + +HB_FUNC( PERIODS ) +{ + if( ISNUM(1) && ISNUM(2) && ISNUM(3) ) + { + double dCapital = hb_parnd(1); + double dPayment = hb_parnd(2); + double dRate = hb_parnd(3); + double dResult; + + if (dPayment <= dCapital*dRate) + { + /* in this case infinite time is needed to cancel the loan */ + hb_retnd (-1.0); + return; + } + + if (dRate == 0.0) + { + /* NOTE: CT3 crashes with dRate == 0.0 */ + if (dPayment == 0.0) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_PERIODS, + NULL, "PERIODS", 0, EF_CANDEFAULT, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + }; + hb_retnd (0.0); + return; + } + ct_matherrbegin(); + dResult = dCapital/dPayment; + ct_matherrend(); + } + else + { + ct_matherrbegin(); + dResult = -log(1.0-(dCapital*dRate/dPayment))/log(1+dRate); + ct_matherrend(); + } + + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_PERIODS, + NULL, "PERIODS", 0, EF_CANSUBSTITUTE, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * RATE() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Estimate rate of interest for a loan + * $SYNTAX$ + * RATE (nLoan, nPayment, nPeriods) --> nRate + * $ARGUMENTS$ + * amount of money you get from the bank + * amount of money you pay back per period + * number of periods you pay the loan back + * $RETURNS$ + * estimated rate of interest per period, 1 == 100% + * $DESCRIPTION$ + * RATE() calculates the rate of interest per period for the given + * loan, payment per periods and number of periods. This is done with + * the same equation used in the PAYMENT() or PERIODS() function: + * + * = *(/100)/(1-(1+/100)^(-)) + * + * However, this equation can not be solved for in a "closed" + * manner, i.e. = ..., so that the result can only be estimated. + * $EXAMPLES$ + * // You get a loan of 5172.56, pay 100 back every month for + * // 5 years (60 months). The effective interest rate per + * // period (=month) is + * + * ? rate (5172.56, 100, 60) --> 0.005 + * + * $TESTS$ + * rate (5172.56, 100, 60.0) == 0.005 + * rate (6000.0, 100, 60.0) == 0.0 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * RATE() is compatible with CT3's RATE(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is finan.c, library is libct. + * $SEEALSO$ + * PV(),FV(),PAYMENT(),PERIODS() + * $END$ + */ + +HB_FUNC( RATE ) +{ + if( ISNUM(1) && ISNUM(2) && ISNUM(3) ) + { + double dCapital = hb_parnd(1); + double dPayment = hb_parnd(2); + double dTime = hb_parnd(3); + double dAux; /* estimated payment to compare for */ + double dEpsilon = 0.00001; /* mimimal to consider 2 numbers as equal*/ + double dScale = 1.0; /* fractional step */ + double r; /* temptative rate */ + double j = 1.0; /* index */ + double dExp; + + while( j < 1020.0 ) /* maximum anual rate */ + { + r = j * 0.000833333; /* j * ( 0.01 / 12.0) mensual's rate */ + + /* replace PAYMENT() function overhead */ + dExp = pow( (1.0 + r), dTime ); + dAux = dCapital * ( (dExp * r) / (dExp - 1.0) ); + + if( dAux > dPayment ) + { + j = j - dScale; + dScale = dScale * 0.10; + + if( (dAux - dPayment) < dEpsilon) + break; + } + else + j = j + dScale; + + } /* endwhile */ + + hb_retnd( j * 0.000833333 ); /* return as mensual's rate */ + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_RATE, + NULL, "RATE", 0, EF_CANSUBSTITUTE, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + + + + diff --git a/harbour/contrib/libct/makefile.bc b/harbour/contrib/libct/makefile.bc index b7a2b55649..b6d648b921 100644 --- a/harbour/contrib/libct/makefile.bc +++ b/harbour/contrib/libct/makefile.bc @@ -114,7 +114,11 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\ctcolton.obj \ $(OBJ_DIR)\ctcrypt.obj \ $(OBJ_DIR)\ctposupp.obj \ + $(OBJ_DIR)\finan.obj \ + $(OBJ_DIR)\math.obj \ + $(OBJ_DIR)\num1.obj \ $(OBJ_DIR)\token1.obj \ + $(OBJ_DIR)\trig.obj \ $(OBJ_DIR)\wordrepl.obj \ \ $(OBJ_DIR)\ctmisc.obj \ @@ -232,10 +236,26 @@ $(OBJ_DIR)\ctposupp.obj : $(TOOLS_DIR)\ctposupp.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\finan.obj : $(TOOLS_DIR)\finan.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\math.obj : $(TOOLS_DIR)\math.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\num1.obj : $(TOOLS_DIR)\num1.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\token1.obj : $(TOOLS_DIR)\token1.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\trig.obj : $(TOOLS_DIR)\trig.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\wordrepl.obj : $(TOOLS_DIR)\wordrepl.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/contrib/libct/makefile.vc b/harbour/contrib/libct/makefile.vc index 606557bd69..7c83146543 100644 --- a/harbour/contrib/libct/makefile.vc +++ b/harbour/contrib/libct/makefile.vc @@ -134,7 +134,11 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\ctcolton.obj \ $(OBJ_DIR)\ctcrypt.obj \ $(OBJ_DIR)\ctposupp.obj \ + $(OBJ_DIR)\finan.obj \ + $(OBJ_DIR)\math.obj \ + $(OBJ_DIR)\num1.obj \ $(OBJ_DIR)\token1.obj \ + $(OBJ_DIR)\trig.obj \ $(OBJ_DIR)\wordrepl.obj \ \ $(OBJ_DIR)\ctmisc.obj \ @@ -172,7 +176,11 @@ CLEAN: -@if exist $(OBJ_DIR)\ctcolton.* del $(OBJ_DIR)\ctcolton.* -@if exist $(OBJ_DIR)\ctcrypt.* del $(OBJ_DIR)\ctcrypt.* -@if exist $(OBJ_DIR)\ctposupp.* del $(OBJ_DIR)\ctposupp.* + -@if exist $(OBJ_DIR)\finan.* del $(OBJ_DIR)\finan.* + -@if exist $(OBJ_DIR)\math.* del $(OBJ_DIR)\math.* + -@if exist $(OBJ_DIR)\num1.* del $(OBJ_DIR)\num1.* -@if exist $(OBJ_DIR)\token1.* del $(OBJ_DIR)\token1.* + -@if exist $(OBJ_DIR)\trig.* del $(OBJ_DIR)\trig.* -@if exist $(OBJ_DIR)\wordrepl.* del $(OBJ_DIR)\wordrepl.* -@if exist $(OBJ_DIR)\ctmisc.* del $(OBJ_DIR)\ctmisc.* -@if exist $(TOOLS_LIB) del $(TOOLS_LIB) diff --git a/harbour/contrib/libct/math.c b/harbour/contrib/libct/math.c new file mode 100644 index 0000000000..3873d98f93 --- /dev/null +++ b/harbour/contrib/libct/math.c @@ -0,0 +1,483 @@ +/* + * Harbour Project source code: + * + * CT3 mathematical functions + * - FLOOR + * - CEILING + * - SIGN + * - LOG10 + * - FACT + * + * NOTE: All these functions were builded using Borland C++ 5.5 (free version) + * + * Copyright 2001 Alejandro de Garate + * + * Documentation and changes concerning error handling Copyright 2001 + * IntTec GmbH, Freiburg, Germany, Author: Martin Vogel + * + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + +#include "ct.h" + + +/* $DOC$ + * $FUNCNAME$ + * FLOOR() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Rounds down a number to the next integer + * $SYNTAX$ + * FLOOR (nNumber) -> nDownRoundedNumber + * $ARGUMENTS$ + * number to round down + * $RETURNS$ + * the rounded number + * $DESCRIPTION$ + * The function FLOOR() determines the biggest integer that is smaller + * than . + * $EXAMPLES$ + * ? floor (1.1) --> 1.0 + * ? floor (-1.1) --> -2.0 + * $TESTS$ + * floor (1.1) == 1.0 + * floor (-1.1) == -2.0 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * FLOOR() is compatible with CT3's FLOOR(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is math.c, library is libct. + * $SEEALSO$ + * CEILING + * $END$ + */ + +HB_FUNC( FLOOR ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + ct_matherrbegin(); + dResult = floor (dInput); + ct_matherrend(); + + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_FLOOR, + NULL, "FLOOR", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * CEILING() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Rounds up a number to the next integer + * $SYNTAX$ + * CEILING (nNumber) -> nUpRoundedNumber + * $ARGUMENTS$ + * number to round up + * $RETURNS$ + * the rounded number + * $DESCRIPTION$ + * The function CEILING() determines the smallest integer that is bigger + * than . + * $EXAMPLES$ + * ? ceiling (1.1) --> 2.0 + * ? ceiling (-1.1) --> -1.0 + * $TESTS$ + * ceiling (1.1) == 2.0 + * ceiling (-1.1) == -1.0 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CEILING() is compatible with CT3's CEILING(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is math.c, library is libct. + * $SEEALSO$ + * FLOOR + * $END$ + */ + +HB_FUNC( CEILING ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + ct_matherrbegin(); + dResult = ceil (dInput); + ct_matherrend(); + + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CEILING, + NULL, "CEILING", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * SIGN() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Sign of a number + * $SYNTAX$ + * SIGN (nNumber) -> nSign + * $ARGUMENTS$ + * a number + * $RETURNS$ + * sign of + * $DESCRIPTION$ + * The function SIGN() determines the sign of . + * If is > 0, then SIGN() returns 1 + * If is < 0, then SIGN() returns -1 + * If is == 0, then SIGN() returns 0 + * $EXAMPLES$ + * ? sign (1.1) --> 1 + * ? sign (-1.1) --> -1 + * ? sign (0.0) --> 0 + * $TESTS$ + * sign (1.1) == 1 + * sign (-1.1) == -1 + * sign (0.0) == 0 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * SIGN() is compatible with CT3's SIGN(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is math.c, library is libct. + * $SEEALSO$ + * $END$ + */ + +HB_FUNC( SIGN ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + int iResult ; + + if( dInput == 0.00 ) + iResult = 0; + else + { + if( dInput > 0.00 ) + iResult = 1; + else + iResult = -1; + } + hb_retni( iResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_SIGN, + NULL, "SIGN", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retni (0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * LOG10() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Decadic logarithm of a number + * $SYNTAX$ + * LOG10 (nNumber) -> nLogarithm + * $ARGUMENTS$ + * number to logarithm + * $RETURNS$ + * decadic logarithm of + * $DESCRIPTION$ + * The function LOG10() calculates the decadic logarithm of , + * i.e. 10^ == . + * $EXAMPLES$ + * ? log10 (10.0) --> 1.0 + * ? log10 (sqrt(10.0)) --> 0.5 + * $TESTS$ + * log10 (10.0) == 1.0 + * log10 (sqrt(10.0)) == 0.5 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * LOG10() is compatible with CT3's LOG10(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is math.c, library is libct. + * $SEEALSO$ + * $END$ + */ + +HB_FUNC( LOG10 ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + if (dInput <= 0.0) + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_LOG10, + NULL, "LOG10", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + else + { + ct_matherrbegin(); + dResult = log10 (dInput); + ct_matherrend(); + hb_retnd( dResult ); + } + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_LOG10, + NULL, "LOG10", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retni (0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * FACT() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Calculates faculty + * $SYNTAX$ + * FACT (nNumber) -> nFaculty + * $ARGUMENTS$ + * number between 0 and 21 + * $RETURNS$ + * the faculty of + * $DESCRIPTION$ + * The function FACT() calculates the faculty to the integer given in + * . The faculty is defined as n! = 1*2*...*n and is often + * used in statistics. Note, that faculties above 21 are too big + * so that the function must return a -1. + * $EXAMPLES$ + * ? fact (0) --> 1 + * ? fact (1) --> 1 + * ? fact (4) --> 24 + * $TESTS$ + * fact (0) == 1 + * fact (1) == 1 + * fact (4) == 24 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * FACT() is compatible with CT3's FACT(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is math.c, library is libct. + * $SEEALSO$ + * $END$ + */ + +HB_FUNC( FACT ) +{ + if( ISNUM(1) ) + { + int iInput = hb_parni(1); + int i; + double dResult = 1.0; + + if ((iInput >= 0) && (iInput < 22)) + { + for (i = 1; i <= iInput; i++) + { + dResult *= (double)i; + } + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_FACT, + NULL, "FACT", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (-1.0); + } + } + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_FACT, + NULL, "FACT", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + diff --git a/harbour/contrib/libct/num1.c b/harbour/contrib/libct/num1.c new file mode 100644 index 0000000000..9e7752d424 --- /dev/null +++ b/harbour/contrib/libct/num1.c @@ -0,0 +1,266 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * + * CT3 Numeric functions - PART 1 + * - CELSIUS + * - FAHRENHEIT + * - INFINITY + * + * NOTE: All these functions were builded using Borland C++ 5.5 (free version) + * + * Copyright 2001 Alejandro de Garate + * + * Documentation and changes concerning error handling Copyright 2001 + * IntTec GmbH, Freiburg, Germany, Author: Martin Vogel + * + * www - http://www.harbour-project.org + * + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + +#include "ct.h" + + +/* $DOC$ + * $FUNCNAME$ + * CELSIUS() + * $CATEGORY$ + * CT3 numeric functions + * $ONELINER$ + * Temperature conversion Fahrenheit to Celsius + * $SYNTAX$ + * CELSIUS (nDegreeFahrenheit) --> nDegreeCelsius + * $ARGUMENTS$ + * temperature in degree Fahrenheit + * $RETURNS$ + * temperate in degree Celsius + * $DESCRIPTION$ + * CELSIUS() converts temperature values measured in the Fahrenheit scale + * to the Celsius scale. + * $EXAMPLES$ + * // melting point of water in standard conditions + * ? celsius (32.0) --> 0.0 + * // boiling point of water in standard conditions + * ? celsius (212.0) --> 100.0 + * $TESTS$ + * celsius (32.0) == 0.0 + * celsius (212.0) == 100.0 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CELSIUS() is compatible with CT3's CELSIUS(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is num1.c, library is libct. + * $SEEALSO$ + * FAHRENHEIT() + * $END$ + */ + +HB_FUNC( CELSIUS ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + ct_matherrbegin(); + dResult = (5.0 / 9.0) * ( dInput - 32.0 ); + ct_matherrend(); + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CELSIUS, + NULL, "CELSIUS", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * FAHRENHEIT() + * $CATEGORY$ + * CT3 numeric functions + * $ONELINER$ + * Temperature conversion Celsius to Fahrenheit + * $SYNTAX$ + * FAHRENHEIT (nDegreeCelsius) --> nDegreeFahrenheit + * $ARGUMENTS$ + * temperate in degree Celsius + * $RETURNS$ + * temperature in degree Fahrenheit + * $DESCRIPTION$ + * FAHRENHEIT() converts temperature values measured in the Celsius scale + * to the Fahrenheit scale. + * $EXAMPLES$ + * // melting point of water in standard conditions + * ? fahrenheit (0.0) --> 32.0 + * // boiling point of water in standard conditions + * ? fahrenheit (100.0) --> 212.0 + * $TESTS$ + * fahrenheit (0.0) == 32.0 + * celsius (100.0) == 212.0 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * FAHRENHEIT() is compatible with CT3's FAHRENHEIT(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is num1.c, library is libct. + * $SEEALSO$ + * CELSIUS() + * $END$ + */ + +HB_FUNC( FAHRENHEIT ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + ct_matherrbegin(); + dResult = (( 9.0 / 5.0) * dInput ) + 32.0 ; + ct_matherrend(); + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_FAHRENHEIT, + NULL, "FAHRENHEIT", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * INFINITY() + * $CATEGORY$ + * CT3 numeric functions + * $ONELINER$ + * Returns the largest floating point number available in the system + * $SYNTAX$ + * INFINITY ([]) --> nLargestNumber + * $ARGUMENTS$ + * [] .T., if the function should return + * the maximum floating point value + * available (DBL_MAX) + * .F., function should try to return + * the same value as the original CT3 lib did + * Default: .F. + * $RETURNS$ + * the largest floating point number available in the system + * $DESCRIPTION$ + * INFINITY() returns the largest floating point number available + * in the system. For platform independance, this is set to DBL_MAX. + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * INFINITY() must not necessarily return the same number as CT3's INFINITY(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is num1.c, library is libct. + * $SEEALSO$ + * $END$ + */ + +HB_FUNC( INFINITY ) +{ + + if (ISLOG (1) && hb_parl(1)) + { + hb_retnd (DBL_MAX); + } + else + { + hb_retnd (93786976294838206460.00); + } + return; + +} + + diff --git a/harbour/contrib/libct/tests/Makefile b/harbour/contrib/libct/tests/Makefile index 8019560254..787cd92d5f 100644 --- a/harbour/contrib/libct/tests/Makefile +++ b/harbour/contrib/libct/tests/Makefile @@ -66,12 +66,16 @@ PRG_SOURCES=\ csetatmu.prg \ csetarge.prg \ csetref.prg \ + finan.prg \ + math.prg \ + num1.prg \ numtoken.prg \ setatlik.prg \ token.prg \ tokenlow.prg \ tokensep.prg \ tokenupp.prg \ + trig.prg \ valpos.prg \ wordone.org \ wordonly.prg \ diff --git a/harbour/contrib/libct/tests/finan.prg b/harbour/contrib/libct/tests/finan.prg new file mode 100644 index 0000000000..c916ccacca --- /dev/null +++ b/harbour/contrib/libct/tests/finan.prg @@ -0,0 +1,111 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 Financial functions + * - PV + * - FV + * - PAYMENT + * - PERIODS + * - RATE + * + * NOTE: All these functions were builded using Borland C++ 5.5 (free version) + * + * Copyright 2001 Alejandro de Garate + * + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + +PROCEDURE MAIN + + CTINIT() + + SET DECIMAL TO 3 + CLS + ?? "Testing Financial functions...." + ? + ? "Calculate how loan summs if you make deposits for $175.00 for 24 months," + ? "if the annual rate of the Bank for this mortage is 9.5% fixed" + ? "PV( 175, 0.095/12, 24 ) = 3811.433 // CT3" + ? SPACE(19), PV( 175, 0.095/12, 24 ), " <-- CT for Harbour" + ? + ? + + ? "Calculate the amount in your account after 3 years, if you make deposits" + ? "for $150.00 per month, and the annual rate of the Bank for this is 6%" + ? "Capital = FV( 150, 0.06/12, 36 ) = 5900.416 // CT3" + ? SPACE(28), FV( 150, 0.06/12, 36 ), " <-- CT for Harbour" + ? + ? + + ? "Calculate the monthly payment for a loan of $2000.00 at an annual rate" + ? "of 10%, within 24 month " + ? "PAYMENT( 2000.00, 0.10/12, 24 ) = 92.290 // CT3" + ? SPACE(26),PAYMENT( 2000.00, 0.10/12, 24 ), " <-- CT for Harbour" + ? + ? " PRESS ANY KEY" + + INKEY (0) + ? "Continue Testing Financial functions...." + ? + ? "Calculate how many month do you need to cancel a loan of $4000.00 at" + ? "an annual rate of 9.5% with payments of $200.00 max" + ? "PERIODS( 4000.00, 200.00, 0.095/12 ) = 21.859 // CT3" + ? SPACE(31), PERIODS( 4000.00, 200.00, 0.095/12 ), " <-- CT for Harbour" + ? + ? + + ? "Calculate which is the effective anual rate of your Bank, for a loan" + ? "of $2500.00 if you pay $86.67 per month for 3 years" + ? "RATE( 2500.00, 86.67, 36 ) * 12 = 0.1501 // CT3" + ? SPACE(24), RATE( 2500.00, 86.67, 36 ) * 12.0, " <-- CT for Harbour" + ? + ? " PRESS ANY KEY" + INKEY(0) + + CTEXIT() + +RETURN diff --git a/harbour/contrib/libct/tests/math.prg b/harbour/contrib/libct/tests/math.prg new file mode 100644 index 0000000000..38fecefab0 --- /dev/null +++ b/harbour/contrib/libct/tests/math.prg @@ -0,0 +1,178 @@ +/* + * Harbour Project source code: + * + * Test CT3 math functions + * - FLOOR + * - CEILING + * - LOG10 + * - SIGN + * - FACT + * + * Copyright 2001 Alejandro de Garate + * + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + + PROCEDURE MAIN + + CTINIT() + + SET DECIMAL TO 2 + CLS + ? "Test of mathematical functions" + ? + + ? "FLOOR( 1.9) = 1 // CT3" + ? SPACE(4), FLOOR( 1.9)," <-- CT for Harbour" + ? + + ? "FLOOR( 1.1) = 1 // CT3" + ? SPACE(4), FLOOR( 1.1)," <-- CT for Harbour" + ? + + ? "FLOOR( 0.9) = 0 // CT3" + ? SPACE(4), FLOOR( 0.9)," <-- CT for Harbour" + ? + + ? "FLOOR( -0.1) = -1 // CT3" + ? SPACE(6), FLOOR( -0.1)," <-- CT for Harbour" + ? + + ? "FLOOR( -0.9) = -1 // CT3" + ? SPACE(6), FLOOR( -0.9)," <-- CT for Harbour" + ? + + ? "FLOOR( -1.1) = -2 // CT3" + ? SPACE(6), FLOOR( -1.1)," <-- CT for Harbour" + ? + WAIT4() + + ? "CEILING( 1.9) = 2 // CT3" + ? SPACE(6), CEILING( 1.9)," <-- CT for Harbour" + ? + + ? "CEILING( 1.1) = 2 // CT3" + ? SPACE(6), CEILING( 1.1)," <-- CT for Harbour" + ? + + ? "CEILING( 0.9) = 1 // CT3" + ? SPACE(6), CEILING( 0.9)," <-- CT for Harbour" + ? + + ? "CEILING( -0.1) = 0 // CT3" + ? SPACE(7), CEILING( -0.1)," <-- CT for Harbour" + ? + + ? "CEILING( -0.9) = 0 // CT3" + ? SPACE(7), CEILING( -0.9)," <-- CT for Harbour" + ? + + ? "CEILING( -1.1) = -1 // CT3" + ? SPACE(8), CEILING( -1.1)," <-- CT for Harbour" + ? + + WAIT4() + + + ? "LOG10( 0.01 ) = -2.00 // CT3" + ? SPACE(7), LOG10( 0.01 )," <-- CT for Harbour" + ? + + ? "LOG10( 2 ) = 0.30 // CT3" + ? SPACE(3), LOG10( 2 )," <-- CT for Harbour" + ? + + ? "LOG10( 100 ) = 2.00 // CT3" + ? SPACE(5), LOG10( 100 )," <-- CT for Harbour" + ? + ? + + ? "SIGN( 48335 ) = 1 // CT3" + ? SPACE(6), SIGN( 48335 )," <-- CT for Harbour" + ? + + ? "SIGN( -258 ) = -1 // CT3" + ? SPACE(6), SIGN( -258 )," <-- CT for Harbour" + ? + + WAIT4() + + SET DECIMALS TO 0 + ? "FACT( 1 ) = 1 // CT3" + ? SPACE(2), FACT( 1 ), " <-- CT for Harbour" + ? + + ? "FACT( 5 ) = 120 // CT3" + ? SPACE(4), FACT( 5), " <-- CT for Harbour" + ? + + ? "FACT( 21 ) = 51090942171709440000 // CT3" + ? SPACE(12), FACT( 21), " <-- CT for Harbour" + ? + + ? "FACT( 25 ) = -1 // CT3" + ? SPACE(4), FACT( 25), " <-- CT for Harbour" + ? + + ? "FACT( 0 ) = 1 // CT3" + ? SPACE(2), FACT( 0), " <-- CT for Harbour" + ? + + CTEXIT() + +RETURN + +PROCEDURE WAIT4 + ? " PRESS ANY KEY" + INKEY(0) + CLS + +RETURN + + + + + + + diff --git a/harbour/contrib/libct/tests/num1.prg b/harbour/contrib/libct/tests/num1.prg new file mode 100644 index 0000000000..46e6191099 --- /dev/null +++ b/harbour/contrib/libct/tests/num1.prg @@ -0,0 +1,106 @@ +/* + * Harbour Project source code: + * + * Test CT3 Numeric functions - PART 1 + * + * - CELSIUS + * - FAHRENHEIT + * - INFINITY + * + * Copyright 2001 Alejandro de Garate + * + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + + + PROCEDURE MAIN + + CTINIT() + + SET DECIMAL TO 14 + CLS + ?? "Test of Numeric functions - part 1" + + ? "CELSIUS( 33.8 ) = 1 // CT3" + ? SPACE(10), CELSIUS( 33.8 ), " <-- CT for Harbour " + ? + + ? "CELSIUS( 338.0 ) = 170 // CT3" + ? SPACE(11), CELSIUS( 338.0 ), " <-- CT for Harbour " + ? + + ? "CELSIUS( 3380.0) = 1860 // CT3" + ? SPACE(12), CELSIUS( 3380.0), " <-- CT for Harbour " + ? + + ? "CELSIUS( -33.8) = -36.5555.. // CT3" + ? SPACE(10), CELSIUS( -33.8), " <-- CT for Harbour " + ? + + ? "FAHRENHEIT( 12.5 ) = 54.5 // CT3" + ? SPACE(12), FAHRENHEIT( 12.5 ), " <-- CT for Harbour " + ? + + ? "FAHRENHEIT( 125 ) = 257 // CT3" + ? SPACE(12), FAHRENHEIT( 125 ), " <-- CT for Harbour " + ? + + ? "FAHRENHEIT( 1250 ) = 2282 // CT3" + ? SPACE(14), FAHRENHEIT( 1250 ), " <-- CT for Harbour " + ? + ? "FAHRENHEIT( -155 ) = -247 // CT3" + ? SPACE(14), FAHRENHEIT( -155 ), " <-- CT for Harbour " + ? + ? " PRESS ANY KEY" + + INKEY(0) + + + ? "INFINITY() // CT3" + ? SPACE(8), STR( INFINITY(), 30, 15), " <-- CT for Harbour" + ? + + CTEXIT() + +RETURN diff --git a/harbour/contrib/libct/tests/trig.prg b/harbour/contrib/libct/tests/trig.prg new file mode 100644 index 0000000000..2b32f1a581 --- /dev/null +++ b/harbour/contrib/libct/tests/trig.prg @@ -0,0 +1,267 @@ +/* + * Harbour Project source code: + * + * Test CT3 TRIGONOMETRIC functions - PART 1 + * + * - PI + * - SIN + * - COS + * - TAN + * - COT + * - ASIN + * - ACOS + * - ATAN + * - ATN2 + * - SINH + * - COSH + * - TANH + * + * Copyright 2001 Alejandro de garate + * + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + + + PROCEDURE MAIN + + local X, Y + + CTINIT() + + SET DECIMAL TO 14 + CLS + ? "Begin test of Trigonometric functions... " + ? + ? "PI = " + STR( PI(), 18, 15 ) + + ? "STR( SIN( PI() /4 ), 18, 15 ) = 0.707106781186548 // CT3" + ? SPACE(32) + STR( SIN( PI() /4 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( SIN( PI() /2 ), 18, 15 ) = 1.000000000000000 // CT3" + ? SPACE(32) + STR( SIN( PI() /2 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( SIN( PI() *99.5 ), 18, 15 ) = -1.000000000000000 // CT3" + ? SPACE(35) + STR( SIN( PI() * 99.5 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( SIN( PI() /9 ), 18, 15 ) = 0.342020143325669 // CT3" + ? SPACE(32) + STR( SIN( PI() / 9 ), 18, 15 ) + " <-- CT for Harbour" + + WAIT4() + + + ? "STR( COS( 0 ), 18, 15 ) = 1.000000000000000 // CT3" + ? SPACE(26) + STR( COS( 0 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( COS( PI() /4 ), 18, 15 ) = 0.707106781186548 // CT3" + ? SPACE(32) + STR( COS( PI() /4 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( COS( PI() /2 ), 18, 15 ) = 0.000000000000000 // CT3" + ? SPACE(32) + STR( COS( PI() /2 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( COS( PI() *99.5 ), 18, 15 ) = 0.000000000000000 // CT3" + ? SPACE(34) + STR( COS( PI() *99.5), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( COS( PI() /9 ), 18, 15 ) = 0.939692620785908 // CT3" + ? SPACE(32) + STR( COS( PI() / 9 ), 18, 15 ) + " <-- CT for Harbour" + ? + + + WAIT4() + + + ? "STR( TAN( 0 ), 18, 15 ) = 1.000000000000000 // CT3 wrong ! " + ? SPACE(26) + STR( TAN( 0 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( TAN( PI() /4 ), 18, 15 ) = 1.000000000000000 // CT3" + ? SPACE(32) + STR( TAN( PI() /4 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( TAN( PI() /9 ), 18, 15 ) = 0.363970234266202 // CT3" + ? SPACE(32) + STR( TAN( PI() / 9 ), 18, 15 ) + " <-- CT for Harbour" + ? + ? + ? + + ? "STR( ASIN( 0.5 ), 18, 15 ) = 0.523598775598299 // CT3" + ? SPACE(29) + STR( ASIN( 0.5 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( ACOS( 0.7 ), 18, 15 ) = 0.795398830184144 // CT3" + ? SPACE(29) + STR( ACOS( 0.7 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( ATAN( PI() /4 ), 18, 15 ) = 0.665773750028354 // CT3" + ? SPACE(33) + STR( ATAN( PI() /4 ), 18, 15 ) + " <-- CT for Harbour" + ? + + WAIT4() + + + ? "STR( COT( PI() /4 ), 18, 15 ) = 1.000000000000000 // CT3" + ? SPACE(32) + STR( COT( PI() /4 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( COT( PI() /2 ), 18, 15 ) = 0.000000000000000 // CT3" + ? SPACE(32) + STR( COT( PI() /2 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( COT( PI() /9 ), 18, 15 ) = 2.747477419454622 // CT3" + ? SPACE(32) + STR( COT( PI() / 9 ), 18, 15 ) + " <-- CT for Harbour" + ? + + WAIT4() + + ?? "Testing Hiperbolic Sine..." + ? + ? "STR( SINH( PI() /2 ), 18, 15 ) = 2.301298902307295 // CT3" + ? SPACE(33) + STR( SINH( PI() /2 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( SINH( PI() /4 ), 18, 15 ) = 0.868670961486010 // CT3" + ? SPACE(33) + STR( SINH( PI() /4 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "Testing Hiperbolic Cosine..." + ? + ? "STR( COSH( PI() /2 ), 18, 15 ) = 2.509178478658057 // CT3" + ? SPACE(33) + STR( COSH( PI() /2 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "STR( COSH( PI() /4 ), 18, 15 ) = 1.324609089252006 // CT3" + ? SPACE(33) + STR( COSH( PI() /4 ), 18, 15 ) + " <-- CT for Harbour" + ? + + ? "Testing Hiperbolic Tangent..." + ? + ? "STR( TANH( PI() /2 ), 18, 15 ) = 0.917152335667274 // CT3" + ? SPACE(33) + STR( TANH( PI() /2 ), 18, 15 ) + " <-- CT for Harbour" + ? + ? "STR( TANH( PI() /4 ), 18, 15 ) = 0.655794202632672 // CT3" + ? SPACE(33) + STR( TANH( PI() /4 ), 18, 15 ) + " <-- CT for Harbour" + ? + + WAIT4() + + ? "Testing Degree TO Radian..." + ? + ? "STR( DTOR( 360), 18, 15 ) = 6.283185307179588 // CT3" + ? SPACE(27) + STR( DTOR( 360), 18, 15 ), " <-- CT for Harbour " + ? + + ? "STR( DTOR( 180), 18, 15 ) = 3.141592653589794 // CT3" + ? SPACE(27) + STR( DTOR( 180), 18, 15 ), " <-- CT for Harbour " + ? + + ? "STR( DTOR( 180.5), 18, 15 ) = 3.150319299849766 // CT3" + ? SPACE(29) + STR( DTOR( 180.5), 18, 15 ), " <-- CT for Harbour " + ? + + ? "STR( DTOR( 720), 18, 15 ) = 12.566370614359180 // CT3" + ? SPACE(28) + STR( DTOR( 720), 18, 15 ), " <-- CT for Harbour " + ? + + ? "STR( DTOR( -180), 18, 15 ) = -3.141592653589794 // CT3" + ? SPACE(29) + STR( DTOR( -180), 18, 15 ), " <-- CT for Harbour " + + WAIT4() + + + ? "Testing Radian TO Degree..." + ? + ? "RTOD( PI() ) = 180 // CT3 " + ? SPACE(7), RTOD( PI() ), " <-- CT for Harbour " + + ? "RTOD( 2 * PI()) = 360 // CT3 " + ? SPACE(10), RTOD( 2 * PI() ), " <-- CT for Harbour " + + ? "RTOD( 4 * PI()) = 720 // CT3 " + ? SPACE(10), RTOD( 4 * PI() ), " <-- CT for Harbour " + + ? "RTOD( -PI() ) = -180 // CT3" + ? SPACE(9), RTOD( -PI() ), " <-- CT for Harbour " + ? + + WAIT4() + + +/* NOTE: ATN2( x, y) have the parameters inverted, when + comparing with the standard C languaje ATAN2( y, x) +*/ + + + ? "Testing ATN2( x, y )... where:" + + x = SIN( DTOR( 30 ) ) + y = COS( DTOR( 30 ) ) + ? "x = SIN( DTOR( 30 ) ) =", x + ? "y = COS( DTOR( 30 ) ) =", y + ? + ? "STR( ATN2( x, y ), 18, 15 ) = 0.523598775598299 // CT3" + ? SPACE(31) + STR( ATN2( x, y), 18, 15 ) + " <-- CT for Harbour" + ? + ? "RTOD( ATN2( x, y)) ="+ STR( RTOD( ATN2( x,y)), 18,4) +" <-- CT for Harbour" + ? + + WAIT4() + + CTEXIT() + +RETURN + + +PROCEDURE WAIT4 + ? " PRESS ANY KEY" + INKEY(0) + CLS + +RETURN + diff --git a/harbour/contrib/libct/token1.c b/harbour/contrib/libct/token1.c index a237d5659a..d73b27634d 100644 --- a/harbour/contrib/libct/token1.c +++ b/harbour/contrib/libct/token1.c @@ -83,7 +83,7 @@ static int siPostSeparator = -1; /* TODO: make this threadsafe */ static void do_token1 (int iSwitch) { - int iParamCheck; + int iParamCheck = 0; int iNoRef = ct_getref(); switch (iSwitch) @@ -110,10 +110,13 @@ static void do_token1 (int iSwitch) size_t sStrLen = (size_t)hb_parclen (1); char *pcSeparatorStr; size_t sSeparatorStrLen; - ULONG ulTokenCounter, ulSkip; + ULONG ulTokenCounter = 0; + ULONG ulSkip; - char *pcSubStr, *pcRet; - size_t sSubStrLen, sRetStrLen; + char *pcSubStr; + char *pcRet = NULL; + size_t sSubStrLen; + size_t sRetStrLen = 0; ULONG ulToken = 0; ULONG ulSkipCnt; @@ -283,7 +286,7 @@ static void do_token1 (int iSwitch) /* should we find the last token, but string ends with tokenizer, i.e. pc points to a the last character at the moment ? -> break here ! */ - if (ulTokenCounter == HB_MKULONG (255,255,255,255) && + if ((ulTokenCounter == HB_MKULONG (255,255,255,255)) && (pc+1==pcString+sStrLen)) { break; @@ -533,7 +536,7 @@ static void do_token1 (int iSwitch) * $PLATFORMS$ * All * $FILES$ - * Source is token1.c, library is ct3. + * Source is token1.c, library is libct. * $SEEALSO$ * TOKEN(),NUMTOKEN(),TOKENLOWER(),TOKENUPPER(),TOKENSEP() * $END$ @@ -610,7 +613,7 @@ HB_FUNC (ATTOKEN) * $PLATFORMS$ * All * $FILES$ - * Source is token1.c, library is ct3. + * Source is token1.c, library is libct. * $SEEALSO$ * NUMTOKEN(),ATTOKEN(),TOKENLOWER(),TOKENUPPER(),TOKENSEP() * $END$ @@ -649,7 +652,7 @@ HB_FUNC (TOKEN) * $PLATFORMS$ * All * $FILES$ - * Source is token1.c, library is ct3. + * Source is token1.c, library is libct. * $SEEALSO$ * TOKEN(),ATTOKEN(),TOKENLOWER(),TOKENUPPER(),TOKENSEP() * $END$ @@ -718,7 +721,7 @@ HB_FUNC (NUMTOKEN) * $PLATFORMS$ * All * $FILES$ - * Source is token1.c, library is ct3. + * Source is token1.c, library is libct. * $SEEALSO$ * TOKEN(),NUMTOKEN(),ATTOKEN(),TOKENUPPER(),TOKENSEP(),CSETREF() * $END$ @@ -788,7 +791,7 @@ HB_FUNC (TOKENLOWER) * $PLATFORMS$ * All * $FILES$ - * Source is token1.c, library is ct3. + * Source is token1.c, library is libct. * $SEEALSO$ * TOKEN(),NUMTOKEN(),ATTOKEN(),TOKENLOWER(),TOKENSEP(),CSETREF() * $END$ @@ -837,7 +840,7 @@ HB_FUNC (TOKENUPPER) * $PLATFORMS$ * All * $FILES$ - * Source is token1.c, library is ct3. + * Source is token1.c, library is libct. * $SEEALSO$ * TOKEN(),NUMTOKEN(),ATTOKEN(),TOKENLOWER(),TOKENUPPER() * $END$ diff --git a/harbour/contrib/libct/trig.c b/harbour/contrib/libct/trig.c new file mode 100644 index 0000000000..e9ce04a5af --- /dev/null +++ b/harbour/contrib/libct/trig.c @@ -0,0 +1,1194 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 trigonometric functions + * - PI + * - SIN + * - COS + * - TAN + * - COT + * - ASIN + * - ACOS + * - ATAN + * - SINH + * - COSH + * - TANH + * - ATN2 + * - RTOD + * - DTOR + * + * NOTE: All these functions were builded using Borland C++ 5.5 (free version) + * + * Copyright 2001 Alejandro de Garate + * + * Documentation and changes concerning error handling Copyright 2001 + * IntTec GmbH, Freiburg, Germany, Author: Martin Vogel + * + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + +#include "ct.h" + + +/* $DOC$ + * $FUNCNAME$ + * PI() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Returns Pi, the perimeter-to-diameter-ratio of a circle + * $SYNTAX$ + * PI () -> nPi + * $ARGUMENTS$ + * $RETURNS$ + * the math constant Pi with maximum precision available + * $DESCRIPTION$ + * The function PI() can be used if the constant Pi is needed + * with maximum precision. One of the most known interpretations of this + * number is the constant perimeter-to-diameter-ratio of circles. + * $EXAMPLES$ + * // the diameter of a circle-like swimming pool is 3.4 meters, how + * // long is the perimeter ? + * + * ? str(PI()*3.4,5,3)+" meters" --> 10.681 meters + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * PI() is compatible with CT3's PI(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is trig.c, library is libct. + * $SEEALSO$ + * SIN(),COS(),TAN(),COT(),ASIN(),ACOS(),ATAN(),ATN2(),SINH(),COSH(),TANH(),RTOD(),DTOR() + * $END$ + */ + +HB_FUNC( PI ) +{ + hb_retnd (CT_PI); + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * SIN() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Sine of the argument + * $SYNTAX$ + * SIN (nRadiant) -> nSine + * $ARGUMENTS$ + * an angle size given in radiants + * $RETURNS$ + * the sine of + * $DESCRIPTION$ + * The function SIN() calculates the sine of an angle whose size is + * given in radiants (full angle equals 2*Pi - see DTOR() for angle size + * given in degress). + * A common geometric interpretation of the SIN() function is the + * counterkathede-hypotenuse-ratio of a right-angled triangle. + * $EXAMPLES$ + * ? sin (0.0) --> 0.0 + * ? sin (1.0) --> 0.8414... + * $TESTS$ + * sin (0.0) == 0.0 + * sin (PI()/4) == sqrt(1/2) + * sin (PI()/2) == 1.0 + * sin (PI()) == 0.0 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * SIN() is compatible with CT3's SIN(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is trig.c, library is libct. + * $SEEALSO$ + * COS(),TAN(),COT(),ASIN(),ACOS(),ATAN(),ATN2(),SINH(),COSH(),TANH(),RTOD(),DTOR(),PI() + * $END$ + */ + +HB_FUNC( SIN ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + ct_matherrbegin(); + dResult = sin (dInput); + ct_matherrend(); + + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_SIN, + NULL, "SIN", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * COS() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Cosine of the argument + * $SYNTAX$ + * COS (nRadiant) -> nCosine + * $ARGUMENTS$ + * an angle size given in radiants + * $RETURNS$ + * the cosine of + * $DESCRIPTION$ + * The function COS() calculates the cosine of an angle whose size is + * given in radiants (full angle equals 2*Pi - see DTOR() for angle size + * given in degress). + * A common geometric interpretation of the COS() function is the + * ankathede-hypotenuse-ratio of a right-angled triangle. + * $EXAMPLES$ + * ? cos (0.0) --> 1.0 + * ? cos (1.0) --> 0.5403... + * $TESTS$ + * cos (0.0) == 1.0 + * cos (PI()/4) == sqrt(1/2) + * cos (PI()/2) == 0.0 + * cos (PI()) == -1.0 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * COS() is compatible with CT3's COS(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is trig.c, library is libct. + * $SEEALSO$ + * SIN(),TAN(),COT(),ASIN(),ACOS(),ATAN(),ATN2(),SINH(),COSH(),TANH(),RTOD(),DTOR(),PI() + * $END$ + */ + +HB_FUNC( COS ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + ct_matherrbegin(); + dResult = cos (dInput); + ct_matherrend(); + + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_COS, + NULL, "COS", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * TAN() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Tangent of the argument + * $SYNTAX$ + * TAN (nRadiant) -> nTangent + * $ARGUMENTS$ + * an angle size given in radiants + * $RETURNS$ + * the tangent of + * $DESCRIPTION$ + * The function TAN() calculates the tangent of an angle whose size is + * given in radiants (full angle equals 2*Pi - see DTOR() for angle size + * given in degress). + * A common geometric interpretation of the TAN() function is the + * counterkathede-ankathede-ratio of a right-angled triangle, or, + * tan(x) = sin(x)/cos(x). + * $EXAMPLES$ + * ? tan (0.0) --> 0.0 + * ? tan (1.0) --> 1.5574... + * $TESTS$ + * tan (0.0) == 0.0 + * tan (PI()/4) == 1 + * tan (PI()) == 0.0 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * TAN() is compatible with CT3's TAN(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is trig.c, library is libct. + * $SEEALSO$ + * SIN(),COS(),COT(),ASIN(),ACOS(),ATAN(),ATN2(),SINH(),COSH(),TANH(),RTOD(),DTOR(),PI() + * $END$ + */ + +HB_FUNC( TAN ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + if (((dInput/CT_PI)-floor(dInput/CT_PI)) == 0.5) + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_TAN, + NULL, "TAN", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (DBL_MAX); + } + } + else + { + ct_matherrbegin(); + dResult = tan (dInput); + ct_matherrend(); + hb_retnd( dResult ); + } + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_TAN, + NULL, "TAN", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * COT() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Cotangent of the argument + * $SYNTAX$ + * COT (nRadiant) -> nCotangent + * $ARGUMENTS$ + * an angle size given in radiants + * $RETURNS$ + * the cotangent of + * $DESCRIPTION$ + * The function COT() calculates the cotangent of an angle whose size is + * given in radiants (full angle equals 2*Pi - see DTOR() for angle size + * given in degress). + * A common geometric interpretation of the COT() function is the + * ankathede-counterkathede-ratio of a right-angled triangle, or, + * cot(x) = cos(x)/sin(x)=1/tan(x). + * $EXAMPLES$ + * ? cot (1.0) --> 0.6420... + * $TESTS$ + * cot (PI()/4) == 1 + * cot (PI()/2) == 0 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * COT() is compatible with CT3's COT(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is trig.c, library is libct. + * $SEEALSO$ + * SIN(),COS(),TAN(),ASIN(),ACOS(),ATAN(),ATN2(),SINH(),COSH(),TANH(),RTOD(),DTOR(),PI() + * $END$ + */ + +HB_FUNC( COT ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + if (((dInput/CT_PI)-floor(dInput/CT_PI)) == 0.0) + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_COT, + NULL, "COT", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (DBL_MAX); + } + } + else + { + ct_matherrbegin(); + dResult = 1/tan (dInput); + ct_matherrend(); + hb_retnd( dResult ); + } + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_COT, + NULL, "COT", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * ASIN() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Arcus sine of the argument + * $SYNTAX$ + * ASIN (nSine) -> nRadiant + * $ARGUMENTS$ + * the sine of an angle + * $RETURNS$ + * the angle whose sine is + * $DESCRIPTION$ + * The function ASIN() is the inverse function of SIN(). It takes a + * sine value and returns the smallest(!) angle whose sine equals to the argument. + * The return value is given in radiants (full angle equals 2*Pi - + * see DTOR() if you need to convert it into degress). + * Note, that must be between -1 and 1 and that + * is always between -PI()/2 and PI()/2. + * $EXAMPLES$ + * ? asin (0.0) --> 0.0 + * ? asin (0.5) --> 0.5235... + * $TESTS$ + * asin (0.0) == 0.0 + * asin (sqrt(1/2)) == PI()/4 + * asin (1.0) == PI()/2 + * asin (0.0) == 0.0 // and not PI(), since the smallest angle is returned ! + * $STATUS$ + * Ready + * $COMPLIANCE$ + * ASIN() is compatible with CT3's ASIN(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is trig.c, library is libct. + * $SEEALSO$ + * SIN(),COS(),TAN(),COT(),ACOS(),ATAN(),ATN2(),SINH(),COSH(),TANH(),RTOD(),DTOR(),PI() + * $END$ + */ + +HB_FUNC( ASIN ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + if (abs(dInput) > 1.0) + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ASIN, + NULL, "ASIN", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + else + { + ct_matherrbegin(); + dResult = asin (dInput); + ct_matherrend(); + hb_retnd( dResult ); + } + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ASIN, + NULL, "ASIN", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * ACOS() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Arcus cosine of the argument + * $SYNTAX$ + * ACOS (nCosine) -> nRadiant + * $ARGUMENTS$ + * the cosine of an angle + * $RETURNS$ + * the angle whose cosine is + * $DESCRIPTION$ + * The function ACOS() is the inverse function of COS(). It takes a + * cosine value and returns the smallest(!) angle whose cosine equals to the argument. + * The return value is given in radiants (full angle equals 2*Pi - + * see DTOR() if you need to convert it into degress). + * Note, that must be between -1 and 1 and that + * is always between 0 and PI(). + * $EXAMPLES$ + * ? acos (0.0) --> PI()/2 + * ? acos (0.5) --> 1.04719... + * $TESTS$ + * acos (0.0) == PI()/2 + * acos (sqrt(1/2)) == PI()/4 + * acos (1.0) == 0.0 + * acos (-1.0) == PI() + * acos (0.0) == PI()/2 // and not -PI()/2, although cos (-PI()/2) == 0.0 ! + * $STATUS$ + * Ready + * $COMPLIANCE$ + * ACOS() is compatible with CT3's ACOS(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is trig.c, library is libct. + * $SEEALSO$ + * SIN(),COS(),TAN(),COT(),ASIN(),ATAN(),ATN2(),SINH(),COSH(),TANH(),RTOD(),DTOR(),PI() + * $END$ + */ + +HB_FUNC( ACOS ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + if (abs(dInput) > 1.0) + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ACOS, + NULL, "ACOS", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + else + { + ct_matherrbegin(); + dResult = acos (dInput); + ct_matherrend(); + hb_retnd( dResult ); + } + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ACOS, + NULL, "ACOS", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * ATAN() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Arcus tangent of the argument + * $SYNTAX$ + * ACOS (nTangent) -> nRadiant + * $ARGUMENTS$ + * the tangent of an angle + * $RETURNS$ + * the angle whose tangent is + * $DESCRIPTION$ + * The function ATAN() is the inverse function of TAN(). It takes a + * tangent value and returns the smallest(!) angle whose tangent equals to the argument. + * The return value is given in radiants between -PI()/2 and PI()/2 + * (full angle equals 2*Pi - see DTOR() if you need to convert it into degress). + * $EXAMPLES$ + * ? atan (0.0) --> 0.0 + * ? atan (0.5) --> 0.4636... + * $TESTS$ + * atan (0.0) == 0.0 + * atan (1.0) == PI()/4 + * atan (0.0) == 0.0 // and not PI(), although tan (PI()) == 0.0 ! + * $STATUS$ + * Ready + * $COMPLIANCE$ + * ATAN() is compatible with CT3's ATAN(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is trig.c, library is libct. + * $SEEALSO$ + * SIN(),COS(),TAN(),COT(),ASIN(),ACOS(),ATAN(),SINH(),COSH(),TANH(),RTOD(),DTOR(),PI() + * $END$ + */ + +HB_FUNC( ATAN ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + ct_matherrbegin(); + dResult = atan (dInput); + ct_matherrend(); + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ATAN, + NULL, "ATAN", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * ATN2() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Arcus tangent a sine and a cosine argument + * $SYNTAX$ + * ATN2 (nSine, nCosine) -> nRadiant + * $ARGUMENTS$ + * the sine of an angle + * the cosine of an angle + * $RETURNS$ + * the angle whose tangent is / + * $DESCRIPTION$ + * The function ATN2() is an alternate function for calculating + * the arcus tangent, atn2(x,y) = atan(x/y). + * It takes two arguments, the sine and the cosine + * of the angle that should be calculated. Thus, in contrast to the ATAN() + * function, ATN2() can distinguish whether the sine or the cosine has + * a negative sign (or both being positive or negative), so that + * the return value can be between -PI() and PI() and covers the full + * angle. + * The return value is given in radiants (full angle equals 2*Pi - + * see DTOR() if you need to convert it into degress). + * $EXAMPLES$ + * ? atn2 (0.0, 1.0) --> 0.0 + * ? atn2 (sqrt(1/2), sqrt(1/2)) --> PI()/4 + * $TESTS$ + * atn2 (0.0, 1.0) == 0.0 + * atn2 (sqrt(1/2),sqrt(1/2)) == PI()/4 + * atn2 (-sqrt(1/2),-sqrt(1/2)) == -3/4*PI() // atan() would return PI()/4 ! + * $STATUS$ + * Ready + * $COMPLIANCE$ + * ATN2() is compatible with CT3's ATN2(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is trig.c, library is libct. + * $SEEALSO$ + * SIN(),COS(),TAN(),COT(),ASIN(),ACOS(),ATAN(),SINH(),COSH(),TANH(),RTOD(),DTOR(),PI() + * $END$ + */ + +HB_FUNC( ATN2 ) +{ + if( ISNUM(1) && ISNUM(2) ) + { + double dY = hb_parnd(1); + double dX = hb_parnd(2); + double dResult; + + ct_matherrbegin(); + dResult = atan2( dY, dX ); /* NOTE: parameters are swapped */ + ct_matherrend(); + hb_retnd( dResult ); + + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_ATN2, + NULL, "ATN2", 0, EF_CANSUBSTITUTE, 2, + hb_paramError (1), hb_paramError (2)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * SINH() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Hyperbolic Sine of the argument + * $SYNTAX$ + * SINH (nArea) -> nHyperbolicSine + * $ARGUMENTS$ + * the size of the area (see below) + * $RETURNS$ + * the hyperbolic sine of + * $DESCRIPTION$ + * The function SINH() calculates the hyperbolic sine of the argument. + * In analytical mathematics it is defined as 1/2*(exp(nArea)-exp(-nArea)). + * A common geometric interpretation of the SINH() function is the + * maximum y value of the points in the area with the given size , + * that is bound by the x axis, a straight line through the point of + * origin (this one is fixed by the area) and the hyperbola x^2-y^2=1. + * $EXAMPLES$ + * ? sinh (0.0) --> 0.0 + * ? sinh (1.0) --> 1.1752... + * $TESTS$ + * sinh (0.0) == 0.0 + * sinh (-0.5) == -sinh(0.5) + * $STATUS$ + * Ready + * $COMPLIANCE$ + * SINH() is new in Harbours CT3's library. + * $PLATFORMS$ + * All + * $FILES$ + * Source is trig.c, library is libct. + * $SEEALSO$ + * SIN(),COS(),TAN(),COT(),ASIN(),ACOS(),ATAN(),ATN2(),COSH(),TANH(),RTOD(),DTOR(),PI() + * $END$ + */ + +HB_FUNC( SINH ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + ct_matherrbegin(); + dResult = sinh (dInput); + ct_matherrend(); + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_SINH, + NULL, "SINH", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * COSH() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Hyperbolic Cosine of the argument + * $SYNTAX$ + * COSH (nArea) -> nHyperbolicCosine + * $ARGUMENTS$ + * the size of the area (see below) + * $RETURNS$ + * the hyperbolic cosine of + * $DESCRIPTION$ + * The function COSH() calculates the hyperbolic cosine of the argument. + * In analytical mathematics it is defined as 1/2*(exp(nArea)+exp(-nArea)). + * A common geometric interpretation of the COSH() function is the + * maximum x value of the points in the area with the given size , + * that is bound by the x axis, a straight line through the point of + * origin (this one is fixed by the area) and the hyperbola x^2-y^2=1. + * $EXAMPLES$ + * ? cosh (0.0) --> 1.0 + * ? cosh (1.0) --> 1.5430... + * $TESTS$ + * cosh (0.0) == 1.0 + * cosh (-0.5) == cosh(0.5) + * $STATUS$ + * Ready + * $COMPLIANCE$ + * COSH() is new in Harbours CT3's library. + * $PLATFORMS$ + * All + * $FILES$ + * Source is trig.c, library is libct. + * $SEEALSO$ + * SIN(),COS(),TAN(),COT(),ASIN(),ACOS(),ATAN(),ATN2(),SINH(),TANH(),RTOD(),DTOR(),PI() + * $END$ + */ + +HB_FUNC( COSH ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + ct_matherrbegin(); + dResult = cosh (dInput); + ct_matherrend(); + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_COSH, + NULL, "COSH", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * SINH() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Hyperbolic Tangent of the argument + * $SYNTAX$ + * TANH (nArea) -> nHyperbolicTangent + * $ARGUMENTS$ + * the size of the area (see below) + * $RETURNS$ + * the hyperbolic tangent of + * $DESCRIPTION$ + * The function TANH() calculates the hyperbolic tangent of the argument. + * In analytical mathematics it is defined as SINH(x)/COSH(x). + * $EXAMPLES$ + * ? tanh (0.0) --> 0.0 + * ? tanh (1.0) --> 0.7615... + * $TESTS$ + * tanh (0.0) == 0.0 + * tanh (-0.5) == -tanh(0.5) + * $STATUS$ + * Ready + * $COMPLIANCE$ + * TANH() is new in Harbours CT3's library. + * $PLATFORMS$ + * All + * $FILES$ + * Source is trig.c, library is libct. + * $SEEALSO$ + * SIN(),COS(),TAN(),COT(),ASIN(),ACOS(),ATAN(),ATN2(),SINH(),COSH(),RTOD(),DTOR(),PI() + * $END$ + */ + +HB_FUNC( TANH ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + + ct_matherrbegin(); + dResult = tanh (dInput); + ct_matherrend(); + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_TANH, + NULL, "TANH", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * RTOD() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Convert radiant to degree + * $SYNTAX$ + * RTOD (nRadiant) -> nDegree + * $ARGUMENTS$ + * the size of an angle in radiant + * $RETURNS$ + * the size of that angle in degree + * $DESCRIPTION$ + * The function RTOD() can be used to convert sizes of angles given + * in radiant (like those returned by the asin, acos or atan function) + * to degrees that are commonly used geometry and technics. + * $EXAMPLES$ + * ? rtod (PI()) --> 180 + * ? tanh (PI()/3) --> 60 + * $TESTS$ + * rtod (0.0) == 0.0 + * rtod (PI()) == 180.0 + * $STATUS$ + * Ready + * $COMPLIANCE$ + * RTOD() is compatible with CT3's RTOD(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is trig.c, library is libct. + * $SEEALSO$ + * SIN(),COS(),TAN(),COT(),ASIN(),ACOS(),ATAN(),ATN2(),SINH(),COSH(),TANH(),DTOR(),PI() + * $END$ + */ + +HB_FUNC( RTOD ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult; + dResult = ( 180.0 / CT_PI ) * dInput ; + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_RTOD, + NULL, "RTOD", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +/* $DOC$ + * $FUNCNAME$ + * DTOR() + * $CATEGORY$ + * CT3 math functions + * $ONELINER$ + * Convert degree to radiant + * $SYNTAX$ + * DTOR (nDegree) -> nRadiant + * $ARGUMENTS$ + * the size of that angle in degree + * $RETURNS$ + * the size of an angle in radiant + * $DESCRIPTION$ + * The function DTOR() can be used to convert sizes of angles given + * in degrees to radiant (as expected by sin, cos or tan functions). + * $EXAMPLES$ + * ? dtor (180) --> PI() + * ? dtor (60) --> PI()/3 + * $TESTS$ + * dtor (0.0) == 0.0 + * dtor (180.0) == PI() + * $STATUS$ + * Ready + * $COMPLIANCE$ + * DTOR() is compatible with CT3's DTOR(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is trig.c, library is libct. + * $SEEALSO$ + * SIN(),COS(),TAN(),COT(),ASIN(),ACOS(),ATAN(),ATN2(),SINH(),COSH(),TANH(),RTOD(),PI() + * $END$ + */ + +HB_FUNC( DTOR ) +{ + if( ISNUM(1) ) + { + double dInput = hb_parnd(1); + double dResult = ( CT_PI / 180.0 ) * dInput ; + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_RTOD, + NULL, "RTOD", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnd (0.0); + } + } + + return; +} + + +