root/1.8.3/trunk/src/funmath.c

/**
 * \file funmath.c
 *
 * \brief Mathematical functions for mushcode.
 * 
 *
 */

#include "copyrite.h"

#include "config.h"
#include <math.h>
#include <string.h>
#include <ctype.h>
#include <errno.h>
#include "conf.h"
#include "externs.h"
#include "sort.h"
#include "parse.h"
#include "confmagic.h"

#ifdef WIN32
#pragma warning( disable : 4761)        /* NJG: disable warning re conversion */
#endif

#ifndef M_PI
/** The ratio of the circumference of a circle to its denominator. */
#define M_PI 3.14159265358979323846264338327
#endif

#define EPSILON 0.000000001  /**< limit of precision for float equality */
#define EQ(x,y) (fabs(x-y) < EPSILON)  /**< floating point equality macro */

static void do_spellnum(char *num, unsigned int len, char **buff, char ***bp);
static void do_ordinalize(char **buff, char ***bp);
static NVAL find_median(NVAL *, int);

static NVAL angle_to_rad(NVAL angle, const char *from);
static NVAL rad_to_angle(NVAL angle, const char *to);
static double frac(double v, double *RESTRICT n, double *RESTRICT d,
                   double error);

int format_long(intmax_t n, char *buff, char **bp, int maxlen, int base);

/* Generated by gperf */
#include "lmathtab.c"

/* Functions for testing and parsing IVALs and UIVALs, the types of
 * arguments to math functions that work on integers instead of
 *  floating-point numbers. No matter what IVAL is (32-bit or 64-bit),
 *  they can be passed to safe_integer()/safe_uinteger(). 
 *
 * Math functions that operate on IVALs: div(), floordiv(), modulo(),
 *  remainder()
 * Math functions that operate on UIVALS: shl(), shr(), band(), bnot(), bor()
 *  bxor(), bnand()
 *
 * Other functions work on NVALs or accept plain ints 
 */

static IVAL
parse_ival_full(const char *str, char **end, int base)
{
#if SIZEOF_IVAL == 4
  return parse_int32(str, end, base);
#else
#error "Unsupported IVAL size"
#endif
}

static IVAL
parse_ival(const char *str)
{
  return parse_ival_full(str, NULL, 10);
}

static UIVAL
parse_uival_full(const char *str, char **end, int base)
{
#if SIZEOF_IVAL == 4
  return parse_uint32(str, end, base);
#else
#error "Unsupported IVAL size"
#endif
}

static UIVAL
parse_uival(const char *str)
{
  return parse_uival_full(str, NULL, 10);
}


/** Is string an integer suitable for a math function?
 * To TinyMUSH, any string is an integer. To PennMUSH, a string that
 * passes strtol is an integer, and a blank string is an integer
 * if NULL_EQ_ZERO is turned on.
 * \param str string to check.
 * \retval 1 string is an integer.
 * \retval 0 string is not an integer.
 */
static bool
is_ival(char const *str)
{
  char *end;

  /* If we're emulating Tiny, anything is an integer */
  if (TINY_MATH)
    return 1;
  if (!str)
    return 0;
  while (isspace((unsigned char) *str))
    str++;
  if (*str == '\0')
    return NULL_EQ_ZERO;
  errno = 0;
  parse_ival_full(str, &end, 10);
  if (errno == ERANGE || *end != '\0')
    return 0;
  return 1;
}

/** Is string a UIVAL?
 * To TinyMUSH, any string is an uinteger. To PennMUSH, a string that
 * passes strtoul is an uinteger, and a blank string is an uinteger
 * if NULL_EQ_ZERO is turned on.
 * \param str string to check.
 * \retval 1 string is an uinteger.
 * \retval 0 string is not an uinteger.
 */
static bool
is_uival(char const *str)
{
  char *end;

  /* If we're emulating Tiny, anything is an integer */
  if (TINY_MATH)
    return 1;
  if (!str)
    return 0;
  /* strtoul() accepts negative numbers, so we still have to do this check */
  while (isspace((unsigned char) *str))
    str++;
  if (*str == '\0')
    return NULL_EQ_ZERO;
  if (!(isdigit((unsigned char) *str) || *str == '+'))
    return 0;
  errno = 0;
  parse_uival_full(str, &end, 10);
  if (errno == ERANGE || *end != '\0')
    return 0;
  return 1;
}

/* ARGSUSED */
FUNCTION(fun_ctu)
{
  NVAL angle;
  if (!is_number(args[0])) {
    safe_str(T(e_num), buff, bp);
    return;
  }

  if (!args[1] || !args[2]) {
    safe_str(T("#-1 INVALID ANGLE TYPE"), buff, bp);
    return;
  }
  angle = angle_to_rad(parse_number(args[0]), args[1]);
  safe_number(rad_to_angle(angle, args[2]), buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_add)
{
  math_add(args, nargs, buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_sub)
{
  math_sub(args, nargs, buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_mul)
{
  math_mul(args, nargs, buff, bp);
}

/* TO-DO: I have better code for comparing floating-point numbers
   lying around somewhere. The idea is that numbers that are very
   close can be 'close enough' to be equal or whatever, without having
   to be exactly the same. */

/* ARGSUSED */
FUNCTION(fun_gt)
{
  if (!is_number(args[0]) || !is_number(args[1])) {
    safe_str(T(e_nums), buff, bp);
    return;
  }
  safe_boolean(parse_number(args[0]) > parse_number(args[1]), buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_gte)
{
  if (!is_number(args[0]) || !is_number(args[1])) {
    safe_str(T(e_nums), buff, bp);
    return;
  }
  safe_boolean(parse_number(args[0]) >= parse_number(args[1]), buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_lt)
{
  if (!is_number(args[0]) || !is_number(args[1])) {
    safe_str(T(e_nums), buff, bp);
    return;
  }
  safe_boolean(parse_number(args[0]) < parse_number(args[1]), buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_lte)
{
  if (!is_number(args[0]) || !is_number(args[1])) {
    safe_str(T(e_nums), buff, bp);
    return;
  }
  safe_boolean(parse_number(args[0]) <= parse_number(args[1]), buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_eq)
{
  if (!is_number(args[0]) || !is_number(args[1])) {
    safe_str(T(e_nums), buff, bp);
    return;
  }
  safe_boolean(EQ(parse_number(args[0]), parse_number(args[1])), buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_neq)
{
  if (!is_number(args[0]) || !is_number(args[1])) {
    safe_str(T(e_nums), buff, bp);
    return;
  }
  safe_boolean(!EQ(parse_number(args[0]), parse_number(args[1])), buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_max)
{
  math_max(args, nargs, buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_min)
{
  math_min(args, nargs, buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_sign)
{
  NVAL x;

  if (!is_number(args[0])) {
    safe_str(T(e_num), buff, bp);
    return;
  }
  x = parse_number(args[0]);
  if (EQ(x, 0))
    safe_chr('0', buff, bp);
  else if (x > 0)
    safe_chr('1', buff, bp);
  else
    safe_str("-1", buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_shl)
{
  if (!is_uival(args[0]) || !is_uival(args[1])) {
    safe_str(T(e_uints), buff, bp);
    return;
  }
  safe_uinteger(parse_uival(args[0]) << parse_uival(args[1]), buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_shr)
{
  if (!is_uival(args[0]) || !is_uival(args[1])) {
    safe_str(T(e_uints), buff, bp);
    return;
  }
  safe_uinteger(parse_uival(args[0]) >> parse_uival(args[1]), buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_inc)
{
  int num;
  char *p;
  /* Handle the case of a pure number */
  if (is_strict_integer(args[0])) {
    safe_integer(parse_integer(args[0]) + 1, buff, bp);
    return;
  }
  /* Handle a null string */
  if (!*args[0]) {
    safe_str(NULL_EQ_ZERO ? "1" : T("#-1 ARGUMENT MUST END IN AN INTEGER"),
             buff, bp);
    return;
  }
  p = args[0] + arglens[0] - 1;
  if (!isdigit((unsigned char) *p)) {
    if (NULL_EQ_ZERO) {
      safe_str(args[0], buff, bp);
      safe_str("1", buff, bp);
    } else
      safe_str(T("#-1 ARGUMENT MUST END IN AN INTEGER"), buff, bp);
    return;
  }
  while ((isdigit((unsigned char) *p) || (*p == '-')) && p != args[0]) {
    if (*p == '-') {
      p--;
      break;
    }
    p--;
  }
  /* p now points to the last non-numeric character in the string */
  if (p == args[0] && (isdigit((unsigned char) *p) || (*p == '-'))) {
    /* Special case - it's all digits, but out of range. */
    safe_str(T(e_range), buff, bp);
    return;
  }

  /* Move it to the first numeric character */
  p++;
  num = parse_integer(p) + 1;
  *p = '\0';
  safe_str(args[0], buff, bp);
  safe_integer(num, buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_dec)
{
  int num;
  char *p;
  /* Handle the case of a pure number */
  if (is_strict_integer(args[0])) {
    safe_integer(parse_integer(args[0]) - 1, buff, bp);
    return;
  }
  /* Handle a null string */
  if (!*args[0]) {
    safe_str(NULL_EQ_ZERO ? "-1" : T("#-1 ARGUMENT MUST END IN AN INTEGER"),
             buff, bp);
    return;
  }
  p = args[0] + arglens[0] - 1;
  if (!isdigit((unsigned char) *p)) {
    if (NULL_EQ_ZERO) {
      safe_str(args[0], buff, bp);
      safe_str("-1", buff, bp);
    } else
      safe_str(T("#-1 ARGUMENT MUST END IN AN INTEGER"), buff, bp);
    return;
  }
  while ((isdigit((unsigned char) *p) || (*p == '-')) && p != args[0]) {
    if (*p == '-') {
      p--;
      break;
    }
    p--;
  }
  /* p now points to the last non-numeric character in the string */
  if (p == args[0] && (isdigit((unsigned char) *p) || (*p == '-'))) {
    /* Special case - it's all digits, but out of range. */
    safe_str(T(e_range), buff, bp);
    return;
  }
  /* Move it to the first numeric character */
  p++;
  num = parse_integer(p) - 1;
  *p = '\0';
  safe_str(args[0], buff, bp);
  safe_integer(num, buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_trunc)
{
  /* This function does not have the non-number check because
   * the help file explicitly states that this function can
   * be used to turn "101dalmations" into "101".
   */
  safe_integer(parse_integer(args[0]), buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_div)
{
  math_div(args, nargs, buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_floordiv)
{
  math_floordiv(args, nargs, buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_modulo)
{
  math_modulo(args, nargs, buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_remainder)
{
  math_remainder(args, nargs, buff, bp);
}


/* ARGSUSED */
FUNCTION(fun_abs)
{
  if (!is_number(args[0])) {
    safe_str(T(e_num), buff, bp);
    return;
  }
  safe_number(fabs(parse_number(args[0])), buff, bp);
}

/* ARGSUSED */
FUNCTION(fun_dist2d)
{
  math_dist2d(args, nargs, buff, bp);
}

FUNCTION(fun_dist3d)
{
  math_dist3d(args, nargs, buff, bp);
}

/* ------------------------------------------------------------------------
 * Dune's vector functions: VADD, VSUB, VMUL, VCROSS, VMAG, VUNIT, VDIM
 *  VCRAMER?
 * Vectors are space-separated numbers.
 */

/* ARGSUSED */
FUNCTION(fun_vmax)
{
  char *p1, *p2;
  char *start;
  char sep;
  NVAL a, b;

  /* return if a list is empty */
  if (!args[0] || !args[1]) {
    safe_str(T("#-1 VECTORS MUST BE SAME DIMENSIONS"), buff, bp);
    return;
  }

  if (!delim_check(buff, bp, nargs, args, 3, &sep))
    return;
  p1 = trim_space_sep(args[0], sep);
  p2 = trim_space_sep(args[1], sep);

  /* return if a list is empty */
  if (!*p1 || !*p2) {
    safe_str(T("#-1 VECTORS MUST BE SAME DIMENSIONS"), buff, bp);
    return;
  }

  /* max the vectors */
  start = *bp;
  a = parse_number(split_token(&p1, sep));
  b = parse_number(split_token(&p2, sep));
  safe_number((a > b) ? a : b, buff, bp);

  while (p1 && p2) {
    safe_chr(sep, buff, bp);
    a = parse_number(split_token(&p1, sep));
    b = parse_number(split_token(&p2, sep));
    safe_number((a > b) ? a : b, buff, bp);
  }

  /* make sure vectors were the same length */
  if (p1 || p2) {
    *bp = start;
    safe_str(T("#-1 VECTORS MUST BE SAME DIMENSIONS"), buff, bp);
    return;
  }
}

/* ARGSUSED */
FUNCTION(fun_vmin)
{
  char *p1, *p2;
  char *start;
  char sep;
  NVAL a, b;

  /* return if a list is empty */
  if (!args[0] || !args[1]) {
    safe_str(T("#-1 VECTORS MUST BE SAME DIMENSIONS"), buff, bp);
    return;
  }

  if (!delim_check(buff, bp, nargs, args, 3, &sep))
    return;
  p1 = trim_space_sep(args[0], sep);
  p2 = trim_space_sep(args[1], sep);

  /* return if a list is empty */
  if (!*p1 || !*p2)
    return;

  /* max the vectors */
  start = *bp;
  a = parse_number(split_token(&p1, sep));
  b = parse_number(split_token(&p2, sep));
  safe_number((a < b) ? a : b, buff, bp);

  while (p1 && p2) {
    safe_chr(sep, buff, bp);
    a = parse_number(split_token(&p1, sep));
    b = parse_number(split_token(&p2, sep));
    safe_number((a < b) ? a : b, buff, bp);
  }

  /* make sure vectors were the same length */
  if (p1 || p2) {
    *bp = start;
    safe_str(T("#-1 VECTORS MUST BE SAME DIMENSIONS"), buff, bp);
    return;
  }
}


/* ARGSUSED */
FUNCTION(fun_vadd)
{
  char *p1, *p2;
  char *start;
  char sep;

  /* return if a list is empty */
  if (!args[0] || !args[1]) {
    safe_str(T("#-1 VECTORS MUST BE SAME DIMENSIONS"), buff, bp);
    return;
  }

  if (!delim_check(buff, bp, nargs, args, 3, &sep))
    return;
  p1 = trim_space_sep(args[0], sep);
  p2 = trim_space_sep(args[1], sep);

  /* return if a list is empty */
  if (!*p1 || !*p2)