home *** CD-ROM | disk | FTP | other *** search
/ Serving the Web / ServingTheWeb1995.disc1of1.iso / linux / slacksrce / tcl / tcl+tk+t / tclx7.3bl / tclx7 / tclX7.3b / src / tclXmath.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-07-16  |  5.2 KB  |  202 lines
  1. /*
  2.  * tclXmath.c --
  3.  *
  4.  * Mathematical Tcl commands.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1991-1994 Karl Lehenbauer and Mark Diekhans.
  7.  *
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11.  * Mark Diekhans make no representations about the suitability of this
  12.  * software for any purpose.  It is provided "as is" without express or
  13.  * implied warranty.
  14.  *-----------------------------------------------------------------------------
  15.  * $Id: tclXmath.c,v 4.0 1994/07/16 05:27:24 markd Rel $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. /*
  22.  * Define return of random function unless stdlib does it.  If we are using
  23.  * out own version, make sure to define it.
  24.  */
  25. #if defined(NO_RANDOM) || !defined(STDLIB_DEFS_RANDOM)
  26. long random ();
  27. #endif
  28.  
  29. /*
  30.  * Prototypes of internal functions.
  31.  */
  32. static long 
  33. ReallyRandom _ANSI_ARGS_((long my_range));
  34.  
  35.  
  36. /*
  37.  *-----------------------------------------------------------------------------
  38.  *
  39.  * Tcl_MaxCmd --
  40.  *      Implements the TCL max command:
  41.  *        max num1 num2 ?..numN?
  42.  *
  43.  * Results:
  44.  *      Standard TCL results.
  45.  *
  46.  *-----------------------------------------------------------------------------
  47.  */
  48. int
  49. Tcl_MaxCmd (clientData, interp, argc, argv)
  50.     ClientData  clientData;
  51.     Tcl_Interp *interp;
  52.     int         argc;
  53.     char      **argv;
  54. {
  55.     double value, maxValue = -MAXDOUBLE;
  56.     int    idx,   maxIdx   =  1;
  57.  
  58.  
  59.     if (argc < 3) {
  60.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  61.                           " num1 num2 ?..numN?", (char *) NULL);
  62.         return TCL_ERROR;
  63.     }
  64.  
  65.     for (idx = 1; idx < argc; idx++) {
  66.         if (Tcl_GetDouble (interp, argv [idx], &value) != TCL_OK)
  67.             return TCL_ERROR;
  68.         if (value > maxValue) {
  69.             maxValue = value;
  70.             maxIdx = idx;
  71.         }
  72.     }
  73.     strcpy (interp->result, argv [maxIdx]);
  74.     return TCL_OK;
  75. }
  76.  
  77. /*
  78.  *-----------------------------------------------------------------------------
  79.  *
  80.  * Tcl_MinCmd --
  81.  *     Implements the TCL min command:
  82.  *         min num1 num2 ?..numN?
  83.  *
  84.  * Results:
  85.  *      Standard TCL results.
  86.  *
  87.  *-----------------------------------------------------------------------------
  88.  */
  89. int
  90. Tcl_MinCmd (clientData, interp, argc, argv)
  91.     ClientData  clientData;
  92.     Tcl_Interp *interp;
  93.     int     argc;
  94.     char      **argv;
  95. {
  96.     double value, minValue = MAXDOUBLE;
  97.     int    idx,   minIdx   = 1;
  98.  
  99.     if (argc < 3) {
  100.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  101.                           " num1 num2 ?..numN?", (char *) NULL);
  102.         return TCL_ERROR;
  103.     }
  104.  
  105.     for (idx = 1; idx < argc; idx++) {
  106.         if (Tcl_GetDouble (interp, argv [idx], &value) != TCL_OK)
  107.             return TCL_ERROR;
  108.         if (value < minValue) {
  109.             minValue = value;
  110.             minIdx = idx;
  111.             }
  112.         }
  113.     strcpy (interp->result, argv [minIdx]);
  114.     return TCL_OK;
  115. }
  116.  
  117. /*
  118.  *-----------------------------------------------------------------------------
  119.  *
  120.  * ReallyRandom --
  121.  *     Insure a good random return for a range, unlike an arbitrary
  122.  *     random() % n, thanks to Ken Arnold, Unix Review, October 1987.
  123.  *
  124.  *-----------------------------------------------------------------------------
  125.  */
  126. #define RANDOM_RANGE 0x7fffffffL
  127.  
  128. static long 
  129. ReallyRandom (myRange)
  130.     long myRange;
  131. {
  132.     long maxMultiple, rnum;
  133.  
  134.     maxMultiple = RANDOM_RANGE / myRange;
  135.     maxMultiple *= myRange;
  136.     while ((rnum = random ()) >= maxMultiple)
  137.         continue;
  138.     return (rnum % myRange);
  139. }
  140.  
  141. /*
  142.  *-----------------------------------------------------------------------------
  143.  *
  144.  * Tcl_RandomCmd  --
  145.  *     Implements the TCL random command:
  146.  *     random limit | seed ?seedval?
  147.  *
  148.  * Results:
  149.  *  Standard TCL results.
  150.  *
  151.  *-----------------------------------------------------------------------------
  152.  */
  153. int
  154. Tcl_RandomCmd (clientData, interp, argc, argv)
  155.     ClientData  clientData;
  156.     Tcl_Interp *interp;
  157.     int         argc;
  158.     char      **argv;
  159. {
  160.     long range;
  161.  
  162.     if ((argc < 2) || (argc > 3))
  163.         goto invalidArgs;
  164.  
  165.     if (STREQU (argv [1], "seed")) {
  166.         unsigned seed;
  167.  
  168.         if (argc == 3) {
  169.             if (Tcl_GetUnsigned (interp, argv[2], &seed) != TCL_OK)
  170.                 return TCL_ERROR;
  171.         } else
  172.             seed = (unsigned) (getpid() + time((time_t *)NULL));
  173.  
  174.         srandom (seed);
  175.  
  176.     } else {
  177.         if (argc != 2)
  178.             goto invalidArgs;
  179.         if (Tcl_GetLong (interp, argv[1], &range) != TCL_OK)
  180.             return TCL_ERROR;
  181.         if ((range <= 0) || (range > RANDOM_RANGE))
  182.             goto outOfRange;
  183.  
  184.         sprintf (interp->result, "%ld", ReallyRandom (range));
  185.     }
  186.     return TCL_OK;
  187.  
  188. invalidArgs:
  189.     Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  190.                       " limit | seed ?seedval?", (char *) NULL);
  191.     return TCL_ERROR;
  192. outOfRange:
  193.     {
  194.         char buf [18];
  195.  
  196.         sprintf (buf, "%ld", RANDOM_RANGE);
  197.         Tcl_AppendResult (interp, "range must be > 0 and <= ",
  198.                           buf, (char *) NULL);
  199.         return TCL_ERROR;
  200.     }
  201. }
  202.