#if !NO_SCCS_STRINGS
static char sccs_fact_c[] = "@(#)fact.c	128.1 1/20/93 19:38:48";
#endif /* NO_SCCS_STRINGS */
/***********************************************************************\

   (c) Copyright 1991 by Lotus Development Corporation
   All Rights Reserved

   Module:  fact.c

   Description:   Custom @function that returns factorial.

\************************************************************************/

#define LPI_MAIN_MODULE      /* identify this module as the primary one */ 

#define USE_REGISTER     /* incorporate routines to register @functions */

#include "lpixport.h"           /* incorporate Lotus header information */
#include "math.h"            /* include math library for floor function */

#define FACTORIAL_NAME "factorial"          /* name of add-in @function */
#define MAX_FACTORIAL   70                   /* largest factorial value */

/************************************************************************\

The following function, factorial, returns the product of the intergral
values between 1 and the input value.  The function returns ERR for
negative input.  By definition, 0! = 1.  Note that 1-2-3 cannot display
values larger than 70!.  1-2-3 fills the cell with asterisks if the
value is too large to display.  1-2-3 returns ERR if the value exceeds
a system-dependent maximum.

\************************************************************************/

lsshort factorial(RegContext, arg_count, LpiContext)
   LpiRegContextType RegContext;       /* required registration context */
   lushort arg_count;                      /* number of input arguments */
   lptr(CONTEXT) LpiContext;                        /* required context */
{

   lfloat8 theResult;                                   /* result value */
   lsshort retval;                                       /* return code */
   lushort i;                                  /* loop counter variable */
   lfloat8 theInput;                                     /* input value */
   lslong theInteger;                               /* input as integer */

   /*
      Get the input value as a float and, if sussessful, convert the
      value to an integer.  This sequence truncates the original input.
      If we specify that we want to accept an integer directly, 1-2-3
      performs rounding.  For example, if we enter @FACTORIAL(4.6), 1-2-3
      provides the value 5 to our function as input.  
   */

   retval = LpiRegGetArgNumFloat(0,&theInput);       /* get input float */
   if (retval != LPI_SUCCESS) return retval;      /* confirm you got it */
   theInteger = floor(theInput);    /* truncate input to avoid rounding */
   
   /*
      If the input is negative, we simply set the return type to ERR.
      If the input is positive, we initialize the result to 1 and
      accumulate the product of the integral values between 2 and the
      input value.  We start at 2 because multiplying by 1 has no effect.
   */

   if (theInteger <= MAX_FACTORIAL && theInteger >= 0)
   {
      theResult = 1.0;     
      for (i = 2; i <= theInteger; i++)
      {                               
         theResult *= i;              
      }
      /* identify the return type and set the return value */
      LpiRegAtSetRetType(LPI_T_REG_AT_TYPE_NUM_FLOAT);       
      * ( (lptr(lfloat8))LpiRegAtAccessRetData ()) = theResult; 
   }
   else
   {
      LpiRegAtSetRetType(LPI_T_REG_AT_TYPE_ERR);    
   }

   return LPI_SUCCESS;                            /* signal no problems */
}

/************************************************************************\

   The following function, LpiBind, is called when 1-2-3 loads our add-in.
   In this function we load the Register module and register our @function.
   Use this function to perform any setup, such as allocating memory,
   opening files, etc.

\************************************************************************/

LpiBind(fact_b)
{
   lsshort retval;                              /* function return code */
   lushort arg_types[1];          /* array of argument types, one entry */
                  
   arg_types[0] = LPI_T_ARG_TYPE_NUM;   /* first and only arg is number */

   LPI_SETUP_LOAD;      /* required before loading zero or more modules */

   if (LPI_LOAD_REGISTER != LPI_SUCCESS)        /* load Register module */
      LpiSignal (LPI_FAILURE);

   retval = LpiRegAtfunc(
      FACTORIAL_NAME,              /* @function name in a #define above */
      factorial,          /* name of function that implements @function */
      1,                                   /* number of input arguments */
      arg_types,                       /* array of input argument types */ 
      LNULL,                                    /* registration context */
      LPI_T_REG_AT_NO_FLAGS,         /* no special registration options */
      LPI_T_REG_AT_TYPE_NUM_FLOAT |          /* returns number or error */
      LPI_T_REG_AT_TYPE_ERR);  

   /* if registration fails, indicate an error */
   if (retval != LPI_SUCCESS) LpiSignal (LPI_FAILURE); 

   LpiSignal (LPI_SUCCESS);             /* otherwise indicate no errors */
}

/************************************************************************\

   The following function, LpiUnbind, is called when 1-2-3 unloads our
   add-in.  This function simply executes the macro LPI_UNBIND and
   signals no errors.  Use this function to perform any cleanup, such as
   deallocating memory you allocated in LpiBind, closing opened files, etc.

   Note: You do not have to explicitly unregister an @function.  When you
   unload the add-in that defines the function, 1-2-3 automatically
   unregisters any @functions the add-in defined.  If you attempt to enter
   an @function that has not yet been registered, 1-2-3 beeps. All existing
   formulas that contain add-in @functions that are currently unregistered
   resolve to ERR.  The @functions will resolve properly the next time the
   add-in registers the @function.

/************************************************************************/

LpiUnbind(fact_u)
{
   LPI_UNLOAD;                                    /* macro for cleanup */

   LpiSignal(LPI_SUCCESS);                        /* indicate no errors */
}


