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

Contents of /trunk/ascend4/TK/units.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, 1 month ago) by aw0a
File MIME type: text/x-tcl
File size: 14745 byte(s)
Setting up web subdirectory in repository
1 # units.tcl
2 # by Benjamin A. Allan and Kirk A. Abbott
3 # Created: January 1994
4 # Part of ASCEND
5 # Revision: $Revision: 1.21 $
6 # Last modified on: $Date: 1998/06/18 15:55:45 $
7 # Last modified by: $Author: mthomas $
8 # Revision control file: $RCSfile: units.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 # Module: units.tcl
30 # Tcl version: 7.1 (Tcl/Tk/XF)
31 # Tk version: 3.4
32 # XF version: 2.2
33 #
34
35 # module contents
36 global moduleList
37 global autoLoadList
38 set moduleList(units.tcl) { .units}
39 set autoLoadList(units.tcl) {0}
40
41 # procedures to show toplevel windows
42
43
44 # procedure to show window ShowWindow.units
45 # proc ShowWindow.units { args}
46 proc ShowWindow.units { args} {
47 # xf ignore me 7
48
49 global env ascUnitVect ascGlobalVect
50
51 StartupSrc.units
52
53 # build widget .units
54 if {"[info procs XFEdit]" != ""} {
55 catch "XFDestroy .units"
56 } {
57 catch "destroy .units"
58 }
59 toplevel .units
60
61 # Ascend patched window manager configurations
62 wm iconify .units
63 wm positionfrom .units user
64 wm sizefrom .units user
65 wm iconname .units {Units}
66 wm minsize .units 100 100
67 wm title .units {A4 Units}
68 wm protocol .units WM_DELETE_WINDOW {Toggle_Remote ascUnitVect}
69
70
71 # build widget .units.entry_frm
72 frame .units.entry_frm \
73 -borderwidth 2 \
74 -relief raised
75
76 # build widget .units.entry_frm.scrollbar2
77 scrollbar .units.entry_frm.scrollbar2 \
78 -command {.units.entry_frm.listbox1 yview}
79
80 # build widget .units.entry_frm.listbox1
81 listbox .units.entry_frm.listbox1 \
82 -relief {raised} \
83 -width 20 \
84 -height 11 \
85 -exportselection 0 \
86 -yscrollcommand {.units.entry_frm.scrollbar2 set} \
87 -font $ascUnitVect(font)
88
89 # pack widget .units.main_frm.atom_frm
90 pack append .units.entry_frm \
91 .units.entry_frm.scrollbar2 {left frame center filly} \
92 .units.entry_frm.listbox1 {top frame center expand fill}
93
94 # build widget .units.entry_setunits
95 frame .units.entry_setunits \
96 -relief {raised}
97
98 # build widget .units.entry_setunits.entry5
99 entry .units.entry_setunits.entry5 \
100 -exportselection 0 \
101 -font $ascUnitVect(font) \
102 -relief {raised} \
103 -textvariable {ascUnitVect(atomdispunits)}
104
105 # build widget .units.entry_setunits.label4
106 label .units.entry_setunits.label4 \
107 -font $ascUnitVect(font) \
108 -height {1} \
109 -padx {0} \
110 -relief {raised} \
111 -text {Set units:}
112
113 # pack widget .units.entry_setunits
114 pack append .units.entry_setunits \
115 .units.entry_setunits.label4 {left frame center} \
116 .units.entry_setunits.entry5 {top frame center expand fill}
117
118
119 # build widget .units.main_frm
120 frame .units.main_frm \
121 -borderwidth {0} \
122 -relief {raised}
123
124 # build widget .units.main_frm.atom_frm
125 frame .units.main_frm.atom_frm \
126 -width 5
127
128 # build widget .units.main_frm.atom_frm.scrollbar2
129 scrollbar .units.main_frm.atom_frm.scrollbar2 \
130 -command {.units.main_frm.atom_frm.listbox1 yview}
131
132 # build widget .units.main_frm.atom_frm.listbox1
133 listbox .units.main_frm.atom_frm.listbox1 \
134 -relief {raised} \
135 -width 20 \
136 -height 10 \
137 -exportselection 0 \
138 -yscrollcommand {.units.main_frm.atom_frm.scrollbar2 set} \
139 -font $ascUnitVect(font)
140
141
142 # pack widget .units.main_frm.atom_frm
143 pack append .units.main_frm.atom_frm \
144 .units.main_frm.atom_frm.scrollbar2 {left frame center filly} \
145 .units.main_frm.atom_frm.listbox1 {top frame center expand fill}
146
147 # build widget .units.main_frm.units_box
148 frame .units.main_frm.units_box \
149 -relief {raised} \
150 -width 20
151
152 # build widget .units.main_frm.units_box.scrollbar2
153 scrollbar .units.main_frm.units_box.scrollbar2 \
154 -command {.units.main_frm.units_box.listbox1 yview}
155
156 # build widget .units.main_frm.units_box.listbox1
157 listbox .units.main_frm.units_box.listbox1 \
158 -relief {raised} \
159 -width 10 \
160 -height 10 \
161 -exportselection 0 \
162 -yscrollcommand {.units.main_frm.units_box.scrollbar2 set} \
163 -font $ascUnitVect(font)
164
165 # pack widget .units.main_frm.units_box
166 pack append .units.main_frm.units_box \
167 .units.main_frm.units_box.scrollbar2 {right frame center filly} \
168 .units.main_frm.units_box.listbox1 {top frame center expand fill}
169
170 # pack widget .units.main_frm
171 pack append .units.main_frm \
172 .units.main_frm.atom_frm {left frame center expand fill} \
173 .units.main_frm.units_box {left frame center expand fill}
174
175 #
176 # Build the menu bar and submenus
177 #
178 menu .units.menubar \
179 -tearoffcommand .UNITS.MENUBAR \
180 -tearoff 0
181
182 # The Display menu
183 menu .units.menubar.disp \
184 -tearoffcommand .UNITS.MENUBAR.DISP \
185 -tearoff 0
186 .units.menubar.disp add command \
187 -label {Show all units} \
188 -underline 0 \
189 -accelerator {Alt-d s} \
190 -command Units_do_ShowAll
191
192 # The File menu
193 menu .units.menubar.file \
194 -tearoffcommand .UNITS.MENUBAR.FILE \
195 -tearoff 0
196 .units.menubar.file add command \
197 -command {Units_do_ReadFile} \
198 -accelerator {Alt-f r} \
199 -underline 0 \
200 -label {Read file ...}
201 .units.menubar.file add command \
202 -command {Units_do_WriteFile} \
203 -underline 0 \
204 -accelerator {Alt-f s} \
205 -label {Save file ...}
206 .units.menubar.file add separator
207 .units.menubar.file add command \
208 -command {Toggle_Remote ascUnitVect} \
209 -accelerator {Alt-f c} \
210 -label {Close window} \
211 -underline 0
212 .units.menubar.file add command \
213 -command {Script_do_Exit} \
214 -label {Exit ASCEND...} \
215 -accelerator {Alt-f e} \
216 -underline 0
217
218 # The Edit menu
219 menu .units.menubar.edit \
220 -tearoffcommand .UNITS.MENUBAR.EDIT \
221 -tearoff 0
222 .units.menubar.edit add command \
223 -command {Units_do_Precision} \
224 -label {Set precision} \
225 -accelerator {Alt-e p} \
226 -underline 4
227 .units.menubar.edit add cascade \
228 -label {Set basic units} \
229 -menu .units.menubar.edit.basic
230
231 # basic units cascade
232 menu .units.menubar.edit.basic \
233 -tearoffcommand .UNITS.MENUBAR.EDIT.BASIC \
234 -tearoff 0
235
236 .units.menubar.edit.basic add cascade \
237 -label {Mass (M)} \
238 -menu {.units.menubar.edit.basic.m0}
239 .units.menubar.edit.basic add cascade \
240 -label {Quantity (Q)} \
241 -menu {.units.menubar.edit.basic.m1}
242 .units.menubar.edit.basic add cascade \
243 -label {Length (L)} \
244 -menu {.units.menubar.edit.basic.m2}
245 .units.menubar.edit.basic add cascade \
246 -label {Time (T)} \
247 -menu {.units.menubar.edit.basic.m3}
248 .units.menubar.edit.basic add cascade \
249 -label {Temperature (TMP)} \
250 -menu {.units.menubar.edit.basic.m4}
251 .units.menubar.edit.basic add cascade \
252 -label {Money (C)} \
253 -menu {.units.menubar.edit.basic.m5}
254 .units.menubar.edit.basic add cascade \
255 -label {Current (E)} \
256 -menu {.units.menubar.edit.basic.m6}
257 .units.menubar.edit.basic add cascade \
258 -label {Light (LUM)} \
259 -menu {.units.menubar.edit.basic.m7}
260 .units.menubar.edit.basic add cascade \
261 -label {Pln. Angle (P)} \
262 -menu {.units.menubar.edit.basic.m8}
263 .units.menubar.edit.basic add cascade \
264 -label {Sol. Angle (S)} \
265 -menu {.units.menubar.edit.basic.m9}
266
267 # build widget .units.menubar.edit.basic.m0
268 menu .units.menubar.edit.basic.m0 \
269 -tearoffcommand .UNITS.MENUBAR.DISP.M0 \
270 -tearoff 0
271 .units.menubar.edit.basic.m0 add command \
272 -label {kilogram}
273
274 # build widget .units.menubar.edit.basic.m1
275 menu .units.menubar.edit.basic.m1 \
276 -tearoffcommand .UNITS.MENUBAR.DISP.M1 \
277 -tearoff 0
278 .units.menubar.edit.basic.m1 add command \
279 -label {mole}
280
281 # build widget .units.menubar.edit.basic.m2
282 menu .units.menubar.edit.basic.m2 \
283 -tearoffcommand .UNITS.MENUBAR.DISP.M2 \
284 -tearoff 0
285 .units.menubar.edit.basic.m2 add command \
286 -label {meter}
287
288 # build widget .units.menubar.edit.basic.m3
289 menu .units.menubar.edit.basic.m3 \
290 -tearoffcommand .UNITS.MENUBAR.DISP.M3 \
291 -tearoff 0
292 .units.menubar.edit.basic.m3 add command \
293 -label {second}
294
295 # build widget .units.menubar.edit.basic.m4
296 menu .units.menubar.edit.basic.m4 \
297 -tearoffcommand .UNITS.MENUBAR.DISP.M4 \
298 -tearoff 0
299 .units.menubar.edit.basic.m4 add command \
300 -label {Kelvin}
301
302 # build widget .units.menubar.edit.basic.m5
303 menu .units.menubar.edit.basic.m5 \
304 -tearoffcommand .UNITS.MENUBAR.DISP.M5 \
305 -tearoff 0
306 .units.menubar.edit.basic.m5 add command \
307 -label {US}
308
309 # build widget .units.menubar.edit.basic.m6
310 menu .units.menubar.edit.basic.m6 \
311 -tearoffcommand .UNITS.MENUBAR.DISP.M6 \
312 -tearoff 0
313 .units.menubar.edit.basic.m6 add command \
314 -label {ampere}
315
316 # build widget .units.menubar.edit.basic.m7
317 menu .units.menubar.edit.basic.m7 \
318 -tearoffcommand .UNITS.MENUBAR.DISP.M7 \
319 -tearoff 0
320 .units.menubar.edit.basic.m7 add command \
321 -label {candela}
322
323 # build widget .units.menubar.edit.basic.m8
324 menu .units.menubar.edit.basic.m8 \
325 -tearoffcommand .UNITS.MENUBAR.DISP.M8 \
326 -tearoff 0
327 .units.menubar.edit.basic.m8 add command \
328 -label {radian}
329
330 # build widget .units.menubar.edit.basic.m9
331 menu .units.menubar.edit.basic.m9 \
332 -tearoffcommand .UNITS.MENUBAR.DISP.M9 \
333 -tearoff 0
334 .units.menubar.edit.basic.m9 add command \
335 -label {steradian}
336
337
338 # The View menu
339 menu .units.menubar.view \
340 -tearoffcommand .UNITS.MENUBAR.VIEW \
341 -tearoff 0
342 .units.menubar.view add command \
343 -label {SI (MKS) set} \
344 -underline 1 \
345 -accelerator {Alt-v i} \
346 -command Units_do_SI
347 .units.menubar.view add command \
348 -label {US Engineering set} \
349 -underline 0 \
350 -accelerator {Alt-v u} \
351 -command Units_do_AE
352 .units.menubar.view add command \
353 -label {CGS set} \
354 -underline 0 \
355 -accelerator {Alt-v c} \
356 -command Units_do_CGS
357 .units.menubar.view add separator
358 .units.menubar.view add command \
359 -command {Units_do_Font} \
360 -accelerator {Alt-v f} \
361 -underline 0 \
362 -label {Font}
363 .units.menubar.view add checkbutton \
364 -offvalue {0} \
365 -onvalue {1} \
366 -variable {ascUnitVect(visibility)} \
367 -accelerator {Alt-v o} \
368 -underline 0 \
369 -label {Open automatically}
370 .units.menubar.view add command \
371 -command {View_Set_Save_Options units} \
372 -underline 0 \
373 -accelerator {Alt-v s} \
374 -label {Save window appearance}
375
376 # The Help menu
377 menu .units.menubar.help \
378 -tearoffcommand .UNITS.MENUBAR.HELP \
379 -tearoff 0
380 .units.menubar.help add command \
381 -command {Units_do_Help} \
382 -label {On Units} \
383 -underline 3
384
385
386 #
387 # Add the menus as cascades of the toplevel's menu;
388 # add the toplevel's menu to the toplevel
389 #
390 .units.menubar add cascade \
391 -menu .units.menubar.file \
392 -label {File} \
393 -underline 0
394 .units.menubar add cascade \
395 -menu .units.menubar.edit \
396 -label {Edit} \
397 -underline 0
398 .units.menubar add cascade \
399 -menu .units.menubar.disp \
400 -label {Display} \
401 -underline 0
402 .units.menubar add cascade \
403 -menu .units.menubar.view \
404 -label {View} \
405 -underline 0
406 .units.menubar add cascade \
407 -menu .units.menubar.help \
408 -label {Help} \
409 -underline 0
410 .units configure \
411 -menu .units.menubar
412
413
414 #
415 # Pack the parts into the .units toplevel
416 #
417 pack append .units \
418 .units.main_frm {top frame center expand fill} \
419 .units.entry_setunits {top frame center fillx} \
420 .units.entry_frm {top frame center fillx}
421
422 EndSrc.units
423
424 if {"[info procs XFEdit]" != ""} {
425 catch "XFMiscBindWidgetTree .units"
426 after 2 "catch {XFEditSetShowWindows}"
427 }
428 }
429
430 # proc DestroyWindow.units {}
431 proc DestroyWindow.units {} {# xf ignore me 7
432 if {"[info procs XFEdit]" != ""} {
433 if {"[info commands .units]" != ""} {
434 global xfShowWindow.units
435 set xfShowWindow.units 0
436 XFEditSetPath .
437 after 2 "XFSaveAsProc .units; XFEditSetShowWindows"
438 }
439 } {
440 catch "destroy .units"
441 update
442 }
443 }
444
445 proc StartupSrc.units {args} {
446 # proc StartupSrc.units {args}
447 # units startup entrance
448 # as much of the C/global dependencies managed here as possible
449 global ascUnitVect ascGlobalVect env
450 if {[catch {set ascUnitVect(windowname)} ]} {
451 set ascUnitVect(minsize) 200x200
452 set ascUnitVect(geometry) 290x420+10+10
453 set ascUnitVect(iconname) Units
454 set ascUnitVect(initialstate) normal
455 set ascUnitVect(font) "-*-*"
456 }
457 if {[catch {set ascGlobalVect(font)} ]} {
458 set ascGlobalVect(font) "-*-*"
459 set ascGlobalVect(labelfont) "-*-*"
460 set ascGlobalVect(tbg) "white"
461 set ascGlobalVect(tfg) "black"
462 set ascGlobalVect(bg) "white"
463 set ascGlobalVect(fg) "black"
464 set ascGlobalVect(afg) "white"
465 set ascGlobalVect(abg) "black"
466 set ascGlobalVect(sfg) "white"
467 set ascGlobalVect(sbg) "black"
468 set ascGlobalVect(visibility) 1
469 set ascGlobalVect(c_loaded) "0"
470 set ascGlobalVect(toolbitmap) \
471 "@$env(ASCENDBITMAPS)/toolAttributes.xbm"
472 }
473 }
474
475 # proc EndSrc.units {}
476 proc EndSrc.units {} {
477 # units startup exit
478 global ascUnitVect
479 global env ascUnitVect ascGlobalVect
480
481 set ascUnitVect(geometry) [sanegeometry $ascUnitVect(geometry)]
482 set minw [lindex [split $ascUnitVect(minsize) x] 0]
483 set minh [lindex [split $ascUnitVect(minsize) x] 1]
484 set gw [lindex [split [lindex [split $ascUnitVect(geometry) +] 0] x] 0]
485 set gh [lindex [split [lindex [split $ascUnitVect(geometry) +] 0] x] 1]
486 set gp "+[lindex [split [split $ascUnitVect(geometry) x] +] 1]+[lindex [split [split $ascUnitVect(geometry) x] +] 2]"
487 if {[expr $gw < $minw]} {set gw $minw}
488 if {[expr $gh < $minh]} {set gh $minh}
489 set gwh "${gw}x${gh}"
490 wm minsize .units $minw $minh
491 wm geometry .units [osgpos $gwh$gp]
492 wm iconname .units $ascUnitVect(iconname)
493 if {$ascUnitVect(initialstate)!="iconic" && \
494 $ascUnitVect(initialstate)!="iconified" && \
495 $ascUnitVect(initialstate)!="withdrawn"} {
496 wm deiconify .units
497 }
498 if {"$ascUnitVect(initialstate)"=="withdrawn"} {
499 wm withdraw .units
500 }
501 }
502
503
504
505 # Internal procedures
506
507 # eof
508 #
509

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