cvs.zerfleddert.de Git - micropolis/blob - src/tclx/src/tclxmath.c

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