home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tclX6.5c / src / tclXmath.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-12-19  |  5.1 KB  |  201 lines
  1. /*
  2.  * tclXmath.c --
  3.  *
  4.  * Mathematical Tcl commands.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1992 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 2.0 1992/10/16 04:50:59 markd Rel $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. extern int rand();
  22.  
  23. /*
  24.  * Prototypes of internal functions.
  25.  */
  26. int 
  27. really_random _ANSI_ARGS_((int my_range));
  28.  
  29.  
  30. /*
  31.  *-----------------------------------------------------------------------------
  32.  *
  33.  * Tcl_MaxCmd --
  34.  *      Implements the TCL max command:
  35.  *        max num1 num2 [..numN]
  36.  *
  37.  * Results:
  38.  *      Standard TCL results.
  39.  *
  40.  *-----------------------------------------------------------------------------
  41.  */
  42. int
  43. Tcl_MaxCmd (clientData, interp, argc, argv)
  44.     ClientData  clientData;
  45.     Tcl_Interp *interp;
  46.     int         argc;
  47.     char      **argv;
  48. {
  49.     double value, maxValue = -MAXDOUBLE;
  50.     int    idx,   maxIdx   =  1;
  51.  
  52.  
  53.     if (argc < 3) {
  54.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  55.                           " num1 num2 [..numN]", (char *) NULL);
  56.         return TCL_ERROR;
  57.     }
  58.  
  59.     for (idx = 1; idx < argc; idx++) {
  60.         if (Tcl_GetDouble (interp, argv [idx], &value) != TCL_OK)
  61.             return TCL_ERROR;
  62.         if (value > maxValue) {
  63.             maxValue = value;
  64.             maxIdx = idx;
  65.         }
  66.     }
  67.     strcpy (interp->result, argv [maxIdx]);
  68.     return TCL_OK;
  69. }
  70.  
  71. /*
  72.  *-----------------------------------------------------------------------------
  73.  *
  74.  * Tcl_MinCmd --
  75.  *     Implements the TCL min command:
  76.  *         min num1 num2 [..numN]
  77.  *
  78.  * Results:
  79.  *      Standard TCL results.
  80.  *
  81.  *-----------------------------------------------------------------------------
  82.  */
  83. int
  84. Tcl_MinCmd (clientData, interp, argc, argv)
  85.     ClientData  clientData;
  86.     Tcl_Interp *interp;
  87.     int     argc;
  88.     char      **argv;
  89. {
  90.     double value, minValue = MAXDOUBLE;
  91.     int    idx,   minIdx   = 1;
  92.  
  93.     if (argc < 3) {
  94.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  95.                           " num1 num2 [..numN]", (char *) NULL);
  96.         return TCL_ERROR;
  97.     }
  98.  
  99.     for (idx = 1; idx < argc; idx++) {
  100.         if (Tcl_GetDouble (interp, argv [idx], &value) != TCL_OK)
  101.             return TCL_ERROR;
  102.         if (value < minValue) {
  103.             minValue = value;
  104.             minIdx = idx;
  105.             }
  106.         }
  107.     strcpy (interp->result, argv [minIdx]);
  108.     return TCL_OK;
  109. }
  110.  
  111. /*
  112.  *-----------------------------------------------------------------------------
  113.  *
  114.  * ReallyRandom --
  115.  *     Insure a good random return for a range, unlike an arbitrary
  116.  *     random() % n, thanks to Ken Arnold, Unix Review, October 1987.
  117.  *
  118.  *-----------------------------------------------------------------------------
  119.  */
  120. #ifdef TCL_32_BIT_RANDOM
  121. #    define RANDOM_RANGE ((1 << 31) - 1)
  122. #else
  123. #    define RANDOM_RANGE ((1 << 15) - 1)
  124. #endif
  125.  
  126. static int 
  127.  
  128. ReallyRandom (myRange)
  129.     int myRange;
  130. {
  131.     int maxMultiple, rnum;
  132.  
  133.     maxMultiple = RANDOM_RANGE / myRange;
  134.     maxMultiple *= myRange;
  135.     while ((rnum = rand()) >= maxMultiple)
  136.         continue;
  137.     return (rnum % myRange);
  138. }
  139.  
  140. /*
  141.  *-----------------------------------------------------------------------------
  142.  *
  143.  * Tcl_RandomCmd  --
  144.  *     Implements the TCL random command:
  145.  *     random limit
  146.  *
  147.  * Results:
  148.  *  Standard TCL results.
  149.  *
  150.  *-----------------------------------------------------------------------------
  151.  */
  152. int
  153. Tcl_RandomCmd (clientData, interp, argc, argv)
  154.     ClientData  clientData;
  155.     Tcl_Interp *interp;
  156.     int         argc;
  157.     char      **argv;
  158. {
  159.     unsigned range;
  160.  
  161.     if ((argc < 2) || (argc > 3))
  162.         goto invalidArgs;
  163.  
  164.     if (STREQU (argv [1], "seed")) {
  165.         long seed;
  166.  
  167.         if (argc == 3) {
  168.             if (Tcl_GetLong (interp, argv[2], &seed) != TCL_OK)
  169.                 return TCL_ERROR;
  170.         } else
  171.             seed = (unsigned) (getpid() + time((time_t *)NULL));
  172.  
  173.         srand(seed);
  174.  
  175.     } else {
  176.         if (argc != 2)
  177.             goto invalidArgs;
  178.         if (Tcl_GetUnsigned (interp, argv[1], &range) != TCL_OK)
  179.             return TCL_ERROR;
  180.         if ((range == 0) || (range > RANDOM_RANGE))
  181.             goto outOfRange;
  182.  
  183.         sprintf (interp->result, "%d", ReallyRandom (range));
  184.     }
  185.     return TCL_OK;
  186.  
  187. invalidArgs:
  188.     Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  189.                       " limit | seed [seedval]", (char *) NULL);
  190.     return TCL_ERROR;
  191. outOfRange:
  192.     {
  193.         char buf [18];
  194.  
  195.         sprintf (buf, "%d", RANDOM_RANGE);
  196.         Tcl_AppendResult (interp, "range must be > 0 and <= ",
  197.                           buf, (char *) NULL);
  198.         return TCL_ERROR;
  199.     }
  200. }
  201.