Changeset 1929 for trunk/gui/scripts/units.tcl
- Timestamp:
- Oct 22, 2010, 4:06:10 PM (14 years ago)
- File:
-
- 1 edited
-
trunk/gui/scripts/units.tcl (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/gui/scripts/units.tcl
r1342 r1929 28 28 proc Rappture::Units::define {what args} { 29 29 if {[regexp {(.+)->(.+)} $what match new fndm]} { 30 31 32 33 34 35 36 37 38 39 40 41 42 43 30 if {[llength $args] != 2} { 31 error "wrong # args: should be \"define units1->units2 exprTo exprFrom\"" 32 } 33 # 34 # Convert the units variables embedded in the conversion 35 # expressions to something that Tcl can handle. We'll 36 # use ${number} to represent the variables. 37 # 38 foreach {exprTo exprFrom} $args { break } 39 regsub -all $new $exprTo {${number}} exprTo 40 regsub -all $fndm $exprFrom {${number}} exprFrom 41 42 Rappture::Units::System #auto $new \ 43 -basis [list $fndm $exprTo $exprFrom] 44 44 45 45 } elseif {[regexp {^/?[a-zA-Z]+[0-9]*$} $what]} { 46 47 48 49 50 51 52 53 54 55 56 46 array set opts { 47 -type "" 48 -metric 0 49 } 50 foreach {key val} $args { 51 if {![info exists opts($key)]} { 52 error "bad option \"$key\": should be [join [lsort [array names opts]] {, }]" 53 } 54 set opts($key) $val 55 } 56 eval Rappture::Units::System #auto $what [array get opts] 57 57 } else { 58 58 error "bad units definition \"$what\": should be something like m or /cm3 or A->m" 59 59 } 60 60 } … … 71 71 proc Rappture::Units::convert {value args} { 72 72 array set opts { 73 74 75 73 -context "" 74 -to "" 75 -units "on" 76 76 } 77 77 foreach {key val} $args { 78 79 80 81 78 if {![info exists opts($key)]} { 79 error "bad option \"$key\": should be [join [lsort [array names opts]] {, }]" 80 } 81 set opts($key) $val 82 82 } 83 83 … … 87 87 set value [string trim $value] 88 88 if {![regexp {^([-+]?[0-9]+\.?([0-9]+)?([eEdD][-+]?[0-9]+)?) *(/?[a-zA-Z]+[0-9]*)?$} $value match number dummy1 dummy2 units]} { 89 90 91 92 93 89 set mesg "bad value \"$value\": should be real number with units" 90 if {$opts(-context) != ""} { 91 append mesg " of [Rappture::Units::description $opts(-context)]" 92 } 93 error $mesg 94 94 } 95 95 if {$units == ""} { 96 96 set units $opts(-context) 97 97 } 98 98 … … 103 103 set oldsys [Rappture::Units::System::for $units] 104 104 if {$oldsys == ""} { 105 106 107 108 109 105 set mesg "value \"$value\" has unrecognized units" 106 if {$opts(-context) != ""} { 107 append mesg ".\nShould be units of [Rappture::Units::description $opts(-context)]" 108 } 109 error $mesg 110 110 } 111 111 … … 114 114 # 115 115 if {$opts(-to) == ""} { 116 117 116 # no units -- return the number as is 117 return "$number$units" 118 118 } 119 119 return [$oldsys convert "$number$units" $opts(-to) $opts(-units)] … … 130 130 set sys [Rappture::Units::System::for $units] 131 131 if {$sys == ""} { 132 132 return "" 133 133 } 134 134 set mesg [$sys cget -type] 135 135 set ulist [Rappture::Units::System::all $units] 136 136 if {"" != $ulist} { 137 137 append mesg " ([join $ulist {, }])" 138 138 } 139 139 return $mesg … … 162 162 private common _prefix2factor 163 163 array set _prefix2factor { 164 165 166 167 168 169 170 171 172 173 174 175 164 c 1e-2 165 m 1e-3 166 u 1e-6 167 n 1e-9 168 p 1e-12 169 f 1e-15 170 a 1e-18 171 k 1e+3 172 M 1e+6 173 G 1e+9 174 T 1e+12 175 P 1e+15 176 176 } 177 177 } … … 182 182 itcl::body Rappture::Units::System::constructor {name args} { 183 183 if {![regexp {^/?[a-zA-Z]+[0-9]*$} $name]} { 184 184 error "bad units declaration \"$name\"" 185 185 } 186 186 eval configure $args … … 193 193 # 194 194 if {$basis != ""} { 195 196 197 198 199 200 201 202 203 195 foreach {base exprTo exprFrom} $basis { break } 196 if {![info exists _base($base)]} { 197 error "fundamental system of units \"$base\" not defined" 198 } 199 while {$type == "" && $base != ""} { 200 set obj $_base($base) 201 set type [$obj cget -type] 202 set base [lindex [$obj cget -basis] 0] 203 } 204 204 } 205 205 set _system $name … … 230 230 itcl::body Rappture::Units::System::fundamental {} { 231 231 if {$basis != ""} { 232 233 232 set sys [Rappture::Units::System::for [lindex $basis 0]] 233 return [$sys fundamental] 234 234 } 235 235 return $_system … … 246 246 itcl::body Rappture::Units::System::convert {value newUnits showUnits} { 247 247 if {![regexp {^([-+]?[0-9]+\.?([0-9]+)?([eEdD][-+]?[0-9]+)?) *(/?[a-zA-Z]+[0-9]*)?$} $value match number dummy1 dummy2 units]} { 248 248 error "bad value \"$value\": should be real number with units" 249 249 } 250 250 … … 258 258 set power "1" 259 259 if {$metric && [regexp {^(/?)([cmunpfakMGTP])([a-zA-Z]+)([0-9]*)$} $units match slash prefix base power]} { 260 260 set baseUnits "$slash$base$power" 261 261 } else { 262 262 set baseUnits $units 263 263 } 264 264 if {![string equal $baseUnits $_system] 265 266 265 && ![string equal $baseUnits [lindex $basis 0]]} { 266 error "can't convert value \"$value\": should have units \"$_system\"" 267 267 } 268 268 … … 272 272 # 273 273 if {$prefix != ""} { 274 275 276 277 278 279 280 281 274 if {$power == ""} { 275 set power 1 276 } 277 if {$slash == "/"} { 278 set number [expr {$number/pow($_prefix2factor($prefix),$power)}] 279 } else { 280 set number [expr {$number*pow($_prefix2factor($prefix),$power)}] 281 } 282 282 } 283 283 … … 287 287 # 288 288 if {[string equal $baseUnits [lindex $basis 0]]} { 289 290 289 foreach {base exprTo exprFrom} $basis { break } 290 set number [expr $exprFrom] 291 291 } 292 292 … … 300 300 set power "1" 301 301 if {$metric && [regexp {^(/?)([cmunpfakMGTP])([a-zA-Z]+)([0-9]*)$} $newUnits match slash prefix base power]} { 302 302 set baseUnits "$slash$base$power" 303 303 } else { 304 304 set baseUnits $newUnits 305 305 } 306 306 if {[string equal $baseUnits $_system]} { 307 308 309 310 311 312 313 314 315 316 317 318 319 320 307 if {$prefix != ""} { 308 if {$power == ""} { 309 set power 1 310 } 311 if {$slash == "/"} { 312 set number [expr {$number*pow($_prefix2factor($prefix),$power)}] 313 } else { 314 set number [expr {$number/pow($_prefix2factor($prefix),$power)}] 315 } 316 } 317 if {$showUnits} { 318 return "$number$newUnits" 319 } 320 return $number 321 321 } 322 322 … … 328 328 set base $_system 329 329 if {"" != $basis} { 330 331 330 foreach {base exprTo exprFrom} $basis { break } 331 set number [expr $exprTo] 332 332 } 333 333 … … 341 341 itcl::configbody Rappture::Units::System::basis { 342 342 if {[llength $basis] != 3} { 343 343 error "bad basis \"$name\": should be {units exprTo exprFrom}" 344 344 } 345 345 } … … 350 350 itcl::configbody Rappture::Units::System::metric { 351 351 if {![string is boolean -strict $metric]} { 352 352 error "bad value \"$metric\": should be boolean" 353 353 } 354 354 } … … 369 369 # 370 370 if {[info exists _base($units)]} { 371 371 return $_base($units) 372 372 } else { 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 373 set orig $units 374 if {[regexp {^(/?)[cCmMuUnNpPfFaAkKgGtT](.+)$} $units match slash tail]} { 375 set base "$slash$tail" 376 if {[info exists _base($base)]} { 377 set sys $_base($base) 378 if {[$sys cget -metric]} { 379 return $sys 380 } 381 } 382 383 # check the base part for improper capitalization below... 384 set units $base 385 } 386 387 set matching "" 388 foreach u [array names _base] { 389 if {[string equal -nocase $u $units]} { 390 lappend matching $_base($u) 391 } 392 } 393 if {[llength $matching] == 1} { 394 set sys [lindex $matching 0] 395 # 396 # If we got rid of a metric prefix above, make sure 397 # that the system is metric. If not, then we don't 398 # have a match. 399 # 400 if {[string equal $units $orig] || [$sys cget -metric]} { 401 return $sys 402 } 403 } 404 404 } 405 405 return "" … … 416 416 set sys [Rappture::Units::System::for $units] 417 417 if {$sys == ""} { 418 418 return "" 419 419 } 420 420 421 421 if {"" != [$sys cget -basis]} { 422 422 set basis [lindex [$sys cget -basis] 0] 423 423 } else { 424 424 set basis $units 425 425 } 426 426 427 427 set ulist $basis 428 428 foreach u [array names _base] { 429 430 431 432 433 429 set obj $_base($u) 430 set b [lindex [$obj cget -basis] 0] 431 if {$b == $basis} { 432 lappend ulist $u 433 } 434 434 } 435 435 return $ulist … … 447 447 set sys [for $units] 448 448 if {$sys == ""} { 449 449 return $units 450 450 } 451 451 # note: case-insensitive matching for metric prefix 452 452 if {[regexp {^(/?)([cCmMuUnNpPfFaAkKgGtT]?)([a-zA-Z]+[0-9]+|[a-zA-Z]+)$} $units match slash prefix tail]} { 453 454 455 456 457 458 459 460 453 if {[regexp {^[CUNFAK]$} $prefix]} { 454 # we know that these should be lower case 455 set prefix [string tolower $prefix] 456 } elseif {[regexp {^[GT]$} $prefix]} { 457 # we know that these should be upper case 458 set prefix [string toupper $prefix] 459 } 460 return "$slash$prefix[string trimleft [$sys basic] /]" 461 461 } 462 462 return [$sys basic]
Note: See TracChangeset
for help on using the changeset viewer.
