]>
Commit | Line | Data |
---|---|---|
6a5fa4e0 MG |
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 | } |