git.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 "tclxint.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 \f
  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 \f
  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 \f
 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 0x7FFFFFFF
 122 #else
 123 #    define RANDOM_RANGE 0x7FFF
 124 #endif
 125
 126 static int
 127
 128 ReallyRandom (myRange)
 129     int myRange;
 130 {
 131     int maxMultiple, rnum;
 132
 133     maxMultiple =
 134         (int)(
 135             RANDOM_RANGE /
 136             myRange);
 137     maxMultiple *=
 138         myRange;
 139
 140     while ((rnum = rand()) >= maxMultiple) {
 141         continue;
 142     }
 143
 144     return (rnum % myRange);
 145 }
 146 \f
 147 /*
 148  *-----------------------------------------------------------------------------
 149  *
 150  * Tcl_RandomCmd  --
 151  *     Implements the TCL random command:
 152  *     random limit
 153  *
 154  * Results:
 155  *  Standard TCL results.
 156  *
 157  *-----------------------------------------------------------------------------
 158  */
 159 int
 160 Tcl_RandomCmd (clientData, interp, argc, argv)
 161     ClientData  clientData;
 162     Tcl_Interp *interp;
 163     int         argc;
 164     char      **argv;
 165 {
 166     unsigned range;
 167
 168     if ((argc < 2) || (argc > 3))
 169         goto invalidArgs;
 170
 171     if (STREQU (argv [1], "seed")) {
 172         long seed;
 173
 174         if (argc == 3) {
 175             if (Tcl_GetLong (interp, argv[2], &seed) != TCL_OK)
 176                 return TCL_ERROR;
 177         } else
 178             seed = (unsigned) (getpid() + time((time_t *)NULL));
 179
 180         srand(seed);
 181
 182     } else {
 183         if (argc != 2)
 184             goto invalidArgs;
 185         if (Tcl_GetUnsigned (interp, argv[1], &range) != TCL_OK)
 186             return TCL_ERROR;
 187         if ((range == 0) || (range > (int)RANDOM_RANGE))
 188             goto outOfRange;
 189
 190         sprintf (interp->result, "%d", ReallyRandom (range));
 191     }
 192     return TCL_OK;
 193
 194 invalidArgs:
 195     Tcl_AppendResult (interp, tclXWrongArgs, argv [0],
 196                       " limit | seed [seedval]", (char *) NULL);
 197     return TCL_ERROR;
 198 outOfRange:
 199     {
 200         char buf [18];
 201
 202         sprintf (buf, "%d", (int)RANDOM_RANGE);
 203         Tcl_AppendResult (interp, "range must be > 0 and <= ",
 204                           buf, (char *) NULL);
 205         return TCL_ERROR;
 206     }
 207 }