line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Physics::Unit; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
14737
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
45
|
|
4
|
2
|
|
|
2
|
|
6
|
use warnings; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
39
|
|
5
|
2
|
|
|
2
|
|
5
|
use Carp; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
123
|
|
6
|
2
|
|
|
2
|
|
8
|
use base qw(Exporter); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
162
|
|
7
|
2
|
|
|
|
|
7300
|
use vars qw( |
8
|
|
|
|
|
|
|
$VERSION |
9
|
|
|
|
|
|
|
@EXPORT_OK |
10
|
|
|
|
|
|
|
%EXPORT_TAGS |
11
|
|
|
|
|
|
|
$debug |
12
|
|
|
|
|
|
|
$number_re |
13
|
2
|
|
|
2
|
|
7
|
); |
|
2
|
|
|
|
|
1
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
$VERSION = '0.54'; |
16
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
@EXPORT_OK = qw( |
19
|
|
|
|
|
|
|
$number_re |
20
|
|
|
|
|
|
|
GetTypeUnit |
21
|
|
|
|
|
|
|
GetUnit |
22
|
|
|
|
|
|
|
InitBaseUnit |
23
|
|
|
|
|
|
|
InitPrefix |
24
|
|
|
|
|
|
|
InitTypes |
25
|
|
|
|
|
|
|
InitUnit |
26
|
|
|
|
|
|
|
ListTypes |
27
|
|
|
|
|
|
|
ListUnits |
28
|
|
|
|
|
|
|
NumBases |
29
|
|
|
|
|
|
|
DeleteNames |
30
|
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
%EXPORT_TAGS = ('ALL' => \@EXPORT_OK); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# This is the regular expression used to parse out a number. It |
35
|
|
|
|
|
|
|
# is here so that other modules can use it for convenience. |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
$number_re = '([-+]?((\d+\.?\d*)|(\.\d+))([eE][-+]?((\d+\.?\d*)|(\.\d+)))?)'; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# The value of this hash is a string representing the token returned |
40
|
|
|
|
|
|
|
# when this word is seen |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
my %reserved_word = ( |
43
|
|
|
|
|
|
|
per => 'divide', |
44
|
|
|
|
|
|
|
square => 'square', |
45
|
|
|
|
|
|
|
sq => 'square', |
46
|
|
|
|
|
|
|
cubic => 'cubic', |
47
|
|
|
|
|
|
|
squared => 'squared', |
48
|
|
|
|
|
|
|
cubed => 'cubed', |
49
|
|
|
|
|
|
|
); |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# Pre-defined units |
52
|
|
|
|
|
|
|
my %unit_by_name; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# Values are references to units representing the prefix |
55
|
|
|
|
|
|
|
my %prefix; |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# Known quantity types. The values of this hash are references to |
58
|
|
|
|
|
|
|
# unit objects that exemplify these types |
59
|
|
|
|
|
|
|
my %prototype; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# The number of base units |
62
|
|
|
|
|
|
|
my $NumBases = 0; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# The names of the base units |
65
|
|
|
|
|
|
|
my @BaseName; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
InitBaseUnit ( |
68
|
|
|
|
|
|
|
'Distance' => ['meter', 'm', 'meters', 'metre', 'metres'], |
69
|
|
|
|
|
|
|
'Mass' => ['gram', 'gm', 'grams'], |
70
|
|
|
|
|
|
|
'Time' => ['second', 's', 'sec', 'secs', 'seconds'], |
71
|
|
|
|
|
|
|
'Temperature' => ['kelvin', 'k', 'kelvins', |
72
|
|
|
|
|
|
|
'degree-kelvin', 'degrees-kelvin', 'degree-kelvins'], |
73
|
|
|
|
|
|
|
'Current' => ['ampere', 'amp', 'amps', 'amperes'], |
74
|
|
|
|
|
|
|
'Substance' => ['mole', 'mol', 'moles'], |
75
|
|
|
|
|
|
|
'Luminosity' => ['candela', 'cd', 'candelas', 'candle', 'candles'], |
76
|
|
|
|
|
|
|
'Money' => ['us-dollar', 'dollar', 'dollars', 'us-dollars', '$'], |
77
|
|
|
|
|
|
|
'Data' => ['bit', 'bits'], |
78
|
|
|
|
|
|
|
); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
InitPrefix ( |
81
|
|
|
|
|
|
|
'deka', 1e1, |
82
|
|
|
|
|
|
|
'deca', 1e1, |
83
|
|
|
|
|
|
|
'hecto', 1e2, |
84
|
|
|
|
|
|
|
'kilo', 1e3, |
85
|
|
|
|
|
|
|
'mega', 1e6, |
86
|
|
|
|
|
|
|
'giga', 1e9, |
87
|
|
|
|
|
|
|
'tera', 1e12, |
88
|
|
|
|
|
|
|
'peta', 1e15, |
89
|
|
|
|
|
|
|
'exa', 1e18, |
90
|
|
|
|
|
|
|
'zetta', 1e21, |
91
|
|
|
|
|
|
|
'yotta', 1e24, |
92
|
|
|
|
|
|
|
'deci', 1e-1, |
93
|
|
|
|
|
|
|
'centi', 1e-2, |
94
|
|
|
|
|
|
|
'milli', 1e-3, |
95
|
|
|
|
|
|
|
'micro', 1e-6, |
96
|
|
|
|
|
|
|
'nano', 1e-9, |
97
|
|
|
|
|
|
|
'pico', 1e-12, |
98
|
|
|
|
|
|
|
'femto', 1e-15, |
99
|
|
|
|
|
|
|
'atto', 1e-18, |
100
|
|
|
|
|
|
|
'zepto', 1e-21, |
101
|
|
|
|
|
|
|
'yocto', 1e-24, |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# binary prefixes |
104
|
|
|
|
|
|
|
'kibi', 2**10, |
105
|
|
|
|
|
|
|
'mebi', 2**20, |
106
|
|
|
|
|
|
|
'gibi', 2**30, |
107
|
|
|
|
|
|
|
'tebi', 2**40, |
108
|
|
|
|
|
|
|
'pebi', 2**50, |
109
|
|
|
|
|
|
|
'exbi', 2**60, |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# others |
112
|
|
|
|
|
|
|
'semi', 0.5, |
113
|
|
|
|
|
|
|
'demi', 0.5, |
114
|
|
|
|
|
|
|
); |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
InitUnit ( |
118
|
|
|
|
|
|
|
# Dimensionless |
119
|
|
|
|
|
|
|
['pi',], '3.1415926535897932385', |
120
|
|
|
|
|
|
|
['e',], '2.7182818284590452354', |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
['unity', 'one', 'ones',], '1', |
123
|
|
|
|
|
|
|
['two', 'twos',], '2', |
124
|
|
|
|
|
|
|
['three', 'threes',], '3', |
125
|
|
|
|
|
|
|
['four', 'fours',], '4', |
126
|
|
|
|
|
|
|
['five', 'fives',], '5', |
127
|
|
|
|
|
|
|
['six', 'sixes',], '6', |
128
|
|
|
|
|
|
|
['seven', 'sevens',], '7', |
129
|
|
|
|
|
|
|
['eight', 'eights',], '8', |
130
|
|
|
|
|
|
|
['nine', 'nines'], '9', |
131
|
|
|
|
|
|
|
['ten', 'tens',], '10', |
132
|
|
|
|
|
|
|
['eleven', 'elevens',], '11', |
133
|
|
|
|
|
|
|
['twelve', 'twelves',], '12', |
134
|
|
|
|
|
|
|
['thirteen', 'thirteens',], '13', |
135
|
|
|
|
|
|
|
['fourteen', 'fourteens',], '14', |
136
|
|
|
|
|
|
|
['fifteen', 'fifteens',], '15', |
137
|
|
|
|
|
|
|
['sixteen', 'sixteens',], '16', |
138
|
|
|
|
|
|
|
['seventeen', 'seventeens',], '17', |
139
|
|
|
|
|
|
|
['eighteen', 'eighteens',], '18', |
140
|
|
|
|
|
|
|
['nineteen', 'nineteens',], '19', |
141
|
|
|
|
|
|
|
['twenty', 'twenties',], '20', |
142
|
|
|
|
|
|
|
['thirty', 'thirties',], '30', |
143
|
|
|
|
|
|
|
['forty', 'forties',], '40', |
144
|
|
|
|
|
|
|
['fifty', 'fifties',], '50', |
145
|
|
|
|
|
|
|
['sixty', 'sixties',], '60', |
146
|
|
|
|
|
|
|
['seventy', 'seventies',], '70', |
147
|
|
|
|
|
|
|
['eighty', 'eighties',], '80', |
148
|
|
|
|
|
|
|
['ninety', 'nineties',], '90', |
149
|
|
|
|
|
|
|
['hundred', 'hundreds'], '100', |
150
|
|
|
|
|
|
|
['thousand', 'thousands'], '1000', |
151
|
|
|
|
|
|
|
['million', 'millions',], '1e6', |
152
|
|
|
|
|
|
|
['billion', 'billions',], '1e9', |
153
|
|
|
|
|
|
|
['trillion', 'trillions',], '1e12', |
154
|
|
|
|
|
|
|
['quadrillion', 'quadrillions',], '1e15', |
155
|
|
|
|
|
|
|
['quintillion', 'quintillions',], '1e18', |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
['half', 'halves',], '0.5', |
158
|
|
|
|
|
|
|
['third', 'thirds',], '1/3', |
159
|
|
|
|
|
|
|
['fourth', 'fourths',], '0.25', |
160
|
|
|
|
|
|
|
['tenth',], '0.1', |
161
|
|
|
|
|
|
|
['hundredth',], '0.01', |
162
|
|
|
|
|
|
|
['thousandth',], '0.001', |
163
|
|
|
|
|
|
|
['millionth',], '1e-6', |
164
|
|
|
|
|
|
|
['billionth',], '1e-9', |
165
|
|
|
|
|
|
|
['trillionth',], '1e-12', |
166
|
|
|
|
|
|
|
['quadrillionth',], '1e-15', |
167
|
|
|
|
|
|
|
['quintillionth',], '1e-18', |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
['percent', '%',], '0.01', |
170
|
|
|
|
|
|
|
['dozen', 'doz',], '12', |
171
|
|
|
|
|
|
|
['gross',], '144', |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# Angular |
174
|
|
|
|
|
|
|
['radian', 'radians',], '1', |
175
|
|
|
|
|
|
|
['steradian', 'sr', 'steradians',], '1', |
176
|
|
|
|
|
|
|
['degree', 'deg', 'degrees',], 'pi radians / 180', |
177
|
|
|
|
|
|
|
['arcminute', 'arcmin', 'arcminutes',], 'deg / 60', |
178
|
|
|
|
|
|
|
['arcsecond', 'arcsec', 'arcseconds',], 'arcmin / 60', |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# Distance |
181
|
|
|
|
|
|
|
['foot', 'ft', 'feet',], '.3048 m', # exact |
182
|
|
|
|
|
|
|
['inch', 'in', 'inches',], 'ft/12', # exact |
183
|
|
|
|
|
|
|
['mil', 'mils',], 'in/1000', # exact |
184
|
|
|
|
|
|
|
['yard', 'yards',], '3 ft', # exact |
185
|
|
|
|
|
|
|
['fathom', 'fathoms',], '2 yards', # exact |
186
|
|
|
|
|
|
|
['rod', 'rods',], '5.5 yards', # exact |
187
|
|
|
|
|
|
|
['pole', 'poles',], '1 rod', # exact |
188
|
|
|
|
|
|
|
['perch', 'perches',], '1 rod', # exact |
189
|
|
|
|
|
|
|
['furlong', 'furlongs',], '40 rods', # exact |
190
|
|
|
|
|
|
|
['mile', 'mi', 'miles',], '5280 ft', # exact |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
['micron', 'microns', 'um',], '1e-6 m', # exact |
193
|
|
|
|
|
|
|
['angstrom', 'a', 'angstroms',], '1e-10 m', # exact |
194
|
|
|
|
|
|
|
['cm',], 'centimeter', # exact |
195
|
|
|
|
|
|
|
['km',], 'kilometer', # exact |
196
|
|
|
|
|
|
|
['nm',], 'nanometer', # exact |
197
|
|
|
|
|
|
|
['mm',], 'millimeter', # exact |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
['pica',], 'in/6', # exact, but see below |
200
|
|
|
|
|
|
|
['point',], 'pica/12', # exact |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
['nautical-mile', 'nmi', 'nauticalmiles', |
203
|
|
|
|
|
|
|
'nauticalmile', 'nautical-miles',], '1852 m', # exact |
204
|
|
|
|
|
|
|
['astronomical-unit', 'au',], '1.49598e11 m', |
205
|
|
|
|
|
|
|
['light-year', 'ly', 'light-years', |
206
|
|
|
|
|
|
|
'lightyear', 'lightyears'], '9.46e15 m', |
207
|
|
|
|
|
|
|
['parsec', 'parsecs',], '3.083e16 m', |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# equatorial radius of the reference geoid: |
210
|
|
|
|
|
|
|
['re'], '6378388 m', # exact |
211
|
|
|
|
|
|
|
# polar radius of the reference geoid: |
212
|
|
|
|
|
|
|
['rp'], '6356912 m', # exact |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
# Acceleration |
215
|
|
|
|
|
|
|
['g0', 'earth-gravity'], '9.80665 m/s^2', # exact |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
# Mass |
218
|
|
|
|
|
|
|
['kg',], 'kilogram', # exact |
219
|
|
|
|
|
|
|
['metric-ton', 'metric-tons', 'tonne', |
220
|
|
|
|
|
|
|
'tonnes'], '1000 kg', # exact |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
['grain', 'grains'], '.0648 gm', |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
['pound-mass', 'lbm', 'lbms', |
225
|
|
|
|
|
|
|
'pounds-mass'], '0.45359237 kg', # exact |
226
|
|
|
|
|
|
|
['ounce', 'oz', 'ounces'], 'lbm/16', # exact |
227
|
|
|
|
|
|
|
['stone', 'stones'], '14 lbm', # exact |
228
|
|
|
|
|
|
|
['hundredweight', 'hundredweights'], '100 lbms', # exact |
229
|
|
|
|
|
|
|
['ton', 'tons', 'short-ton', 'short-tons'], '2000 lbms', # exact |
230
|
|
|
|
|
|
|
['long-ton', 'long-tons'], '2240 lbms', # exact |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
['slug', 'slugs'], 'lbm g0 s^2/ft', # exact |
233
|
|
|
|
|
|
|
['mg',], 'milligram', # exact |
234
|
|
|
|
|
|
|
['ug',], 'microgram', # exact |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
['dram', 'drams'], 'ounce / 16', # exact |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
['troy-pound', 'troy-pounds'], '0.373 kg', |
239
|
|
|
|
|
|
|
['troy-ounce', 'troy-ounces', |
240
|
|
|
|
|
|
|
'ounce-troy', 'ounces-troy'], '31.103 gm', |
241
|
|
|
|
|
|
|
['pennyweight', 'pennyweights'], '1.555 gm', |
242
|
|
|
|
|
|
|
['scruple', 'scruples'], '1.296 gm', |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
['hg',], 'hectogram', # exact |
245
|
|
|
|
|
|
|
['dag',], 'decagram', # exact |
246
|
|
|
|
|
|
|
['dg',], 'decigram', # exact |
247
|
|
|
|
|
|
|
['cg',], 'centigram', # exact |
248
|
|
|
|
|
|
|
['carat', 'carats', 'karat', 'karats',], '200 milligrams', # exact |
249
|
|
|
|
|
|
|
['j-point',], '2 carats', # exact |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
['atomic-mass-unit', 'amu', 'u', |
252
|
|
|
|
|
|
|
'atomic-mass-units'], '1.6605402e-27 kg', |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# Time |
256
|
|
|
|
|
|
|
['minute', 'min', 'mins', 'minutes'], '60 s', |
257
|
|
|
|
|
|
|
['hour', 'hr', 'hrs', 'hours'], '60 min', |
258
|
|
|
|
|
|
|
['day', 'days'], '24 hr', |
259
|
|
|
|
|
|
|
['week', 'wk', 'weeks'], '7 days', |
260
|
|
|
|
|
|
|
['fortnight', 'fortnights'], '2 week', |
261
|
|
|
|
|
|
|
['year', 'yr', 'yrs', 'years'], '365.25 days', |
262
|
|
|
|
|
|
|
['month', 'mon', 'mons', 'months'], 'year / 12', # an average month |
263
|
|
|
|
|
|
|
['score', 'scores'], '20 yr', |
264
|
|
|
|
|
|
|
['century', 'centuries'], '100 yr', |
265
|
|
|
|
|
|
|
['millenium', 'millenia',], '1000 yr', |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
['ms', 'msec', 'msecs'], 'millisecond', |
268
|
|
|
|
|
|
|
['us', 'usec', 'usecs'], 'microsecond', |
269
|
|
|
|
|
|
|
['ns', 'nsec', 'nsecs'], 'nanosecond', |
270
|
|
|
|
|
|
|
['ps', 'psec', 'psecs'], 'picosecond', |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
# Data |
273
|
|
|
|
|
|
|
['byte', 'bytes'], '8 bits', |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
# Frequency |
276
|
|
|
|
|
|
|
['hertz', 'hz'], '1/sec', |
277
|
|
|
|
|
|
|
['becquerel', 'bq'], '1 hz', |
278
|
|
|
|
|
|
|
['revolution', 'revolutions',], '1', |
279
|
|
|
|
|
|
|
['rpm',], 'revolutions per minute', |
280
|
|
|
|
|
|
|
['cycle', 'cycles',], '1', |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
# Current |
283
|
|
|
|
|
|
|
['abampere', 'abamp', 'abamps', 'abamperes'], '10 amps', |
284
|
|
|
|
|
|
|
['statampere', 'statamp', 'statamps', 'statamperes'], '3.336e-10 amps', |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
['ma',], 'milliamp', |
287
|
|
|
|
|
|
|
['ua',], 'microamp', |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# Electric_potential |
290
|
|
|
|
|
|
|
['volt', 'v', 'volts'], 'kg m^2 / amp s^3', |
291
|
|
|
|
|
|
|
['mv',], 'millivolt', |
292
|
|
|
|
|
|
|
['uv',], 'microvolt', |
293
|
|
|
|
|
|
|
['abvolt', 'abvolts'], '1e-8 volt', |
294
|
|
|
|
|
|
|
['statvolt', 'statvolts'], '299.8 volt', |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
# Resistance |
297
|
|
|
|
|
|
|
['ohm', 'ohms'], 'kg m^2 / amp^2 s^3', |
298
|
|
|
|
|
|
|
['abohm', 'abohms'], 'nano ohm', |
299
|
|
|
|
|
|
|
['statohm', 'statohms'], '8.987e11 ohm', |
300
|
|
|
|
|
|
|
['kilohm', 'kilohms',], 'kilo ohm', |
301
|
|
|
|
|
|
|
['megohm', 'megohms'], 'mega ohm', |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
# Conductance |
304
|
|
|
|
|
|
|
['siemens',], 'amp^2 s^3 / kg m^2', |
305
|
|
|
|
|
|
|
['mho', 'mhos'], '1/ohm', |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
# Capacitance |
308
|
|
|
|
|
|
|
['farad', 'f', 'farads'], 'amp^2 s^4 / kg m^2', |
309
|
|
|
|
|
|
|
['abfarad', 'abfarads'], 'giga farad', |
310
|
|
|
|
|
|
|
['statfarad', 'statfarads'], '1.113e-12 farad', |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
['uf',], 'microfarad', |
313
|
|
|
|
|
|
|
['pf',], 'picofarads', |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
# Inductance |
316
|
|
|
|
|
|
|
['henry', 'henrys'], 'kg m^2 / amp^2 s^2', |
317
|
|
|
|
|
|
|
['abhenry', 'abhenrys'], 'nano henry', |
318
|
|
|
|
|
|
|
['stathenry', 'stathenrys'], '8.987e11 henry', |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
['uh',], 'microhenry', |
321
|
|
|
|
|
|
|
['mh',], 'millihenry', |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
# Magnetic_flux |
324
|
|
|
|
|
|
|
['weber', 'wb', 'webers'], 'kg m^2 / amp s^2', |
325
|
|
|
|
|
|
|
['maxwell', 'maxwells'], '1e-8 weber', |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
# Magnetic_field |
328
|
|
|
|
|
|
|
['tesla', 'teslas'], 'kg / amp sec^2', |
329
|
|
|
|
|
|
|
['gauss',], '1e-4 tesla', |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
# Temperature |
332
|
|
|
|
|
|
|
['degree-rankine', 'degrees-rankine'], '5/9 * kelvin', # exact |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# Force |
335
|
|
|
|
|
|
|
['pound', 'lb', 'lbs', 'pounds', |
336
|
|
|
|
|
|
|
'pound-force', 'lbf', |
337
|
|
|
|
|
|
|
'pounds-force', 'pound-weight'], 'slug foot / s^2', # exact |
338
|
|
|
|
|
|
|
['ounce-force', 'ozf'], 'pound-force / 16', # exact |
339
|
|
|
|
|
|
|
['newton', 'nt', 'newtons'], 'kg m / s^2', # exact |
340
|
|
|
|
|
|
|
['dyne', 'dynes'], 'gm cm / s^2', # exact |
341
|
|
|
|
|
|
|
['gram-weight', 'gram-force'], 'gm g0', # exact |
342
|
|
|
|
|
|
|
['kgf',], 'kilo gram-force', # exact |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
# Area |
345
|
|
|
|
|
|
|
['are', 'ares'], '100 square meters', |
346
|
|
|
|
|
|
|
['hectare', 'hectares',], '100 ares', |
347
|
|
|
|
|
|
|
['acre', 'acres'], '43560 square feet', |
348
|
|
|
|
|
|
|
['barn', 'barns'], '1e-28 square meters', |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
# Volume |
351
|
|
|
|
|
|
|
['liter', 'l', 'liters'], 'm^3/1000', # exact |
352
|
|
|
|
|
|
|
['cl',], 'centiliter', # exact |
353
|
|
|
|
|
|
|
['dl',], 'deciliter', # exact |
354
|
|
|
|
|
|
|
['cc', 'ml',], 'cubic centimeter', # exact |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
['gallon', 'gal', 'gallons'], '3.785411784 liter', |
357
|
|
|
|
|
|
|
['quart', 'qt', 'quarts'], 'gallon/4', |
358
|
|
|
|
|
|
|
['peck', 'pecks'], '8 quarts', |
359
|
|
|
|
|
|
|
['bushel', 'bushels'], '4 pecks', |
360
|
|
|
|
|
|
|
['fifth', 'fifths'], 'gallon/5', |
361
|
|
|
|
|
|
|
['pint', 'pt', 'pints'], 'quart/2', |
362
|
|
|
|
|
|
|
['cup', 'cups'], 'pint/2', |
363
|
|
|
|
|
|
|
['fluid-ounce', 'floz', 'fluidounce', |
364
|
|
|
|
|
|
|
'fluidounces', 'fluid-ounces'], 'cup/8', |
365
|
|
|
|
|
|
|
['gill', 'gills'], '4 fluid-ounces', |
366
|
|
|
|
|
|
|
['fluidram', 'fluidrams'], '3.5516 cc', |
367
|
|
|
|
|
|
|
['minim', 'minims'], '0.059194 cc', |
368
|
|
|
|
|
|
|
['tablespoon', 'tbsp', 'tablespoons'], 'fluid-ounce / 2', |
369
|
|
|
|
|
|
|
['teaspoon', 'tsp', 'teaspoons'], 'tablespoon / 3', |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
# Power |
372
|
|
|
|
|
|
|
['watt', 'w', 'watts'], 'kg m^2 / s^3', |
373
|
|
|
|
|
|
|
['horsepower', 'hp'], '550 foot pound-force / s', |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# Energy |
376
|
|
|
|
|
|
|
['joule', 'j', 'joules'], 'kg m^2 / s^2', # exact |
377
|
|
|
|
|
|
|
['electron-volt', 'ev', 'electronvolt', |
378
|
|
|
|
|
|
|
'electronvolts', 'electron-volts'], '1.60217733e-19 joule', |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
['mev',], 'mega electron-volt', |
381
|
|
|
|
|
|
|
['gev',], 'giga electron-volt', |
382
|
|
|
|
|
|
|
['tev',], 'tera electron-volt', |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
['calorie', 'cal', 'calories'], '4.184 joules', # exact |
385
|
|
|
|
|
|
|
['kcal',], 'kilocalorie', # exact |
386
|
|
|
|
|
|
|
['british-thermal-unit', 'btu', 'btus', |
387
|
|
|
|
|
|
|
'britishthermalunit', 'britishthermalunits', |
388
|
|
|
|
|
|
|
'british-thermal-units'], '1055.056 joule', |
389
|
|
|
|
|
|
|
['erg', 'ergs'], '1.0e-7 joule', # exact |
390
|
|
|
|
|
|
|
['kwh',], 'kilowatt hour', # exact |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
# Torque |
393
|
|
|
|
|
|
|
['foot-pound', 'ftlb', 'ft-lb', |
394
|
|
|
|
|
|
|
'footpound', 'footpounds', 'foot-pounds'], 'foot pound-force', |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
# Charge |
397
|
|
|
|
|
|
|
['coulomb', 'coul', 'coulombs'], 'ampere second', |
398
|
|
|
|
|
|
|
['abcoulomb', 'abcoul', 'abcoulombs'], '10 coulomb', |
399
|
|
|
|
|
|
|
['statcoulomb', 'statcoul', 'statcoulombs'], '3.336e-10 coulomb', |
400
|
|
|
|
|
|
|
['elementary-charge', 'eq'], '1.6021892e-19 coulomb', |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
# Pressure |
403
|
|
|
|
|
|
|
['pascal', 'pa'], 'newton / m^2', |
404
|
|
|
|
|
|
|
['bar', 'bars'], '1e5 pascal', |
405
|
|
|
|
|
|
|
['torr',], '(101325 / 760) pascal', |
406
|
|
|
|
|
|
|
['psi',], 'pounds per inch^2', |
407
|
|
|
|
|
|
|
['atmosphere', 'atm'], '101325 pascal', # exact |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
# Speed |
410
|
|
|
|
|
|
|
['mph',], 'mi/hr', |
411
|
|
|
|
|
|
|
['kph',], 'km/hr', |
412
|
|
|
|
|
|
|
['kps',], 'km/s', |
413
|
|
|
|
|
|
|
['fps',], 'ft/s', |
414
|
|
|
|
|
|
|
['knot', 'knots'], 'nm/hr', |
415
|
|
|
|
|
|
|
['mps',], 'meter/s', |
416
|
|
|
|
|
|
|
['speed-of-light', 'c'], '2.99792458e8 m/sec', |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
# Dose of radiation |
419
|
|
|
|
|
|
|
['gray', 'gy'], 'joule / kg', |
420
|
|
|
|
|
|
|
['sievert', 'sv'], 'joule / kg', |
421
|
|
|
|
|
|
|
['rad',], 'gray / 100', |
422
|
|
|
|
|
|
|
['rem',], 'sievert / 100', |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
# Other |
425
|
|
|
|
|
|
|
['gravitational-constant', 'g'], '6.6720e-11 m^3 / kg s^2', |
426
|
|
|
|
|
|
|
# Planck constant: |
427
|
|
|
|
|
|
|
['h'], '6.626196e-34 J/s', |
428
|
|
|
|
|
|
|
# Avogadro constant: |
429
|
|
|
|
|
|
|
['na'], '6.022169/mol', |
430
|
|
|
|
|
|
|
); |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
InitTypes ( |
434
|
|
|
|
|
|
|
'Dimensionless' => 'unity', |
435
|
|
|
|
|
|
|
'Frequency' => 'hertz', |
436
|
|
|
|
|
|
|
'Electric_potential' => 'volt', |
437
|
|
|
|
|
|
|
'Resistance' => 'ohm', |
438
|
|
|
|
|
|
|
'Conductance' => 'siemens', |
439
|
|
|
|
|
|
|
'Capacitance' => 'farad', |
440
|
|
|
|
|
|
|
'Inductance' => 'henry', |
441
|
|
|
|
|
|
|
'Magnetic_flux' => 'weber', |
442
|
|
|
|
|
|
|
'Magnetic_field' => 'tesla', |
443
|
|
|
|
|
|
|
'Momentum' => 'kg m/s', |
444
|
|
|
|
|
|
|
'Force' => 'newton', |
445
|
|
|
|
|
|
|
'Area' => 'are', |
446
|
|
|
|
|
|
|
'Volume' => 'liter', |
447
|
|
|
|
|
|
|
'Power' => 'watt', |
448
|
|
|
|
|
|
|
'Energy' => 'joule', |
449
|
|
|
|
|
|
|
'Torque' => 'kg m^2/s^2', |
450
|
|
|
|
|
|
|
'Charge' => 'coulomb', |
451
|
|
|
|
|
|
|
'Pressure' => 'pascal', |
452
|
|
|
|
|
|
|
'Speed' => 'mps', |
453
|
|
|
|
|
|
|
'Dose' => 'gray', # of radiation |
454
|
|
|
|
|
|
|
'Acceleration' => 'm/s^2', |
455
|
|
|
|
|
|
|
); |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
GetUnit('joule')->type('Energy'); |
459
|
|
|
|
|
|
|
GetUnit('ev')->type('Energy'); |
460
|
|
|
|
|
|
|
GetUnit('mev')->type('Energy'); |
461
|
|
|
|
|
|
|
GetUnit('gev')->type('Energy'); |
462
|
|
|
|
|
|
|
GetUnit('tev')->type('Energy'); |
463
|
|
|
|
|
|
|
GetUnit('cal')->type('Energy'); |
464
|
|
|
|
|
|
|
GetUnit('kcal')->type('Energy'); |
465
|
|
|
|
|
|
|
GetUnit('btu')->type('Energy'); |
466
|
|
|
|
|
|
|
GetUnit('erg')->type('Energy'); |
467
|
|
|
|
|
|
|
GetUnit('kwh')->type('Energy'); |
468
|
|
|
|
|
|
|
GetUnit('ftlb')->type('Torque'); |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
sub InitBaseUnit { |
472
|
3
|
|
|
3
|
1
|
10
|
while (@_) { |
473
|
19
|
|
|
|
|
23
|
my ($t, $names) = (shift, shift); |
474
|
19
|
50
|
33
|
|
|
72
|
croak 'Invalid arguments to InitBaseUnit' |
475
|
|
|
|
|
|
|
if ref $t || (ref $names ne "ARRAY"); |
476
|
|
|
|
|
|
|
|
477
|
19
|
50
|
|
|
|
24
|
print "Initializing Base Unit $$names[0]\n" if $debug; |
478
|
|
|
|
|
|
|
|
479
|
19
|
|
|
|
|
23
|
my $unit = NewOne(); |
480
|
19
|
|
|
|
|
33
|
$unit->AddNames(@$names); |
481
|
19
|
|
|
|
|
25
|
$unit->{def} = $unit->name(); # def same as name |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
# The dimension vector for this Unit has zeros in every place |
484
|
|
|
|
|
|
|
# except the last |
485
|
19
|
|
|
|
|
19
|
$unit->{dim}->[$NumBases] = 1; |
486
|
19
|
|
|
|
|
22
|
$BaseName[$NumBases] = $unit->abbr(); |
487
|
19
|
|
|
|
|
17
|
$NumBases++; |
488
|
|
|
|
|
|
|
|
489
|
19
|
|
|
|
|
24
|
$unit->NewType($t); |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
} |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
sub InitPrefix { |
494
|
3
|
|
|
3
|
1
|
9
|
while (@_) { |
495
|
60
|
|
|
|
|
51
|
my ($name, $factor) = (shift, shift); |
496
|
60
|
50
|
33
|
|
|
308
|
croak 'Invalid arguments to InitPrefix' |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
497
|
|
|
|
|
|
|
if !$name || !$factor || ref $name || ref $factor; |
498
|
|
|
|
|
|
|
|
499
|
60
|
50
|
|
|
|
63
|
print "Initializing Prefix $name\n" if $debug; |
500
|
|
|
|
|
|
|
|
501
|
60
|
|
|
|
|
54
|
my $u = NewOne(); |
502
|
60
|
|
|
|
|
61
|
$u->AddNames($name); |
503
|
60
|
|
|
|
|
52
|
$u->{factor} = $factor; |
504
|
60
|
|
|
|
|
44
|
$u->{type} = 'prefix'; |
505
|
60
|
|
|
|
|
46
|
$prefix{$name} = $u; |
506
|
|
|
|
|
|
|
|
507
|
60
|
|
|
|
|
89
|
$u->{def} = $factor; |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
sub InitUnit { |
512
|
6
|
|
|
6
|
1
|
21
|
while (@_) { |
513
|
440
|
|
|
|
|
494
|
my ($names, $def) = (shift, shift); |
514
|
|
|
|
|
|
|
|
515
|
440
|
50
|
33
|
|
|
1303
|
if (ref $names ne "ARRAY" || !$def) { |
516
|
0
|
|
|
|
|
0
|
print "InitUnit, second argument is '$def'\n"; |
517
|
0
|
|
|
|
|
0
|
croak 'Invalid arguments to InitUnit'; |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
|
520
|
440
|
50
|
|
|
|
495
|
print "Initializing Unit $$names[0]\n" if $debug; |
521
|
440
|
|
|
|
|
429
|
my $u = CreateUnit($def); |
522
|
440
|
|
|
|
|
587
|
$u->AddNames(@$names); |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
sub InitTypes { |
527
|
3
|
|
|
3
|
1
|
12
|
while (@_) { |
528
|
43
|
|
|
|
|
40
|
my ($t, $u) = (shift, shift); |
529
|
43
|
50
|
33
|
|
|
182
|
croak 'Invalid arguments to InitTypes' |
|
|
|
33
|
|
|
|
|
530
|
|
|
|
|
|
|
if !$t || ref $t || !$u; |
531
|
|
|
|
|
|
|
|
532
|
43
|
|
|
|
|
43
|
my $unit = GetUnit($u); |
533
|
43
|
|
|
|
|
49
|
$unit->NewType($t); |
534
|
|
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
sub GetUnit { |
538
|
1382
|
|
|
1382
|
1
|
2027
|
my $u = shift; |
539
|
1382
|
50
|
|
|
|
1628
|
croak 'GetUnit: expected an argument' unless $u; |
540
|
1382
|
100
|
|
|
|
1902
|
return $u if ref $u; |
541
|
|
|
|
|
|
|
|
542
|
748
|
100
|
|
|
|
1070
|
if ($unit_by_name{$u}) { |
543
|
|
|
|
|
|
|
#print "GetUnit, $u yields ", $unit_by_name{$u}->name, "\n"; |
544
|
721
|
|
|
|
|
1110
|
return $unit_by_name{$u}; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
# Try it as an expression |
548
|
27
|
|
|
|
|
39
|
return CreateUnit($u); |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
sub ListUnits { |
552
|
5
|
|
|
5
|
1
|
1840
|
return sort keys %unit_by_name; |
553
|
|
|
|
|
|
|
} |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
sub ListTypes { |
556
|
1
|
|
|
1
|
1
|
17
|
return sort keys %prototype; |
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
sub NumBases { |
560
|
0
|
|
|
0
|
1
|
0
|
return $NumBases; |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
sub GetTypeUnit { |
564
|
30
|
|
|
30
|
1
|
20
|
my $t = shift; |
565
|
30
|
|
|
|
|
40
|
return $prototype{$t}; |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
# DeleteNames - argument can be either an array ref, a list of name strings, or |
569
|
|
|
|
|
|
|
# a unit object |
570
|
|
|
|
|
|
|
sub DeleteNames { |
571
|
4
|
|
|
4
|
1
|
20
|
my $arg0 = $_[0]; |
572
|
4
|
|
100
|
|
|
17
|
my $argIsUnit = ref $arg0 && ref $arg0 ne 'ARRAY'; |
573
|
|
|
|
|
|
|
# Get the list of names to delete |
574
|
|
|
|
|
|
|
my $names = |
575
|
|
|
|
|
|
|
!ref $arg0 |
576
|
|
|
|
|
|
|
? \@_ # list of names |
577
|
|
|
|
|
|
|
: ref $arg0 eq 'ARRAY' |
578
|
|
|
|
|
|
|
? $arg0 # array ref |
579
|
4
|
100
|
|
|
|
12
|
: $arg0->{names}; # unit object |
|
|
100
|
|
|
|
|
|
580
|
|
|
|
|
|
|
|
581
|
4
|
|
|
|
|
6
|
my $u; |
582
|
4
|
100
|
|
|
|
5
|
if ($argIsUnit) { $u = $arg0; } |
|
1
|
|
|
|
|
2
|
|
583
|
4
|
|
|
|
|
6
|
for my $n (@$names) { |
584
|
8
|
50
|
|
|
|
10
|
if (LookName($n) != 2) { |
585
|
0
|
|
|
|
|
0
|
croak "'$n' is not a unit name."; |
586
|
|
|
|
|
|
|
} |
587
|
8
|
50
|
|
|
|
11
|
print "deleting '$n'\n" if $debug; |
588
|
8
|
|
|
|
|
9
|
delete $prefix{$n}; |
589
|
8
|
100
|
|
|
|
10
|
if (!$argIsUnit) { $u = $unit_by_name{$n}; } |
|
5
|
|
|
|
|
5
|
|
590
|
8
|
|
|
|
|
8
|
delete $unit_by_name{$n}; |
591
|
|
|
|
|
|
|
# Delete the array element matching $n from @{$u->{names}} |
592
|
8
|
100
|
|
|
|
11
|
if (!$argIsUnit) { |
593
|
5
|
|
|
|
|
1
|
$u->{names} = [ grep { $_ ne $n } @{$u->{names}} ]; |
|
15
|
|
|
|
|
24
|
|
|
5
|
|
|
|
|
8
|
|
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
} |
596
|
4
|
100
|
|
|
|
10
|
if ($argIsUnit) { $u->{names} = []; } |
|
1
|
|
|
|
|
3
|
|
597
|
|
|
|
|
|
|
} |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
sub new { |
601
|
20
|
|
|
20
|
1
|
623
|
my $proto = shift; |
602
|
20
|
|
|
|
|
50
|
my $class; |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
my $self; |
605
|
20
|
100
|
|
|
|
36
|
if (ref $proto) { # object method |
606
|
2
|
|
|
|
|
5
|
$self = $proto->copy; |
607
|
|
|
|
|
|
|
} |
608
|
|
|
|
|
|
|
else { # class method |
609
|
18
|
|
|
|
|
22
|
my $r = shift; |
610
|
18
|
|
|
|
|
30
|
$self = CreateUnit($r); |
611
|
|
|
|
|
|
|
} |
612
|
|
|
|
|
|
|
|
613
|
20
|
|
|
|
|
43
|
$self->AddNames(@_); |
614
|
20
|
|
|
|
|
59
|
return $self; |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
sub type { |
618
|
49
|
|
|
49
|
1
|
505
|
my $self = shift; |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
# See if the user is setting the type |
621
|
49
|
|
|
|
|
31
|
my $t; |
622
|
49
|
100
|
|
|
|
77
|
if ($t = shift) { |
623
|
|
|
|
|
|
|
# XXX Maybe we should check that $t is a valid type name, and |
624
|
|
|
|
|
|
|
# XXX that it's type really does match. |
625
|
23
|
|
|
|
|
27
|
return $self->{type} = $t; |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
# If the type is known already, return it |
629
|
26
|
100
|
|
|
|
60
|
return $self->{type} if $self->{type}; |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
# See if it is a prefix |
632
|
22
|
|
|
|
|
33
|
my $name = $self->name(); |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
return $self->{type} = 'prefix' |
635
|
22
|
50
|
66
|
|
|
53
|
if defined $name && defined $prefix{$name}; |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
# Collect all matching types |
638
|
22
|
|
|
|
|
17
|
my @t; |
639
|
22
|
|
|
|
|
122
|
for (keys %prototype) { |
640
|
|
|
|
|
|
|
push @t, $_ |
641
|
667
|
100
|
|
|
|
711
|
unless CompareDim($self, $prototype{$_}); |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
# Return value depends on whether we got zero, one, or multiple types |
645
|
22
|
100
|
|
|
|
82
|
return undef unless @t; |
646
|
18
|
100
|
|
|
|
295
|
return $self->{type} = $t[0] if @t == 1; |
647
|
1
|
|
|
|
|
3
|
return \@t; |
648
|
|
|
|
|
|
|
} |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
sub name { |
651
|
90
|
|
|
90
|
1
|
92
|
my $self = shift; |
652
|
90
|
|
|
|
|
74
|
my $n = $self->{names}; |
653
|
90
|
|
|
|
|
195
|
return $$n[0]; |
654
|
|
|
|
|
|
|
} |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
sub abbr { |
657
|
19
|
|
|
19
|
1
|
12
|
my $self = shift; |
658
|
19
|
|
|
|
|
15
|
my $n = ${$self->{names}}[0]; |
|
19
|
|
|
|
|
22
|
|
659
|
19
|
50
|
|
|
|
32
|
return undef unless defined $n; |
660
|
|
|
|
|
|
|
|
661
|
19
|
|
|
|
|
21
|
for ($self->names()) { |
662
|
79
|
100
|
|
|
|
105
|
$n = $_ if length $_ < length $n; |
663
|
|
|
|
|
|
|
} |
664
|
19
|
|
|
|
|
31
|
return $n; |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
sub names { |
668
|
22
|
|
|
22
|
1
|
960
|
my $self = shift; |
669
|
22
|
|
|
|
|
16
|
return @{$self->{names}}; |
|
22
|
|
|
|
|
49
|
|
670
|
|
|
|
|
|
|
} |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
sub def { |
673
|
4
|
|
|
4
|
1
|
5
|
my $self = shift; |
674
|
4
|
|
|
|
|
16
|
return $self->{def}; |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
sub expanded { |
678
|
11
|
|
|
11
|
1
|
21
|
my $self = shift; |
679
|
11
|
|
|
|
|
16
|
my $s = $self->{factor}; |
680
|
11
|
100
|
|
|
|
26
|
$s = '' if $s == 1; |
681
|
|
|
|
|
|
|
|
682
|
11
|
|
|
|
|
10
|
my $i = 0; |
683
|
11
|
|
|
|
|
12
|
for my $d (@{$self->{dim}}) { |
|
11
|
|
|
|
|
24
|
|
684
|
118
|
100
|
|
|
|
128
|
if ($d) { |
685
|
|
|
|
|
|
|
#print "Dimension index $i is $d\n"; |
686
|
22
|
100
|
|
|
|
29
|
if ($s) { $s .= " "; } |
|
20
|
|
|
|
|
58
|
|
687
|
22
|
|
|
|
|
28
|
$s .= $BaseName[$i]; |
688
|
22
|
100
|
|
|
|
41
|
$s .= "^$d" unless $d == 1; |
689
|
|
|
|
|
|
|
} |
690
|
118
|
|
|
|
|
79
|
$i++; |
691
|
|
|
|
|
|
|
} |
692
|
|
|
|
|
|
|
|
693
|
11
|
50
|
|
|
|
24
|
$s = 1 if $s eq ''; |
694
|
11
|
|
|
|
|
49
|
return $s; |
695
|
|
|
|
|
|
|
} |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
sub ToString { |
698
|
11
|
|
|
11
|
1
|
6
|
my $self = shift; |
699
|
11
|
|
66
|
|
|
23
|
return $self->name || $self->def || $self->expanded; |
700
|
|
|
|
|
|
|
} |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
sub factor { |
703
|
9
|
|
|
9
|
1
|
12
|
my $self = shift; |
704
|
9
|
100
|
|
|
|
21
|
if (@_) { |
705
|
3
|
|
|
|
|
6
|
$self->CheckChange; |
706
|
3
|
|
|
|
|
6
|
$self->{factor} = shift; |
707
|
|
|
|
|
|
|
} |
708
|
9
|
|
|
|
|
24
|
return $self->{factor}; |
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
sub convert { |
712
|
19
|
|
|
19
|
1
|
24
|
my ($self, $other) = @_; |
713
|
19
|
|
|
|
|
24
|
my $u = GetUnit($other); |
714
|
19
|
50
|
|
|
|
29
|
carp "Can't convert ". $self->name() .' to '. $u->name() |
715
|
|
|
|
|
|
|
if CompareDim($self, $u); |
716
|
19
|
|
|
|
|
68
|
return $self->{factor} / $u->{factor}; |
717
|
|
|
|
|
|
|
} |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
sub times { |
720
|
472
|
|
|
472
|
1
|
330
|
my $self = shift; |
721
|
472
|
|
|
|
|
489
|
$self->CheckChange; |
722
|
472
|
|
|
|
|
440
|
my $u = GetUnit(shift); |
723
|
472
|
|
|
|
|
560
|
$self->{factor} *= $u->{factor}; |
724
|
|
|
|
|
|
|
|
725
|
472
|
|
|
|
|
638
|
for (0 .. $NumBases) { |
726
|
4756
|
100
|
|
|
|
4770
|
my $u_val = defined $u->{dim}[$_] ? $u->{dim}[$_] : 0; |
727
|
4756
|
100
|
|
|
|
4300
|
if (defined $self->{dim}[$_]) { |
728
|
4738
|
|
|
|
|
3702
|
$self->{dim}[$_] += $u_val; |
729
|
|
|
|
|
|
|
} |
730
|
|
|
|
|
|
|
else { |
731
|
18
|
|
|
|
|
36
|
$self->{dim}[$_] = $u_val; |
732
|
|
|
|
|
|
|
} |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
|
735
|
472
|
|
|
|
|
358
|
$self->{type} = ''; |
736
|
472
|
|
|
|
|
894
|
return $self; |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
sub recip { |
740
|
141
|
|
|
141
|
1
|
91
|
my $self = shift; |
741
|
141
|
|
|
|
|
151
|
$self->CheckChange; |
742
|
141
|
|
|
|
|
173
|
$self->{factor} = 1 / $self->{factor}; |
743
|
|
|
|
|
|
|
|
744
|
141
|
|
|
|
|
187
|
for (0 .. $NumBases) { |
745
|
1424
|
100
|
|
|
|
1364
|
if (defined $self->{dim}[$_]) { |
746
|
1416
|
|
|
|
|
1210
|
$self->{dim}->[$_] = -$self->{dim}->[$_]; |
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
else { |
749
|
8
|
|
|
|
|
16
|
$self->{dim}[$_] = 0; |
750
|
|
|
|
|
|
|
} |
751
|
|
|
|
|
|
|
} |
752
|
|
|
|
|
|
|
|
753
|
141
|
|
|
|
|
203
|
return $self; |
754
|
|
|
|
|
|
|
} |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
sub divide { |
757
|
139
|
|
|
139
|
1
|
139
|
my ($self, $other) = @_; |
758
|
139
|
|
|
|
|
145
|
my $u = GetUnit($other)->copy; |
759
|
139
|
|
|
|
|
182
|
$self->times($u->recip); |
760
|
|
|
|
|
|
|
} |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
sub power { |
763
|
88
|
|
|
88
|
1
|
71
|
my $self = shift; |
764
|
88
|
|
|
|
|
102
|
$self->CheckChange; |
765
|
88
|
|
|
|
|
65
|
my $p = shift; |
766
|
88
|
50
|
|
|
|
131
|
die 'Exponentiation to integer values only, please' |
767
|
|
|
|
|
|
|
unless $p == int $p; |
768
|
88
|
|
|
|
|
126
|
$self->{factor} **= $p; |
769
|
|
|
|
|
|
|
|
770
|
88
|
|
|
|
|
122
|
for (0 .. $NumBases) { |
771
|
885
|
100
|
|
|
|
969
|
$self->{dim}[$_] = 0 unless defined $self->{dim}[$_]; |
772
|
885
|
|
|
|
|
665
|
$self->{dim}[$_] *= $p; |
773
|
|
|
|
|
|
|
} |
774
|
|
|
|
|
|
|
|
775
|
88
|
|
|
|
|
75
|
$self->{type} = ''; |
776
|
88
|
|
|
|
|
64
|
return $self; |
777
|
|
|
|
|
|
|
} |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
sub add { |
780
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
781
|
0
|
|
|
|
|
0
|
$self->CheckChange; |
782
|
|
|
|
|
|
|
|
783
|
0
|
|
|
|
|
0
|
my $other = shift; |
784
|
0
|
|
|
|
|
0
|
my $u = GetUnit($other); |
785
|
|
|
|
|
|
|
|
786
|
0
|
0
|
|
|
|
0
|
croak "Can't add ". $u->type .' to a '. $self->type |
787
|
|
|
|
|
|
|
if CompareDim($self, $u); |
788
|
0
|
|
|
|
|
0
|
$self->{factor} += $u->{factor}; |
789
|
0
|
|
|
|
|
0
|
return $self; |
790
|
|
|
|
|
|
|
} |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
sub neg { |
793
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
794
|
0
|
|
|
|
|
0
|
$self->CheckChange; |
795
|
0
|
|
|
|
|
0
|
$self->{factor} = -$self->{factor}; |
796
|
0
|
|
|
|
|
0
|
return $self; |
797
|
|
|
|
|
|
|
} |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
sub subtract { |
800
|
0
|
|
|
0
|
1
|
0
|
my ($self, $other) = @_; |
801
|
0
|
|
|
|
|
0
|
my $u = GetUnit($other)->copy; |
802
|
0
|
|
|
|
|
0
|
$self->add( $u->neg ); |
803
|
|
|
|
|
|
|
} |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
sub copy { |
806
|
758
|
|
|
758
|
1
|
554
|
my $self = shift; |
807
|
|
|
|
|
|
|
my $n = { |
808
|
|
|
|
|
|
|
'factor' => $self->{factor}, |
809
|
758
|
|
|
|
|
2709
|
'dim' => [@{$self->{dim}}], |
810
|
|
|
|
|
|
|
'type' => $self->{type}, |
811
|
|
|
|
|
|
|
'names' => [], |
812
|
|
|
|
|
|
|
'def' => $self->{def}, |
813
|
758
|
|
|
|
|
623
|
}; |
814
|
|
|
|
|
|
|
|
815
|
758
|
|
|
|
|
757
|
bless $n, 'Physics::Unit'; |
816
|
758
|
|
|
|
|
687
|
return $n; |
817
|
|
|
|
|
|
|
} |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
sub equal { |
820
|
6
|
|
|
6
|
1
|
9
|
my $obj1 = shift; |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
# If it was called as a class method, throw away the first |
823
|
|
|
|
|
|
|
# argument (the class name) |
824
|
6
|
100
|
|
|
|
14
|
$obj1 = shift unless ref $obj1; |
825
|
6
|
|
|
|
|
7
|
$obj1 = GetUnit($obj1); |
826
|
6
|
|
|
|
|
8
|
my $obj2 = GetUnit(shift); |
827
|
|
|
|
|
|
|
|
828
|
6
|
50
|
|
|
|
9
|
return 0 if CompareDim($obj1, $obj2); |
829
|
6
|
50
|
|
|
|
15
|
return 0 unless $obj1->{factor} == $obj2->{factor}; |
830
|
6
|
|
|
|
|
19
|
return 1; |
831
|
|
|
|
|
|
|
} |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
sub NewOne { |
834
|
417
|
|
|
417
|
0
|
1262
|
my $u = { |
835
|
|
|
|
|
|
|
'factor' => 1, |
836
|
|
|
|
|
|
|
'dim' => [0, 0, 0, 0, 0, 0, 0, 0, 0, 0], |
837
|
|
|
|
|
|
|
'type' => undef, |
838
|
|
|
|
|
|
|
'names' => [], |
839
|
|
|
|
|
|
|
'def' => undef, |
840
|
|
|
|
|
|
|
}; |
841
|
417
|
|
|
|
|
535
|
bless $u, 'Physics::Unit'; |
842
|
|
|
|
|
|
|
} |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
sub AddNames { |
845
|
539
|
|
|
539
|
0
|
379
|
my $self = shift; |
846
|
539
|
|
|
|
|
357
|
my $n; |
847
|
539
|
|
|
|
|
740
|
while ($n = shift) { |
848
|
1072
|
50
|
|
|
|
1150
|
croak "Can't use a reference as a name!" if ref $n; |
849
|
1072
|
50
|
|
|
|
927
|
carp "Name $n is already defined" if LookName($n); |
850
|
1072
|
|
|
|
|
660
|
push @{$self->{names}}, "\L$n"; |
|
1072
|
|
|
|
|
1538
|
|
851
|
1072
|
|
|
|
|
4187
|
$unit_by_name{$n} = $self; |
852
|
|
|
|
|
|
|
} |
853
|
|
|
|
|
|
|
} |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
sub NewType { |
856
|
62
|
|
|
62
|
0
|
77
|
my ($self, $t) = @_; |
857
|
|
|
|
|
|
|
# my $oldtype = $self->type; |
858
|
|
|
|
|
|
|
# croak "NewType: the type $t is already defined as $oldtype" |
859
|
|
|
|
|
|
|
# if $oldtype ne 'unknown'; |
860
|
62
|
|
|
|
|
57
|
$self->{type} = $t; |
861
|
62
|
|
|
|
|
159
|
$prototype{$t} = $self; |
862
|
|
|
|
|
|
|
} |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
sub CreateUnit { |
865
|
485
|
|
|
485
|
0
|
365
|
my $def = shift; |
866
|
|
|
|
|
|
|
# argument was a Unit object |
867
|
485
|
100
|
|
|
|
573
|
return $def->new() if ref $def; |
868
|
|
|
|
|
|
|
# argument was either a simple name or an expression - doesn't matter |
869
|
484
|
|
|
|
|
478
|
$def = lc $def; |
870
|
|
|
|
|
|
|
|
871
|
484
|
|
|
|
|
461
|
my $u = expr($def); |
872
|
484
|
|
|
|
|
447
|
$u->{def} = $def; |
873
|
484
|
|
|
|
|
463
|
return $u; |
874
|
|
|
|
|
|
|
} |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
sub CompareDim { |
877
|
692
|
|
|
692
|
0
|
531
|
my ($u1, $u2) = @_; |
878
|
692
|
|
|
|
|
513
|
my $d1 = $u1->{dim}; |
879
|
692
|
|
|
|
|
581
|
my $d2 = $u2->{dim}; |
880
|
|
|
|
|
|
|
|
881
|
692
|
|
|
|
|
710
|
for (0 .. $NumBases) { |
882
|
1370
|
100
|
|
|
|
1717
|
$$d1[$_] = 0 unless defined $$d1[$_]; |
883
|
1370
|
100
|
|
|
|
1599
|
$$d2[$_] = 0 unless defined $$d2[$_]; |
884
|
1370
|
|
|
|
|
979
|
my $c = ($$d1[$_] <=> $$d2[$_]); |
885
|
1370
|
100
|
|
|
|
2411
|
return $c if $c; |
886
|
|
|
|
|
|
|
} |
887
|
44
|
|
|
|
|
101
|
return 0; |
888
|
|
|
|
|
|
|
} |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
sub LookName { |
891
|
1715
|
|
|
1715
|
0
|
1710
|
my $name = shift; |
892
|
1715
|
50
|
|
|
|
2125
|
return 3 if defined $prototype{$name}; |
893
|
1715
|
100
|
|
|
|
2414
|
return 2 if defined $unit_by_name{$name}; |
894
|
1158
|
100
|
|
|
|
1375
|
return 1 if defined $reserved_word{$name}; |
895
|
1138
|
|
|
|
|
1381
|
return 0; |
896
|
|
|
|
|
|
|
} |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
sub DebugString { |
899
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
900
|
0
|
|
|
|
|
0
|
my $s = $self->{factor}; |
901
|
0
|
|
|
|
|
0
|
$s .= '['. join (', ', @{$self->{dim}}) .']'; |
|
0
|
|
|
|
|
0
|
|
902
|
0
|
|
|
|
|
0
|
return $s; |
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
sub CheckChange { |
906
|
704
|
|
|
704
|
0
|
507
|
my $self = shift; |
907
|
704
|
50
|
|
|
|
919
|
carp "You're not allowed to change named units!" if $self->{names}[0]; |
908
|
704
|
|
|
|
|
690
|
$self->{names} = []; |
909
|
704
|
|
|
|
|
758
|
$self->{type} = $self->{def} = undef; |
910
|
|
|
|
|
|
|
} |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
# global variables used for parsing. |
913
|
|
|
|
|
|
|
my $def; # string being parsed |
914
|
|
|
|
|
|
|
my $tok; # the token type |
915
|
|
|
|
|
|
|
my $numval; # the value when the token is a number |
916
|
|
|
|
|
|
|
my $tokname; # when it is a name |
917
|
|
|
|
|
|
|
my $indent; # used to indent debug messages |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
# parser |
920
|
|
|
|
|
|
|
sub expr { |
921
|
486
|
100
|
|
486
|
0
|
625
|
if (@_) { |
922
|
484
|
|
|
|
|
335
|
$def = shift; |
923
|
484
|
|
|
|
|
525
|
get_token(); |
924
|
|
|
|
|
|
|
} |
925
|
|
|
|
|
|
|
|
926
|
486
|
50
|
|
|
|
684
|
print ' ' x $indent, "inside expr\n" if $debug; |
927
|
486
|
|
|
|
|
350
|
$indent++; |
928
|
486
|
|
|
|
|
497
|
my $u = term(); |
929
|
|
|
|
|
|
|
|
930
|
486
|
|
|
|
|
362
|
for (;;) { |
931
|
625
|
100
|
|
|
|
823
|
if ($tok eq 'times') { |
|
|
100
|
|
|
|
|
|
932
|
3
|
|
|
|
|
4
|
get_token(); |
933
|
3
|
|
|
|
|
10
|
$u->times(term()); |
934
|
|
|
|
|
|
|
} |
935
|
|
|
|
|
|
|
elsif ($tok eq 'divide') { |
936
|
136
|
|
|
|
|
147
|
get_token(); |
937
|
136
|
|
|
|
|
154
|
$u->divide(term()); |
938
|
|
|
|
|
|
|
} |
939
|
|
|
|
|
|
|
else { |
940
|
486
|
50
|
|
|
|
543
|
print ' ' x $indent, "expr: returning ", $u->DebugString, "\n" |
941
|
|
|
|
|
|
|
if $debug; |
942
|
486
|
|
|
|
|
295
|
$indent--; |
943
|
486
|
|
|
|
|
435
|
return $u; |
944
|
|
|
|
|
|
|
} |
945
|
|
|
|
|
|
|
} |
946
|
|
|
|
|
|
|
} |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
sub term { |
949
|
625
|
50
|
|
625
|
0
|
727
|
print ' ' x $indent, "inside term\n" if $debug; |
950
|
625
|
|
|
|
|
393
|
$indent++; |
951
|
625
|
|
|
|
|
561
|
my $u = Factor(); |
952
|
|
|
|
|
|
|
|
953
|
625
|
|
|
|
|
391
|
for (;;) { |
954
|
889
|
50
|
|
|
|
1019
|
print ' ' x $indent, "inside term loop\n" if $debug; |
955
|
889
|
100
|
66
|
|
|
4730
|
if ($tok eq 'number' || |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
956
|
|
|
|
|
|
|
$tok eq 'name' || |
957
|
|
|
|
|
|
|
$tok eq 'prefix' || |
958
|
|
|
|
|
|
|
$tok eq 'square' || |
959
|
|
|
|
|
|
|
$tok eq 'cubic') |
960
|
|
|
|
|
|
|
{ |
961
|
264
|
|
|
|
|
277
|
$u->times(Factor()); |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
else { |
964
|
625
|
50
|
|
|
|
710
|
print ' ' x $indent, "term: returning ", $u->DebugString, "\n" |
965
|
|
|
|
|
|
|
if $debug; |
966
|
625
|
|
|
|
|
364
|
$indent--; |
967
|
625
|
|
|
|
|
669
|
return $u; |
968
|
|
|
|
|
|
|
} |
969
|
|
|
|
|
|
|
} |
970
|
|
|
|
|
|
|
} |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
sub Factor { |
973
|
889
|
50
|
|
889
|
0
|
972
|
print ' ' x $indent, "inside factor\n" if $debug; |
974
|
889
|
|
|
|
|
547
|
$indent++; |
975
|
|
|
|
|
|
|
|
976
|
889
|
|
|
|
|
809
|
my $u = prim(); |
977
|
|
|
|
|
|
|
|
978
|
889
|
|
|
|
|
596
|
for (;;) { |
979
|
966
|
50
|
|
|
|
1069
|
print ' ' x $indent, "inside factor loop\n" if $debug; |
980
|
966
|
100
|
|
|
|
897
|
if ($tok eq 'exponent') { |
981
|
77
|
|
|
|
|
79
|
get_token(); |
982
|
77
|
50
|
|
|
|
117
|
die 'Exponent must be an integer' |
983
|
|
|
|
|
|
|
unless $tok eq 'number'; |
984
|
77
|
|
|
|
|
115
|
$u->power($numval); |
985
|
77
|
|
|
|
|
98
|
get_token(); |
986
|
|
|
|
|
|
|
} |
987
|
|
|
|
|
|
|
else { |
988
|
889
|
50
|
|
|
|
1054
|
print ' ' x $indent, "factor: returning ", |
989
|
|
|
|
|
|
|
$u->DebugString, "\n" if $debug; |
990
|
889
|
|
|
|
|
535
|
$indent--; |
991
|
889
|
|
|
|
|
949
|
return $u; |
992
|
|
|
|
|
|
|
} |
993
|
|
|
|
|
|
|
} |
994
|
|
|
|
|
|
|
} |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
sub prim { |
997
|
963
|
50
|
|
963
|
0
|
1065
|
print ' ' x $indent, "inside prim\n" if $debug; |
998
|
963
|
|
|
|
|
578
|
$indent++; |
999
|
|
|
|
|
|
|
|
1000
|
963
|
|
|
|
|
573
|
my $u; |
1001
|
|
|
|
|
|
|
|
1002
|
963
|
100
|
|
|
|
1418
|
if ($tok eq 'number') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1003
|
338
|
50
|
|
|
|
382
|
print ' ' x $indent, "got number $numval\n" if $debug; |
1004
|
|
|
|
|
|
|
# Create a new Unit object to represent this number |
1005
|
338
|
|
|
|
|
323
|
$u = NewOne(); |
1006
|
338
|
|
|
|
|
363
|
$u->{factor} = $numval; |
1007
|
338
|
|
|
|
|
335
|
get_token(); |
1008
|
|
|
|
|
|
|
} |
1009
|
|
|
|
|
|
|
elsif ($tok eq 'prefix') { |
1010
|
64
|
50
|
|
|
|
84
|
print ' ' x $indent, "got a prefix: ", "$tokname\n" if $debug; |
1011
|
64
|
|
|
|
|
67
|
$u = GetUnit($tokname)->copy(); |
1012
|
64
|
|
|
|
|
71
|
get_token(); |
1013
|
64
|
|
|
|
|
95
|
$u->times(prim()); |
1014
|
|
|
|
|
|
|
} |
1015
|
|
|
|
|
|
|
elsif ($tok eq 'name') { |
1016
|
549
|
50
|
|
|
|
600
|
print ' ' x $indent, "got a name: ", "$tokname\n" if $debug; |
1017
|
549
|
|
|
|
|
539
|
$u = GetUnit($tokname)->copy(); |
1018
|
549
|
|
|
|
|
574
|
get_token(); |
1019
|
|
|
|
|
|
|
} |
1020
|
|
|
|
|
|
|
elsif ($tok eq 'lparen') { |
1021
|
2
|
50
|
|
|
|
7
|
print ' ' x $indent, "got a left paren\n" if $debug; |
1022
|
2
|
|
|
|
|
4
|
get_token(); |
1023
|
2
|
|
|
|
|
11
|
$u = expr(); |
1024
|
2
|
50
|
|
|
|
7
|
die 'Missing right parenthesis' |
1025
|
|
|
|
|
|
|
unless $tok eq 'rparen'; |
1026
|
2
|
|
|
|
|
4
|
get_token(); |
1027
|
|
|
|
|
|
|
} |
1028
|
|
|
|
|
|
|
elsif ($tok eq 'end') { |
1029
|
0
|
0
|
|
|
|
0
|
print ' ' x $indent, "got end\n" if $debug; |
1030
|
0
|
|
|
|
|
0
|
$u = NewOne(); |
1031
|
|
|
|
|
|
|
} |
1032
|
|
|
|
|
|
|
elsif ($tok eq 'square') { |
1033
|
8
|
|
|
|
|
9
|
get_token(); |
1034
|
8
|
|
|
|
|
15
|
$u = prim()->power(2); |
1035
|
|
|
|
|
|
|
} |
1036
|
|
|
|
|
|
|
elsif ($tok eq 'cubic') { |
1037
|
2
|
|
|
|
|
5
|
get_token(); |
1038
|
2
|
|
|
|
|
5
|
$u = prim()->power(3); |
1039
|
|
|
|
|
|
|
} |
1040
|
|
|
|
|
|
|
else { |
1041
|
0
|
|
|
|
|
0
|
die 'Primary expected'; |
1042
|
|
|
|
|
|
|
} |
1043
|
|
|
|
|
|
|
|
1044
|
963
|
50
|
|
|
|
1210
|
print ' ' x $indent, "prim: returning ", $u->DebugString, "\n" |
1045
|
|
|
|
|
|
|
if $debug; |
1046
|
963
|
|
|
|
|
603
|
$indent--; |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
# Before returning, see if the *next* token is 'squared' or 'cubed' |
1049
|
963
|
|
|
|
|
629
|
for(;;) { |
1050
|
964
|
100
|
|
|
|
1242
|
if ($tok eq 'squared') { |
|
|
50
|
|
|
|
|
|
1051
|
1
|
|
|
|
|
3
|
get_token(); |
1052
|
1
|
|
|
|
|
2
|
$u->power(2); |
1053
|
|
|
|
|
|
|
} |
1054
|
|
|
|
|
|
|
elsif ($tok eq 'cubed') { |
1055
|
0
|
|
|
|
|
0
|
get_token(); |
1056
|
0
|
|
|
|
|
0
|
$u->power(3); |
1057
|
|
|
|
|
|
|
} |
1058
|
|
|
|
|
|
|
else { |
1059
|
963
|
|
|
|
|
701
|
last; |
1060
|
|
|
|
|
|
|
} |
1061
|
|
|
|
|
|
|
} |
1062
|
|
|
|
|
|
|
|
1063
|
963
|
|
|
|
|
893
|
return $u; |
1064
|
|
|
|
|
|
|
} |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
sub get_token { |
1067
|
1743
|
50
|
|
1743
|
0
|
2001
|
print ' ' x $indent, "get_token, looking at '$def'\n" if $debug; |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
# First remove whitespace at the begining |
1070
|
1743
|
|
|
|
|
2273
|
$def =~ s/^\s+//; |
1071
|
|
|
|
|
|
|
|
1072
|
1743
|
100
|
|
|
|
2189
|
if ($def eq '') { |
1073
|
484
|
|
|
|
|
347
|
$tok = 'end'; |
1074
|
484
|
|
|
|
|
400
|
return; |
1075
|
|
|
|
|
|
|
} |
1076
|
|
|
|
|
|
|
|
1077
|
1259
|
100
|
100
|
|
|
9083
|
if ($def =~ s/^\(//) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1078
|
2
|
|
|
|
|
4
|
$tok = 'lparen'; |
1079
|
|
|
|
|
|
|
} |
1080
|
|
|
|
|
|
|
elsif ($def =~ s/^\)//) { |
1081
|
2
|
|
|
|
|
3
|
$tok = 'rparen'; |
1082
|
|
|
|
|
|
|
} |
1083
|
|
|
|
|
|
|
elsif ($def =~ s/^\*\*// || $def =~ s/^\^//) { |
1084
|
77
|
|
|
|
|
88
|
$tok = 'exponent'; |
1085
|
|
|
|
|
|
|
} |
1086
|
|
|
|
|
|
|
elsif ($def =~ s/^\*//) { |
1087
|
3
|
|
|
|
|
6
|
$tok = 'times'; |
1088
|
|
|
|
|
|
|
} |
1089
|
|
|
|
|
|
|
elsif ($def =~ s/^\///) { |
1090
|
127
|
|
|
|
|
136
|
$tok = 'divide'; |
1091
|
|
|
|
|
|
|
} |
1092
|
|
|
|
|
|
|
elsif ($def =~ s/^$number_re//io) { |
1093
|
415
|
|
|
|
|
793
|
$numval = $1 + 0; # convert to a number |
1094
|
415
|
|
|
|
|
421
|
$tok = 'number'; |
1095
|
|
|
|
|
|
|
} |
1096
|
|
|
|
|
|
|
elsif ($def =~ /^([^\ \n\r\t\f\(\)\/\^\*]+)/) { |
1097
|
633
|
|
|
|
|
773
|
my $t = $1; |
1098
|
633
|
|
|
|
|
633
|
my $l = LookName($t); |
1099
|
|
|
|
|
|
|
|
1100
|
633
|
100
|
|
|
|
1045
|
if ($l == 1) { |
|
|
100
|
|
|
|
|
|
1101
|
20
|
|
|
|
|
23
|
$tok = $reserved_word{$t}; |
1102
|
20
|
|
|
|
|
17
|
$tokname = $t; |
1103
|
20
|
|
|
|
|
25
|
$def = substr $def, length($t); |
1104
|
20
|
|
|
|
|
41
|
return; |
1105
|
|
|
|
|
|
|
} |
1106
|
|
|
|
|
|
|
elsif ($l == 2) { |
1107
|
549
|
|
|
|
|
369
|
$tok = 'name'; |
1108
|
549
|
|
|
|
|
388
|
$tokname = $t; |
1109
|
549
|
|
|
|
|
595
|
$def = substr $def, length($t); |
1110
|
549
|
|
|
|
|
465
|
return; |
1111
|
|
|
|
|
|
|
} |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
# Couldn't find the name on the first try, look for prefix |
1114
|
64
|
|
|
|
|
288
|
for my $p (keys %prefix) { |
1115
|
939
|
100
|
|
|
|
3688
|
if ($t =~ /^$p/i) { |
1116
|
64
|
|
|
|
|
59
|
$tok = 'prefix'; |
1117
|
64
|
|
|
|
|
51
|
$tokname = $p; |
1118
|
64
|
|
|
|
|
75
|
$def = substr $def, length($p); |
1119
|
64
|
|
|
|
|
93
|
return; |
1120
|
|
|
|
|
|
|
} |
1121
|
|
|
|
|
|
|
} |
1122
|
0
|
|
|
|
|
|
die "Unknown unit: $t\n"; |
1123
|
|
|
|
|
|
|
} |
1124
|
|
|
|
|
|
|
else { |
1125
|
0
|
|
|
|
|
|
die "Illegal token in $def"; |
1126
|
|
|
|
|
|
|
} |
1127
|
|
|
|
|
|
|
} |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
1; |
1130
|
|
|
|
|
|
|
__END__ |