/[ascend]/trunk/ascend4/TK/UnitsProc.tcl
ViewVC logotype

Contents of /trunk/ascend4/TK/UnitsProc.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations) (download) (as text)
Fri Oct 29 20:54:12 2004 UTC (17 years, 6 months ago) by aw0a
File MIME type: text/x-tcl
File size: 17861 byte(s)
Setting up web subdirectory in repository
1 # UnitsProc.tcl: Units window Tcl code
2 # by Benjamin A. Allan and Kirk A. Abbott
3 # Created: January 1994
4 # Part of ASCEND
5 # Revision: $Revision: 1.25 $
6 # Last modified on: $Date: 1998/06/18 15:55:05 $
7 # Last modified by: $Author: mthomas $
8 # Revision control file: $RCSfile: UnitsProc.tcl,v $
9 #
10 # This file is part of the ASCEND Tcl/Tk Interface.
11 #
12 # Copyright (C) 1994-1998 Carnegie Mellon University
13 #
14 # The ASCEND Tcl/Tk Interface is free software; you can redistribute
15 # it and/or modify it under the terms of the GNU General Public
16 # License as published by the Free Software Foundation; either
17 # version 2 of the License, or (at your option) any later version.
18 #
19 # The ASCEND Tcl/Tk Interface is distributed in hope that it will be
20 # useful, but WITHOUT ANY WARRANTY; without even the implied warranty
21 # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 # GNU General Public License for more details.
23 #
24 # You should have received a copy of the GNU General Public License
25 # along with the program; if not, write to the Free Software
26 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the
27 # file named COPYING. COPYING is found in ../compiler.
28
29 #
30 # proc set_Units_Defaults {}
31 #------------------------------------------------------------------------
32 # put Units bindings, etc here
33 #------------------------------------------------------------------------
34 proc set_Units_Defaults {} {
35 # puts "setting units buttons"
36 global env ascUnitVect
37 set ascUnitVect(windowname) .units
38 set ascUnitVect(stdunits) $env(ASCENDDIST)/models/measures.a4l
39 set ascUnitVect(filename) "mysi.a4u"
40 set ascUnitVect(visibility) 1
41 set ascUnitVect(dimnames) "M Q T L TMP C E LUM P S"
42 set ascUnitVect(cascade.M) .units.menubar.edit.basic.m0
43 set ascUnitVect(cascade.Q) .units.menubar.edit.basic.m1
44 set ascUnitVect(cascade.L) .units.menubar.edit.basic.m2
45 set ascUnitVect(cascade.T) .units.menubar.edit.basic.m3
46 set ascUnitVect(cascade.TMP) .units.menubar.edit.basic.m4
47 set ascUnitVect(cascade.C) .units.menubar.edit.basic.m5
48 set ascUnitVect(cascade.E) .units.menubar.edit.basic.m6
49 set ascUnitVect(cascade.LUM) .units.menubar.edit.basic.m7
50 set ascUnitVect(cascade.P) .units.menubar.edit.basic.m8
51 set ascUnitVect(cascade.S) .units.menubar.edit.basic.m9
52 set ascUnitVect(atombox) .units.main_frm.atom_frm.listbox1
53 set ascUnitVect(basicbox) .units.entry_frm.listbox1
54 set ascUnitVect(unitbox) .units.main_frm.units_box.listbox1
55 set ascUnitVect(entrybox) .units.entry_setunits.entry5
56 set ascUnitVect(basefiletypes) {
57 {{New preferred units} {.a4u} }
58 {{Old preferred units} {.uasc} }
59 }
60 set ascUnitVect(filetypes) $ascUnitVect(basefiletypes)
61 set ascUnitVect(lastextension) .a4u
62
63 set ascUnitVect(atomname) ""
64 set ascUnitVect(atomdispunits) "*"
65 Units_update_DisplayBtn
66 Units_do_UpdateAtomBox
67 Units_updatedefaultentry
68 Units_update_ViewBtn
69 # bindings
70 bind .units.entry_setunits.entry5 <Return> {Units_CreateUnit}
71 #tk_listboxSingleSelect $ascUnitVect(atombox)
72 #tk_listboxSingleSelect $ascUnitVect(unitbox)
73 VPane-Bind .units.main_frm atom_frm units_box 10 0.55
74 $ascUnitVect(atombox) config -exportselection 0
75 bind $ascUnitVect(atombox) <B1-ButtonRelease> {
76 set atom ""
77 if {[catch { set atom [$ascUnitVect(atombox) get \
78 [$ascUnitVect(atombox) curselection]] } ]} {
79 Units_do_UpdateAtomBox
80 Units_update_DisplayBtn
81 }
82 if {$atom != ""} {Units_UpdateUnitBox $atom}
83 set ascUnitVect(atomname) $atom
84 }
85 bind $ascUnitVect(unitbox) <B1-ButtonRelease> {
86 set unit ""
87 catch {
88 set unit \
89 [$ascUnitVect(unitbox) get [$ascUnitVect(unitbox) curselection]]
90 }
91 set ascUnitVect(atomdispunits) $unit
92 if {$unit != ""} {Units_UpdateDisplayUnit $unit}
93 }
94 catch {u_setprec $ascUnitVect(precision)}
95
96 ascRightMouseAddCommand $ascUnitVect(unitbox) normal \
97 command -label "Close window" \
98 -underline 0 -command {Toggle_Remote ascUnitVect}
99
100 ascRightMouseAddCommand $ascUnitVect(atombox) normal \
101 command -label "Close window" \
102 -underline 0 -command {Toggle_Remote ascUnitVect}
103
104 }
105 #
106 # proc Units_do_Font {}
107 #---------------------------------------------------------------------
108 # font select button for window
109 #---------------------------------------------------------------------
110 proc Units_do_Font {args} {
111 global ascUnitVect
112 set ascUnitVect(atombox) .units.main_frm.atom_frm.listbox1
113 set ascUnitVect(unitbox) .units.main_frm.units_box.listbox1
114 set font ""
115 if {$args == ""} {
116 set font [ascFontGet]
117 } else {
118 set font $args
119 }
120 if {"$font" == ""} {
121 return;
122 }
123 $ascUnitVect(atombox) configure -font $font
124 $ascUnitVect(unitbox) configure -font $font
125 $ascUnitVect(entrybox) configure -font $font
126 $ascUnitVect(basicbox) configure -font $font
127 set ascUnitVect(font) [lindex [$ascUnitVect(unitbox) configure -font] 4]
128 }
129
130 #
131 # proc Units_Redraw {}
132 #------------------------------------------------------------------------
133 # repaint the units window after ascend.tcl restart
134 #------------------------------------------------------------------------
135 proc Units_Redraw {} {
136 Units_updatedefaultentry
137 Units_do_UpdateAtomBox
138 Units_update_DisplayBtn
139 }
140
141 #
142 # proc Units_updatedefaultentry {}
143 #------------------------------------------------------------------------
144 # updates the string in the bottom entry.
145 #------------------------------------------------------------------------
146 proc Units_updatedefaultentry {} {
147 global ascUnitVect
148 set def [u_getbasedef]
149 $ascUnitVect(basicbox) configure -selectforeground \
150 [$ascUnitVect(basicbox) cget -foreground]
151 $ascUnitVect(basicbox) configure -selectbackground \
152 [$ascUnitVect(basicbox) cget -background]
153 $ascUnitVect(basicbox) delete 0 end
154 $ascUnitVect(basicbox) insert end {Basic units:}
155 foreach j [u_getbasedef] {
156 $ascUnitVect(basicbox) insert end $j
157 }
158 }
159 #
160 # proc Units_setdefunit {basedim unit}
161 #------------------------------------------------------------------------
162 # sets the default display unit for basedim to be unit
163 #------------------------------------------------------------------------
164 proc Units_setdefunit {basedim unit} {
165 global ascUnitVect
166 u_change_baseunit $unit
167 Units_updatedefaultentry
168 HUB_Message_to_HUB UNITSUPDATED
169 }
170 #
171 # proc Units_do_AE {}
172 #------------------------------------------------------------------------
173 # sets the display base units to be american engineering, including dollar
174 #------------------------------------------------------------------------
175 proc Units_do_AE {} {
176 global ascUnitVect
177 catch {Libr_file_get $ascUnitVect(stdunits)} msg
178 if {[catch {
179 foreach i {lbm s ft R A lb_mole cd deg srad US} {
180 u_change_baseunit $i
181 }
182 } err]} {
183 error "Using AE units requires first loading measures.a4l"
184 }
185 Units_updatedefaultentry
186 HUB_Message_to_HUB UNITSUPDATED
187 }
188 #
189 # proc Units_do_CGS {}
190 #------------------------------------------------------------------------
191 # sets the display base units to be cgs (but doesn't reset currency)
192 #------------------------------------------------------------------------
193 proc Units_do_CGS {} {
194 global ascUnitVect
195 catch {Libr_file_get $ascUnitVect(stdunits)} msg
196 if {[catch {
197 foreach i {g s cm K A g_mole cd rad srad CR} {
198 u_change_baseunit $i
199 }
200 } err]} {
201 error "Using CGS units requires first loading measures.a4l"
202 }
203 Units_updatedefaultentry
204 HUB_Message_to_HUB UNITSUPDATED
205 }
206 #
207 # proc Units_do_ShowAll {}
208 #------------------------------------------------------------------------
209 # show all the units
210 #------------------------------------------------------------------------
211 proc Units_do_ShowAll {} {
212 DispClear
213 DispInsert "UNITS"
214 set l [lsort [u_dump 2]]
215 set old_d 0
216 foreach i $l {
217 if {[string compare [lindex $i 0] $old_d]} {
218 lappend l2 ""
219 if {![string length [lindex $i 4]]} {
220 lappend l2 "\t (* DIMENSIONLESS *)"
221 } else {
222 if {[string compare [lindex $i 4] *]} {
223 lappend l2 "\t (* DIMENSION [lindex $i 4] *)"
224 } else {
225 lappend l2 "\t (* DIMENSION WILD *)"
226 }
227 }
228 set old_d [lindex $i 0]
229 }
230 lappend l2 "\t[lindex $i 1]\t =\t \{[lindex $i 2]*[lindex $i 3]\};"
231 }
232 DispInsert "$l2"
233 DispInsert "END UNITS;"
234 newraise .display
235 }
236
237 #
238 # proc Units_do_SI {}
239 #------------------------------------------------------------------------
240 # sets the display base units to be SI mks (but doesn't reset currency)
241 #------------------------------------------------------------------------
242 proc Units_do_SI {} {
243 global ascUnitVect
244 if {[catch {
245 foreach i {kg s m K A mole cd rad srad CR} {
246 u_change_baseunit $i
247 }
248 } err]} {
249 error "Using abbreviated SI units requires first loading measures.a4l"
250 }
251 Units_updatedefaultentry
252 HUB_Message_to_HUB UNITSUPDATED
253 }
254 #
255 # proc Units_do_ReadFile {}
256 #------------------------------------------------------------------------
257 # read a units user specs file
258 #------------------------------------------------------------------------
259 proc Units_do_ReadFile {} {
260 global ascUnitVect ascGlobalVect asc_tkfbox
261 set defaultname "[pwd]"
262 set asc_tkfbox(otherdirs) $ascGlobalVect(librarypathdirs)
263 set filename [tk_getOpenFile \
264 -defaultextension "" \
265 -filetypes $ascUnitVect(filetypes) \
266 -initialdir $defaultname \
267 -parent .units \
268 -title {Read preferred units file}]
269
270 if {$filename == "" || [file isdirectory $filename]} {
271 return 1;
272 } {
273 set newext "[file extension $filename]"
274 if {[catch {source $filename} ]} {error "Problem reading $filename"}
275 set ascUnitVect(filename) $filename
276 set ascUnitVect(lastextension) $newext
277 ascresort_filetypes ascUnitVect lastextension
278 if {$ascUnitVect(visibility)} {
279 newraise .units
280 }
281 update idletasks
282 }
283 Units_updatedefaultentry
284 Units_UpdateUnitBox $ascUnitVect(atomname)
285 HUB_Message_to_HUB UNITSUPDATED
286 }
287 #
288 # proc Units_do_WriteFile {}
289 #------------------------------------------------------------------------
290 # get filename and save user set and fundamental units there
291 #------------------------------------------------------------------------
292 proc Units_do_WriteFile {} {
293 global ascUnitVect
294 set defaultname $ascUnitVect(filename)
295 set filename [tk_getSaveFile \
296 -defaultextension .uasc \
297 -filetypes $ascUnitVect(filetypes) \
298 -initialfile $defaultname \
299 -parent .units \
300 -title {Save preferred units}]
301
302 if {$filename == ""} {
303 return 1;
304 } {
305 if {[catch {Units_Put $filename} ]} {error "Problem writing $filename"}
306 set ascUnitVect(filename) $filename
307 newraise .units
308 update idletasks
309 }
310 }
311 #
312 # proc Units_Put {file}
313 #------------------------------------------------------------------------
314 # write units save file
315 #------------------------------------------------------------------------
316 proc Units_Put {file} {
317 if {[catch {set ufile [open $file w]} ]} {
318 puts "Error writing $file"
319 return
320 }
321 puts $ufile \
322 "\# Units in this file may be changed, saved, and read at any time."
323 puts $ufile \
324 "\# To automatically load it, put the line"
325 puts $ufile "\# \"source $file\" in your ~/.ascendrc"
326 puts $ufile \
327 "\# after the line which sources ascend.tcl."
328 foreach i [u_getbasedef] {
329 puts $ufile "u_change_baseunit $i"
330 }
331 foreach i [u_get_list] {
332 puts $ufile "u_set_user $i"
333 }
334 close $ufile
335 puts stdout "wrote units data to $file"
336 }
337
338 #
339 # proc Units_HandleSourceRead {args}
340 #------------------------------------------------------------------------
341 # Update the atoms box in the units window when library changed.
342 #------------------------------------------------------------------------
343 proc Units_HandleSourceRead {args} {
344 Units_do_UpdateAtomBox
345 Units_update_DisplayBtn
346 global ascUnitVect
347 if {$ascUnitVect(atomname) != ""} {
348 Units_UpdateUnitBox $ascUnitVect(atomname)
349 }
350 }
351 #
352 # proc Units_HandleLibDestroyed {args}
353 #------------------------------------------------------------------------
354 # Update the atoms box in the units window when library deleted.
355 #------------------------------------------------------------------------
356 proc Units_HandleLibDestroyed {args} {
357 Units_do_UpdateAtomBox
358 global ascUnitVect
359 set ascUnitVect(atomname) ""
360 ascclearlist $ascUnitVect(unitbox)
361 }
362
363 #
364 # Units_ChangePrecision {}
365 #------------------------------------------------------------------------
366 # notify the hub of precision change
367 #------------------------------------------------------------------------
368 proc Units_ChangePrecision {} {
369 HUB_Message_to_HUB UNITSUPDATED
370 }
371 #
372 # proc Units_do_Precision {}
373 #------------------------------------------------------------------------
374 # set the display precision with a slider
375 #------------------------------------------------------------------------
376 proc Units_do_Precision {} {
377 global ascUnitVect
378 ascPopSlide popslide [setpos .units 40 40] \
379 4 16 "Display Precision" \
380 Units_ChangePrecision \
381 [u_getprec] u_setprec
382 }
383
384 #
385 # proc Units_UpdateDisplayUnit {unit}
386 #------------------------------------------------------------------------
387 # set the internal display unit for objects of current atom dims to be
388 # existing unit.
389 #------------------------------------------------------------------------
390 proc Units_UpdateDisplayUnit {unit} {
391 global ascUnitVect
392 if {$unit == "default"} {
393 u_clear_user $ascUnitVect(atomname)
394 } else {Units_CreateUnit}
395 HUB_Message_to_HUB UNITSUPDATED
396 }
397 #
398 # proc Units_update_DisplayBtn {}
399 #------------------------------------------------------------------------
400 # this procedure reconfigures the cascade menus under the display button
401 # to show all simple units available.
402 #------------------------------------------------------------------------
403 proc Units_update_DisplayBtn {} {
404 global ascUnitVect
405 foreach dn $ascUnitVect(dimnames) {
406 $ascUnitVect(cascade.$dn) delete 0 last
407 set ulist [u_frombasedim [u_dim2num $dn]]
408 foreach u $ulist {
409 $ascUnitVect(cascade.$dn) add command \
410 -label $u \
411 -command "Units_setdefunit $dn $u"
412 }
413 }
414 }
415
416 #
417 # proc Units_update_ViewBtn {}
418 #------------------------------------------------------------------------
419 # this procedure configures the view button
420 #------------------------------------------------------------------------
421 proc Units_update_ViewBtn {} {
422
423 global ascUnitVect
424 global ascGlobalVect
425
426 set mb .units.menubar.view
427
428 if {$ascGlobalVect(saveoptions) == 1} {
429 $mb entryconfigure 6 -state normal
430 } else {
431 $mb entryconfigure 6 -state disabled
432 }
433 }
434
435 #
436 # proc Units_GetAtomBoxList {}
437 #------------------------------------------------------------------------
438 # sets the list of representative atoms for dimension -> units assignment
439 #------------------------------------------------------------------------
440 proc Units_GetAtomBoxList {} {
441 set udlist {}
442 set ralist ""
443 foreach i [u_getdimatoms] {
444 if {[lsearch $udlist [lindex $i 1]] == "-1"} {
445 lappend udlist [lindex $i 1]
446 lappend ralist [lindex $i 0]
447 }
448 }
449 return $ralist
450 }
451 #
452 # proc Units_do_UpdateAtomBox {}
453 #------------------------------------------------------------------------
454 # stuffs the atom box in the units window.
455 #------------------------------------------------------------------------
456 proc Units_do_UpdateAtomBox {} {
457 global ascUnitVect
458 set ascUnitVect(atomlist) [Units_GetAtomBoxList]
459 ascclearlist $ascUnitVect(atombox)
460 foreach i $ascUnitVect(atomlist) {
461 $ascUnitVect(atombox) insert end $i
462 }
463 }
464
465 #
466 # proc Units_GetUnitBoxList {atom}
467 #------------------------------------------------------------------------
468 # sets the list of representative atoms for dimension -> units assignment
469 #------------------------------------------------------------------------
470 proc Units_GetUnitBoxList {{atom "solver_var"}} {
471 set rulist ""
472 catch {set rulist "default [u_fromatomdim $atom]"}
473 return $rulist
474 }
475 #
476 # proc Units_UpdateUnitBox {atom}
477 #------------------------------------------------------------------------
478 # stuffs the unit box in the units window with units match dim of atom
479 #------------------------------------------------------------------------
480 proc Units_UpdateUnitBox {atom} {
481 global ascUnitVect
482 ascclearlist $ascUnitVect(unitbox)
483 set ascUnitVect(atomdispunits) ""
484 if {$atom!=""} {
485 set ascUnitVect(unitlist) [Units_GetUnitBoxList $atom]
486 foreach i $ascUnitVect(unitlist) {
487 $ascUnitVect(unitbox) insert end $i
488 }
489 set ascUnitVect(atomdispunits) [u_get_units $atom]
490 set i [lsearch $ascUnitVect(unitlist) [u_get_user $atom]]
491 $ascUnitVect(unitbox) select set $i
492 }
493 }
494
495 #
496 # proc Units_CreateUnit {}
497 #------------------------------------------------------------------------
498 # attempts to create a unit definition (from existing ones) and set the
499 # matching dimensionality to have that user defined unit set.
500 #------------------------------------------------------------------------
501 proc Units_CreateUnit {} {
502 global ascUnitVect
503 set units $ascUnitVect(atomdispunits)
504 regsub -all { } $units "" units
505 if {[catch {u_set_user $units} ]} {
506 Units_UpdateUnitBox $ascUnitVect(atomname)
507 error "Unable to parse user specified units. Check spelling."
508 } else {
509 catch {u_change_baseunit $units}
510 }
511 Units_UpdateUnitBox $ascUnitVect(atomname)
512 HUB_Message_to_HUB UNITSUPDATED
513 }
514 #
515 # proc Units_do_Help {}
516 # proc Units_do_BindHelp {}
517 #------------------------------------------------------------------------
518 # units help button calls
519 #------------------------------------------------------------------------
520 proc Units_do_Help {} {
521 Help_button units
522 }
523 proc Units_do_BindHelp {} {
524 Help_button units.help.onunits
525 }

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22