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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations) (download) (as text)
Fri Oct 29 20:54:12 2004 UTC (20 years, 4 months ago) by aw0a
File MIME type: text/x-tcl
File size: 84247 byte(s)
Setting up web subdirectory in repository
1 # ascplotproc.tcl: a columnar data manipulator
2 # by Benjamin Allan
3 # August 1995
4 # Part of ASCEND
5 # Revision: $Revision: 1.38 $
6 # Last modified on: $Date: 2003/02/06 13:49:43 $
7 # Last modified by: $Author: ballan $
8 # Revision control file: $RCSfile: ascplotproc.tcl,v $
9 #
10 # This file is part of the ASCEND Tcl/Tk Interface.
11 #
12 # Copyright (C) 1995-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 # This file requires the tkTable extension 1.4 or later.
31 #
32 # The idea here is that we can take ASCII numeric data files
33 # in a columnar format and feed various bizarre x/unix plot
34 # programs. If there is direct access to a decent spreadsheet
35 # or real plot package, this isn't needed. Limited spreadsheetlike
36 # functionality is supported.
37 #
38 # Depends:
39 # tkTable widget.
40 # generalk.tcl
41 # templates/Procedures/ascparm.tcl
42 # templates/Procedures/ascoktext.tcl
43 #
44 # global variables:
45 # public:
46 # ascplotvect (an array with many many elements)
47 # private:
48 # plotan$setuid (data arrays)
49 # ascplot_xgraphvect xgraph plot window configuration ascparmpage
50 #
51 # public elements of ascplot_xgraphvect:
52 # command system command for invoking xgraph
53 #
54 # public elements of ascplotvect:
55 # titlefont font for label at the top of the window
56 # textfont font for lists, texts, tables, entries
57 # btnfont font for buttons and misc widgets
58 # textname widget pathname of the message text.
59 # dataname widget pathname of the data table
60 # setsname widget pathname of the set list
61 # varsname widget pathname of the vars list
62 # depname widget pathname of the dependent vars list
63 # indvname widget pathname of the independent var entry
64 # bitmap bitmap name
65 #
66 # private elements:
67 # nfiles no. of files known
68 # file.$i name of ith file
69 # nsets no. of data sets known
70 # set.$j {{filenum} {setnum}} of jth data set
71 # topline.$j initial line of set j
72 # array.$j array name of the global array for the table of set j
73 # cols.$j number of columns presently in data set j
74 # rows.$j number of rows presently in data set j
75 # curset number of the current selected data set
76 # curfile number of the current file, redundant
77 # sel.var current selection indices in the vars listbox
78 # sel.dep current selection indices in the dependent vars listbox
79 # sel.dat current selection indices in the data sets listbox
80 # note: sel.*may be unset if there is no selection
81 # filename latest file attempted name
82 # setctr a number we will use in making up array names
83 # plotter one of {xgraph }, the currently selected plotter.
84 # uplegend boolean value indicating window is up or not
85 # showdata boolean value indicating what data view should do next
86 #
87 # The following info is stored with the data array. aname is
88 # the name in $ascplotvect(array.$set), the name of the data array.
89 # ${aname}(-7,$c) type of column c in set {data, calcexpr}
90 # ${aname}(-6,$c) legend of column c in set
91 # ${aname}(-5,$c) full variable name of column c in set
92 # ${aname}(-4,$vid) column of vid in set
93 # ${aname}(-3,$c) column number, redundant but video
94 # ${aname}(-2,$c) variable id of column c in set
95 # ${aname}(-1,$c) variable units of column c in set
96 # ${aname}($r,-1) row # of row r in set
97 # ${aname}($r,-2) type of row r {data, calcexpr}
98 # Don't forget tcls indirect address! the value of ${aname}(-1,$c)
99 # can only be retrieved as [set ${aname}(-1,$c)] or by otherwise
100 # invoking a second pass on ${aname}(-1,$c) with eval.
101 # A calcexpr is the most recent mathematical expression evaluated
102 # to fill up the row or column. data may have been altered since.
103 #
104 # plot info
105 # This portion of the ascplotvect is compatible with ascParPage.
106 # The dependent vars are plotted as ordered in the dependent box.
107 # ncurves is the number of dependent variables
108 # legend.$c is the legend for curve c
109 # plottitle is the title of the plot
110 # xtitle is the horizontal label x axis
111 # ytitle is the vertical label y axis
112 # Everything else is controlled by the specific plotter parameters.
113 # We try to cook up sane defaults for the titles and legends from the data.
114 #
115
116 proc set_ascplot_defaults {} {
117 global ascplotvect
118 if {0} {
119 # do nothing
120 } else {
121 global ascplotvect ascGlobalVect
122 if {[info exists ascGlobalVect(viewoptions)]} {
123 # steal ascend defaults
124 set ascplotvect(titlefont) $ascGlobalVect(labelfont)
125 set ascplotvect(textfont) $ascGlobalVect(font)
126 set ascplotvect(btnfont) $ascGlobalVect(font)
127 set ascplotvect(bitmap) "$ascGlobalVect(toolbitmap)"
128 } else {
129 set ascplotvect(titlefont) {helvetica 12 bold}
130 set ascplotvect(textfont) {helvetica 12 bold}
131 set ascplotvect(btnfont) {helvetica 12 bold}
132 set ascplotvect(bitmap) "info"
133 }
134 set ascplotvect(dataname) {.ascplot.bot_frm.table_frm.datatable.table1}
135 set ascplotvect(textname) {.ascplot.bot_frm.message.text2}
136 set ascplotvect(setsname) {.ascplot.top_frm.datasets.listbox1}
137 set ascplotvect(varsname) {.ascplot.top_frm.varfrm.varsel.varlist.listbox1}
138 set ascplotvect(depvname) {.ascplot.top_frm.varfrm.varsel.depvar.listbox1}
139 set ascplotvect(indvname) {.ascplot.top_frm.varfrm.indepvar.entry5}
140 set ascplotvect(filename) {obs.dat}
141 set ascplotvect(xgraph_filename) {plot.xgraph}
142 set ascplotvect(entrywidth) 20
143 set ascplotvect(uplegend) 0
144 set ascplotvect(showdata) 1
145 set ascplotvect(array.-1) apv.dummy
146
147 set ascplotvect(plotter) xgraph
148 set ascplotvect(plotterchoices) {xgraph}
149 set ascplotvect(nfiles) 0
150 set ascplotvect(nsets) 0
151 set ascplotvect(curset) -1
152 set ascplotvect(windowname) .ascplot
153 set ascplotvect(winopen) 0
154
155 # parpage plot stuff defaults. can have more legends
156 set ascplotvect(ncurves) 0
157 for {set i 0} {$i < 64} {incr i} {
158 set ascplotvect(legend$i) "legend$i"
159 set ascplotvect(legend$i.type) string
160 set ascplotvect(legend$i.label) "Legend for $i"
161 }
162 set ascplotvect(npages) 1
163 set ascplotvect(grab) 0
164 set ascplotvect(helpcommand) {
165 global ascplotvect
166 OKText .ascplot_help "Which word didn't you understand??" "Doh!!" \
167 0 $ascplotvect(textfont) [getpos .ascplot] 12 40
168 }
169 set ascplotvect(whenokcommand) ascplot_genericok
170 set ascplotvect(title) "Graph Generics"
171 set ascplotvect(toplevel) .ascplot_titles
172 set ascplotvect(namelist) \
173 [list plottitle xtitle ytitle \
174 legend0 legend1 legend2 legend3 \
175 legend4 legend5 legend6 legend7]
176 set ascplotvect(baselist) "plottitle xtitle ytitle"
177 set ascplotvect(xtitle) X
178 set ascplotvect(xtitle.label) "X Axis Title"
179 set ascplotvect(ytitle) Y
180 set ascplotvect(ytitle.label) "Y Axis Title"
181 set ascplotvect(plottitle) AscPlot
182 set ascplotvect(plottitle.label) "Plot Title"
183 }
184 }
185 set_ascplot_defaults
186
187 proc ascplot_setssdef {} {
188 global ascplot_ssvect
189 set ascplot_ssvect(newcolnum) 0
190 set ascplot_ssvect(npages) 1
191 set ascplot_ssvect(grab) 1
192 set ascplot_ssvect(entrywidth) 40
193 set ascplot_ssvect(helpcommand) {ascplot_sshelp}
194 set ascplot_ssvect(whenokcommand) "ascplot_insert col ok"
195 set ascplot_ssvect(title) "Create Data"
196 set ascplot_ssvect(toplevel) .ascplot_sscreate
197 set ascplot_ssvect(namelist) \
198 [list after last dtype formula cancel]
199 set ascplot_ssvect(after) 0
200 set ascplot_ssvect(after.lo) 0
201 set ascplot_ssvect(after.hi) 0
202 set ascplot_ssvect(after.type) int
203 set ascplot_ssvect(after.label) {Insert after Column}
204 set ascplot_ssvect(dtype) data
205 set ascplot_ssvect(dtype.type) string
206 set ascplot_ssvect(dtype.choices) "data formula"
207 set ascplot_ssvect(dtype.label) "Column type"
208 set ascplot_ssvect(formula) {A($r,$c) + 1}
209 set ascplot_ssvect(formula.type) string
210 set ascplot_ssvect(formula.label) Formula
211 set ascplot_ssvect(colformula) {A($r,$c-1) + 1}
212 set ascplot_ssvect(colformula.type) string
213 set ascplot_ssvect(colformula.label) Formula
214 set ascplot_ssvect(rowformula) {A($r-1,$c) + 1}
215 set ascplot_ssvect(rowformula.type) string
216 set ascplot_ssvect(rowformula.label) Formula
217 set ascplot_ssvect(last) 0
218 set ascplot_ssvect(last.type) bool
219 set ascplot_ssvect(last.label) {Insert at end (overrides col)}
220 set ascplot_ssvect(cancellable) 0
221 set ascplot_ssvect(cancel) 0
222 set ascplot_ssvect(cancel.type) bool
223 set ascplot_ssvect(cancel.label) {Forget this insertion}
224 }
225
226
227 # dummy widget info
228 proc ascplot_setdummy {} {
229 global ascplotvect apv.dummy
230 set ascplotvect(curset) -1
231 set ascplotvect(curfile) -1
232 set ascplotvect(nfiles) 1
233 set ascplotvect(nsets) 1
234 set ascplotvect(file.-1) /tmp/dummy.baa
235 set ascplotvect(set.-1) {-1 -1}
236 set ascplotvect(array.-1) apv.dummy
237 set ascplotvect(dummyvar) apv.dummy
238 set ascplotvect(cols.-1) 4
239 set ascplotvect(rows.-1) 4
240 # put data here
241 }
242
243 #
244 # ascplot_seldataset {}
245 #---------------------------------------------------------------------
246 # makes the first mouse
247 # selected set in the dataset list the current working set.
248 #---------------------------------------------------------------------
249 proc ascplot_seldataset {} {
250 global ascplotvect
251 if {![info exists ascplotvect(sel.dat)] || $ascplotvect(sel.dat)==""} {
252 return
253 }
254 # get list index
255 set new [lindex $ascplotvect(sel.dat) 0]
256 # get data set index
257 set new [lindex $ascplotvect(list2set) $new]
258 # make new the current set
259 ascplot_select_set_by_number $new
260 }
261
262 #
263 # ascplot_select_set_by_number {new}
264 #---------------------------------------------------------------------
265 # makes the numbered set the current working set.
266 #---------------------------------------------------------------------
267 proc ascplot_select_set_by_number {new} {
268 global ascplotvect
269 set ascplotvect(curset) $new
270 set ascplotvect(sel.dat) ""
271 set ascplotvect(curfile) \
272 $ascplotvect(file.[lindex $ascplotvect(set.$new) 0])
273 ascplot_showdata 0
274 $ascplotvect(varsname) delete 0 end
275 $ascplotvect(depvname) delete 0 end
276 set ncol "$ascplotvect(cols.$new)"
277 set aname "$ascplotvect(array.$new)"
278 global $aname
279 # make list of col#) shortid longid units
280 for {set i 0} {$i < $ncol} {incr i} {
281 $ascplotvect(varsname) insert end \
282 "$i) [set ${aname}(-2,$i)] [set ${aname}(-5,$i)] [set ${aname}(-1,$i)]"
283 }
284
285 $ascplotvect(varsname) selection clear 0 end
286 catch {
287 $ascplotvect(varsname) selection set 0 0
288 }
289 set ascplotvect(sel.var) 0
290 ascplot_selindependentleft discard
291 ascplot_setlegends
292 ascplot_showdata 1
293 }
294
295 #
296 # proc ascplot_unseldependent {}
297 #---------------------------------------------------------------------
298 # moves lines from right box to end of left box
299 #---------------------------------------------------------------------
300 proc ascplot_unseldependent {} {
301 global ascplotvect
302 set dlist -1
303 if {![info exists ascplotvect(sel.dep)] || $ascplotvect(sel.dep)==""} {
304 return
305 }
306 foreach i $ascplotvect(sel.dep) {
307 $ascplotvect(varsname) insert end [$ascplotvect(depvname) get $i]
308 set dlist [linsert $dlist 0 $i]
309 }
310 foreach i $dlist {
311 if {[expr $i > -1]} {
312 $ascplotvect(depvname) delete $i $i
313 }
314 }
315 set ascplotvect(sel.dep) ""
316 ascplot_setlegends
317 }
318 #
319 # proc ascplot_seldependent {}
320 #---------------------------------------------------------------------
321 # moves lines from left box to end of right box based on mouse
322 #---------------------------------------------------------------------
323 proc ascplot_seldependent {} {
324 global ascplotvect
325 if {![info exists ascplotvect(sel.var)] || $ascplotvect(sel.var)==""} {
326 return
327 }
328 ascplot_seldependent_list $ascplotvect(sel.var)
329 set ascplotvect(sel.var) ""
330 ascplot_setlegends
331 }
332
333 #
334 # proc ascplot_seldependent_list {sellist}
335 #---------------------------------------------------------------------
336 # moves lines from left box to end of right box based on list input.
337 # list must be integers, not {1 end}
338 #---------------------------------------------------------------------
339 proc ascplot_seldependent_list {sellist} {
340 global ascplotvect
341 set dlist -1
342 foreach i $sellist {
343 $ascplotvect(depvname) insert end [$ascplotvect(varsname) get $i]
344 set dlist [linsert $dlist 0 $i]
345 }
346 foreach i $dlist {
347 if {[expr $i > -1]} {
348 $ascplotvect(varsname) delete $i $i
349 }
350 }
351 }
352 #
353 # proc ascplot_showtitles {openclose}
354 #---------------------------------------------------------------------
355 # opens or closes generic titles window when called with <open,close>
356 # if called when already open, redraws in current position.
357 # binds the window so that titles and legends in data arrays stay synced
358 #---------------------------------------------------------------------
359 proc ascplot_showtitles {oc} {
360 global ascplotvect
361 if {$oc== "close" && $ascplotvect(uplegend)} {
362 catch "destroy $ascplotvect(toplevel)"
363 set ascplotvect(uplegend) 0
364 return
365 }
366 if {$oc=="open"} {
367 if {$ascplotvect(uplegend)} {
368 set geom [getpos $ascplotvect(toplevel)]
369 destroy $ascplotvect(toplevel)
370 ascParPage ascplotvect $geom 1
371 } else {
372 ascParPage ascplotvect [setpos .ascplot 20 20] 1
373 set ascplotvect(uplegend) 1
374 }
375 bind $ascplotvect(toplevel) <Any-Leave> {
376 set aname $ascplotvect(array.$ascplotvect(curset))
377 for {set i 0} {$i < $ascplotvect(ncurves)} {incr i} {
378 set col "[lindex $ascplotvect(legend$i.label) 1]"
379 set ${aname}(-6,$col) "$ascplotvect(legend$i)"
380 }
381 }
382 return
383 }
384 }
385 #
386 # proc ascplot_showdata {show}
387 #---------------------------------------------------------------------
388 # makes the array with dataset $ascplotvect(curset) the displayed data
389 # table. If show is 0, only header rows are shown.
390 # if show is 1, shows all data.
391 # Configures menu appropriately
392 #---------------------------------------------------------------------
393 proc ascplot_showdata {show} {
394 global ascplotvect
395 set cs $ascplotvect(curset)
396 if {$show} {
397 $ascplotvect(dataname) configure \
398 -variable $ascplotvect(array.$cs) \
399 -rows [expr $ascplotvect(rows.$cs) + 3] \
400 -cols [expr $ascplotvect(cols.$cs) + 1]
401 .ascplot.menubar.display entryconfigure 0 \
402 -label "Hide data"
403 set ascplotvect(showdata) 0
404 } else {
405 $ascplotvect(dataname) configure \
406 -variable $ascplotvect(array.$cs) \
407 -rows 3 \
408 -cols [expr $ascplotvect(cols.$cs) + 1]
409 .ascplot.menubar.display entryconfigure 0 \
410 -label "Show data"
411 set ascplotvect(showdata) 1
412 }
413 }
414 #---------------------------------------------------------------------
415 #---------------------------------------------------------------------
416 proc ascplot_defineplot {} {
417 ascplot_showtitles open
418 }
419 #---------------------------------------------------------------------
420 #---------------------------------------------------------------------
421 proc ascplot_loadplot {} {
422 error "ascplot_loadplot unimplemented"
423 }
424 #---------------------------------------------------------------------
425 #---------------------------------------------------------------------
426 proc ascplot_updateplot {} {
427 error "ascplot_updateplot unimplemented"
428 }
429 #---------------------------------------------------------------------
430 #---------------------------------------------------------------------
431 proc ascplot_deleteplot {} {
432 error "ascplot_deleteplot unimplemented"
433 }
434 #---------------------------------------------------------------------
435 #---------------------------------------------------------------------
436 proc ascplot_loaddata {} {
437 global ascplotvect
438 set defaultname "[pwd]"
439 set filename [tk_getOpenFile \
440 -defaultextension .dat \
441 -filetypes $ascplotvect(filetypes) \
442 -initialdir $defaultname \
443 -parent .ascplot \
444 -title {Load data file}]
445
446 if {$filename == ""} {
447 return
448 } else {
449 ascplot_parse_file $filename
450 ascplot_drawsets
451 }
452 }
453 #---------------------------------------------------------------------
454 #---------------------------------------------------------------------
455 proc ascplot_savedata {} {
456 error "ascplot_savedata not implemented."
457 }
458 #
459 # proc ascplot_unloaddata {interactive}
460 #---------------------------------------------------------------------
461 # delete data sets. if interactive, prompt for confirmation of
462 # deletion.
463 #---------------------------------------------------------------------
464 proc ascplot_unloaddata {int} {
465 global ascplotvect
466 if {![info exists ascplotvect(sel.dat)] || $ascplotvect(sel.dat)==""} {
467 return
468 }
469 # names to be nuked
470 set killsets ""
471 # set numbers to be nuked
472 set killlist ""
473 # set true if cur to be killed
474 set killcur 0
475 foreach i $ascplotvect(sel.dat) {
476 # get data set index
477 set new "[lindex $ascplotvect(list2set) $i]"
478 lappend killlist $new
479 append killsets "[$ascplotvect(setsname) get $i]\n"
480 if {$new == $ascplotvect(curset)} {
481 set killcur 1
482 }
483 }
484 set ascplotvect(sel.dat) ""
485
486 if {[tk_dialog .question "Delete these data sets?" \
487 $killsets {} 0 OK Cancel] == 0} {
488 if {$killcur} {
489 ascplot_showdata 0
490 set ascplotvect(curset) -1
491 set ascplotvect(curfile) ""
492 $ascplotvect(dataname) configure -variable apv.dummy
493 set ascplotvect(sel.dep) ""
494 set ascplotvect(sel.var) ""
495 set ew $ascplotvect(indvname)
496 $ew configure -state normal
497 $ew delete 0 end
498 $ew configure -state disabled
499 $ascplotvect(depvname) delete 0 end
500 $ascplotvect(varsname) delete 0 end
501 }
502 foreach i $killlist {
503 set ascplotvect(rows.$i) 0
504 set aname "$ascplotvect(array.$i)"
505 global $aname
506 unset $aname
507 set fn [lindex $ascplotvect(set.$i) 0]
508 incr ascplotvect(filecnt.$fn) -1
509 }
510 ascplot_drawsets
511 if {$killcur} {
512 ascplot_setlegends
513 }
514 } else {
515 $ascplotvect(setsname) selection clear 0 end
516 }
517 }
518
519 proc ascplot_reloaddata {int} {
520 # by cf2w. prolly needs checking
521 global ascplotvect
522 # names to be nuked
523 set killsets ""
524 # set numbers to be nuked
525 set killlist ""
526 # set TRUE if cur to be killed
527 set killcur 0
528 foreach i $ascplotvect(sel.dat) {
529 # get data set index
530 set new "[lindex $ascplotvect(list2set) $i]"
531 lappend killlist $new
532 append killsets "[$ascplotvect(setsname) get $i]\n"
533 if {$new == $ascplotvect(curset)} {
534 set killcur 1
535 }
536 }
537 set ascplotvect(sel.dat) ""
538 if {$killcur} {
539 ascplot_showdata 0
540 set ascplotvect(curset) -1
541 set ascplotvect(curfile) ""
542 $ascplotvect(dataname) configure -variable apv.dummy
543 set ascplotvect(sel.dep) ""
544 set ascplotvect(sel.var) ""
545 set ew $ascplotvect(indvname)
546 $ew configure -state normal
547 $ew delete 0 end
548 $ew configure -state disabled
549 $ascplotvect(depvname) delete 0 end
550 $ascplotvect(varsname) delete 0 end
551 }
552 foreach i $killlist {
553 set ascplotvect(rows.$i) 0
554 set aname "$ascplotvect(array.$i)"
555 global $aname
556 unset $aname
557 set fn [lindex $ascplotvect(set.$i) 0]
558 incr ascplotvect(filecnt.$fn) -1
559 }
560 foreach i $killsets {
561 ascplot_parse_file $i
562 ascplot_drawsets
563 }
564 }
565 #---------------------------------------------------------------------
566 #---------------------------------------------------------------------
567 proc ascplot_mergedata {} {
568 error "ascplot_mergedata unimplemented"
569 }
570 #---------------------------------------------------------------------
571 #---------------------------------------------------------------------
572 proc ascplot_selplotter {args} {
573 global ascplotvect
574 if {[lsearch -exact $ascplotvect(plotterchoices) [lindex $args 0] ] > -1} {
575 set ascplotvect(plotter) "[lindex $args 0]"
576 } else {
577 error "Unsupported plotter."
578 }
579 }
580 #---------------------------------------------------------------------
581 #---------------------------------------------------------------------
582 proc ascplot_writegraph {} {
583 global ascplotvect
584 switch $ascplotvect(plotter) {
585 {xgraph} -
586 {xmgr} -
587 {gnuplot} {
588 ascplot_write$ascplotvect(plotter)
589 }
590 default {
591 error "Can't write unsupported graph type."
592 }
593 }
594 }
595 #
596 # proc ascplot_writexgraph
597 #---------------------------------------------------------------------
598 # generates a plot file and saves to a user specified place
599 #---------------------------------------------------------------------
600 proc ascplot_writexgraph {} {
601 global ascplotvect
602 set pattern "*.xgraph"
603 set defaultname $ascplotvect(xgraph_filename)
604 set filename [tk_getSaveFile \
605 -defaultextension .xgraph \
606 -filetypes $ascplotvect(filetypes) \
607 -initialdir $defaultname \
608 -parent .ascplot \
609 -title {Write to which data file?}]
610
611 if {$filename == ""} {
612 return
613 } else {
614 set ascplotvect(xgraph_filename) $filename
615 set file "[ascplot_genxgraph]"
616 if {$file != "" && $file != "err"} {
617 file rename -- $file $filename
618 puts stdout "Wrote $filename"
619 }
620 }
621 }
622 #
623 # proc ascplot_writegnuplot
624 #---------------------------------------------------------------------
625 # generates a plot file and saves to a user specified place
626 #---------------------------------------------------------------------
627 proc ascplot_writegnuplot {} {
628 error "ascplot_writegnuplot: options page not written yet."
629 }
630 #
631 # proc ascplot_writexmgr
632 #---------------------------------------------------------------------
633 # generates a plot file and saves to a user specified place
634 #---------------------------------------------------------------------
635 proc ascplot_writexmgr {} {
636 error "ascplot_writexmgr: options page not written yet."
637 }
638 #
639 # proc ascplot_viewgraph {}
640 #---------------------------------------------------------------------
641 # generate and invoke x program on a graph file.
642 #---------------------------------------------------------------------
643 proc ascplot_viewgraph {} {
644 global ascplotvect
645 set plotcmd ""
646 set file ""
647 switch $ascplotvect(plotter) {
648 {xgraph} {
649 global ascplot_xgraphvect
650 set plotcmd $ascplot_xgraphvect(Command)
651 set file "[ascplot_genxgraph]"
652 }
653 default {
654 error "$ascplotvect(plotter) unsupported"
655 }
656 }
657 if {$file != "" && $file != "err"} {
658 if {[catch {eval "exec" $plotcmd $file &} msg]} {
659 error "Invoking $plotcmd $filename failed. $msg"
660 }
661 } else {
662 error "Unable to generate graph file."
663 }
664 }
665
666 #
667 # proc ascplot_genxgraph {}
668 #---------------------------------------------------------------------
669 # generate an xgraph file in /tmp or TMPDIR and return the filename
670 #---------------------------------------------------------------------
671 proc ascplot_genxgraph {} {
672 global ascplotvect ascplot_xgraphvect env
673 set sdir ""
674 if {[info exists env(TMPDIR)]} {
675 set sdir $env(TMPDIR)
676 } else {
677 set sdir "/tmp"
678 }
679 set file [FileUniqueName "$sdir/ascdiscode"]
680 set fid [open $file w+]
681 ascplot_xgraphpreamble $fid
682 set cs $ascplotvect(curset)
683 set aname $ascplotvect(array.$cs)
684 global $aname
685 set lmax [$ascplotvect(depvname) size]
686 set nr $ascplotvect(rows.$cs)
687 set ew $ascplotvect(indvname)
688 $ew configure -state normal
689 set line "[$ew get]"
690 $ew configure -state disabled
691 set x "[string trim [lindex $line 0] ()]"
692
693 for {set i 0} {$i < $lmax} {incr i} {
694 set line "[$ascplotvect(depvname) get $i]"
695 set c "[string trim [lindex $line 0] ()]"
696 puts $fid "\n\"$ascplotvect(legend$i)\""
697 for {set r 0} {$r < $nr} {incr r} {
698 catch {puts $fid "[set ${aname}($r,$x)] [set ${aname}($r,$c)]"}
699 }
700 }
701 close $fid
702 return $file
703 }
704 proc ascplot_xgraphpreamble {fid} {
705 global ascplot_xgraphvect ascplotvect
706 puts $fid "BarGraph: $ascplot_xgraphvect(BarGraph)"
707 puts $fid "NoLines: $ascplot_xgraphvect(NoLines)"
708 puts $fid "LogX: $ascplot_xgraphvect(LogX)"
709 puts $fid "LogY: $ascplot_xgraphvect(LogY)"
710 puts $fid "BoundBox: $ascplot_xgraphvect(BoundBox)"
711 puts $fid "Ticks: $ascplot_xgraphvect(Ticks)"
712 puts $fid "Markers: $ascplot_xgraphvect(Markers)"
713 puts $fid "PixelMarkers: $ascplot_xgraphvect(PixelMarkers)"
714 puts $fid "LargePixels: $ascplot_xgraphvect(LargePixels)"
715 puts $fid "StyleMarkers: $ascplot_xgraphvect(StyleMarkers)"
716 puts $fid "ReverseVideo: $ascplot_xgraphvect(ReverseVideo)"
717 puts $fid "Debug: $ascplot_xgraphvect(Debug)"
718 puts $fid "XHighLimit: $ascplot_xgraphvect(XHighLimit)"
719 puts $fid "YHighLimit: $ascplot_xgraphvect(YHighLimit)"
720 puts $fid "XLowLimit: $ascplot_xgraphvect(XLowLimit)"
721 puts $fid "YLowLimit: $ascplot_xgraphvect(YLowLimit)"
722 puts $fid "BarWidth: $ascplot_xgraphvect(BarWidth)"
723 puts $fid "BarBase: $ascplot_xgraphvect(BarBase)"
724 puts $fid "BorderSize: $ascplot_xgraphvect(BorderSize)"
725 puts $fid "GridSize: $ascplot_xgraphvect(GridSize)"
726 puts $fid "LineWidth: $ascplot_xgraphvect(LineWidth)"
727 puts $fid "ZeroWidth: $ascplot_xgraphvect(ZeroWidth)"
728 puts $fid "GridStyle: $ascplot_xgraphvect(GridStyle)"
729 puts $fid "ZeroStyle: $ascplot_xgraphvect(ZeroStyle)"
730 puts $fid "TitleText: $ascplotvect(plottitle)"
731 puts $fid "XUnitText: $ascplotvect(xtitle)"
732 puts $fid "YUnitText: $ascplotvect(ytitle)"
733 puts $fid "LabelFont: $ascplot_xgraphvect(LabelFont)"
734 puts $fid "TitleFont: $ascplot_xgraphvect(TitleFont)"
735 puts $fid "Device: $ascplot_xgraphvect(Device)"
736 puts $fid "FileOrDev: $ascplot_xgraphvect(FileOrDev)"
737 puts $fid "Disposition: $ascplot_xgraphvect(Disposition)"
738 puts $fid "Border: $ascplot_xgraphvect(Border)"
739 puts $fid "ZeroColor: $ascplot_xgraphvect(ZeroColor)"
740 puts $fid "0.Style: $ascplot_xgraphvect(Style0)"
741 puts $fid "0.Color: $ascplot_xgraphvect(Color0)"
742 puts $fid "1.Style: $ascplot_xgraphvect(Style1)"
743 puts $fid "1.Color: $ascplot_xgraphvect(Color1)"
744 puts $fid "2.Style: $ascplot_xgraphvect(Style2)"
745 puts $fid "2.Color: $ascplot_xgraphvect(Color2)"
746 puts $fid "3.Style: $ascplot_xgraphvect(Style3)"
747 puts $fid "3.Color: $ascplot_xgraphvect(Color3)"
748 puts $fid "4.Style: $ascplot_xgraphvect(Style4)"
749 puts $fid "4.Color: $ascplot_xgraphvect(Color4)"
750 puts $fid "5.Style: $ascplot_xgraphvect(Style5)"
751 puts $fid "5.Color: $ascplot_xgraphvect(Color5)"
752 puts $fid "6.Style: $ascplot_xgraphvect(Style6)"
753 puts $fid "6.Color: $ascplot_xgraphvect(Color6)"
754 puts $fid "7.Style: $ascplot_xgraphvect(Style7)"
755 puts $fid "7.Color: $ascplot_xgraphvect(Color7)"
756 }
757 #
758 # ascplot_credits {}
759 #---------------------------------------------------------------------
760 # put up a window about whodunnit
761 #---------------------------------------------------------------------
762 proc ascplot_credits {} {
763 global ascplotvect
764 OKText .ascplot_credit "
765 Plot Widget for feeding various graph programs
766 from a standard tabular input file.
767 Supports basic data manipulations in a spreadsheet-like fashion.
768
769 By Benjamin A Allan, August 1995
770 Carnegie Mellon University
771 Engineering Design Research Center
772 ASCEND project. (ballan@cs.cmu.edu)
773 ascend+bb@cs.cmu.edu.
774
775 Thanks also to the authors of
776 Tcl/Tk, xgraph, and tkTable." "Plot Credits" 0 $ascplotvect(textfont) \
777 [getpos .ascplot] 12 40
778 }
779 #---------------------------------------------------------------------
780 #---------------------------------------------------------------------
781 proc ascplot_sources {} {
782 global ascplotvect
783 OKText .ascplot_sources "
784 This widget and associated tools are part of the ASCEND modeling
785 environment available by ftp:
786 ftp.cs.cmu.edu:project/ascend/gnu-ascend.
787 It is also available for standalone use
788 at the same ftp site." "Plot availability" 0 $ascplotvect(textfont) \
789 [getpos .ascplot] 8 40
790 }
791 #
792 # proc ascplot_selindependentleft {args}
793 #---------------------------------------------------------------------
794 # moves the selected variable from var box to independent entry
795 # if args is "discard" forgets the old variable info
796 #---------------------------------------------------------------------
797 proc ascplot_selindependentleft {args} {
798 global ascplotvect
799 set ew $ascplotvect(indvname)
800 if {![info exists ascplotvect(sel.var)] || $ascplotvect(sel.var)==""} {
801 return
802 }
803 set new [lindex $ascplotvect(sel.var) 0]
804 set dlist $new
805 set new [$ascplotvect(varsname) get $new]
806 $ew configure -state normal
807 set old "[$ew get]"
808 if {$old != ""} {
809 if {[info exists args] && $args != "discard"} {
810 $ascplotvect(varsname) insert end $old
811 }
812 $ew delete 0 end
813 }
814 $ew insert end $new
815 $ew configure -state disabled
816 $ascplotvect(varsname) delete $dlist $dlist
817 set ascplotvect(sel.var) ""
818 $ascplotvect(varsname) selection clear 0 end
819 }
820 #
821 # proc ascplot_selindependentright {}
822 #---------------------------------------------------------------------
823 # moves the selected variable from dependent box to independent entry
824 #---------------------------------------------------------------------
825 proc ascplot_selindependentright {} {
826 global ascplotvect
827 set ew $ascplotvect(indvname)
828 if {![info exists ascplotvect(sel.dep)] || $ascplotvect(sel.dep)==""} {
829 return
830 }
831 set new [lindex $ascplotvect(sel.dep) 0]
832 set dlist $new
833 set new [$ascplotvect(depvname) get $new]
834 $ew configure -state normal
835 set old "[$ew get]"
836 if {$old != ""} {
837 $ascplotvect(depvname) insert end $old
838 $ew delete 0 end
839 }
840 $ew insert end $new
841 $ew configure -state disabled
842 $ascplotvect(depvname) delete $dlist $dlist
843 set ascplotvect(sel.dep) ""
844 $ascplotvect(depvname) selection clear 0 end
845 }
846 #---------------------------------------------------------------------
847 #---------------------------------------------------------------------
848 proc ascplot_grill {} {
849 global ascplotvect
850 ascParPage ascplot_$ascplotvect(plotter)vect [getpos .ascplot] 1
851 }
852 #
853 # ascplot_insert {rc args}
854 #---------------------------------------------------------------------
855 # inserts a row or column after ascertaining the sort of
856 # stuff to insert and calculating it if needed.
857 #---------------------------------------------------------------------
858 proc ascplot_insert {rc args} {
859 global ascplotvect
860 global ascplot_ssvect
861 # if no args, pop up dialog initial else process dialog
862 if {![info exists args] || $args == ""} {
863 if {$rc=="row"} {
864 set type Row
865 set ascplot_ssvect(after.hi) $ascplotvect(rows.$ascplotvect(curset))
866 } else {
867 set ascplot_ssvect(after.hi) $ascplotvect(cols.$ascplotvect(curset))
868 set type Column
869 }
870 set ascplot_ssvect(after.label) "Insert after $type"
871 set ascplot_ssvect(formula) "$ascplot_ssvect(${rc}formula)"
872 set ascplot_ssvect(last.label) "Insert at end (overrides $type)"
873 set ascplot_ssvect(dtype.label) "$type type"
874 set ascplot_ssvect(cancel) 0
875 set ascplot_ssvect(whenokcommand) "ascplot_insert $rc ok"
876 ascParPage ascplot_ssvect [setpos .ascplot 20 20] 1
877 return
878 } else {
879 set aname $ascplotvect(array.$ascplotvect(curset))
880 global $aname
881 if {$ascplot_ssvect(cancel)} {
882 return
883 }
884 if {$rc=="row"} {
885 set new $ascplotvect(rows.$ascplotvect(curset))
886 if {$ascplot_ssvect(last) || $ascplot_ssvect(after) > $new} {
887 set ascplot_ssvect(after) [expr $new -1]
888 }
889 set new [expr $ascplot_ssvect(after)+1]
890 ascplot_insertrow $ascplot_ssvect(after)
891 set ${aname}($new,-1) "Row $new"
892 set ${aname}($new,-2) $ascplot_ssvect(dtype)
893 if {$ascplot_ssvect(dtype)=="formula"} {
894 set ${aname}($new,-2) $ascplot_ssvect(rowformula)
895 ascplot_calcrow $new
896 } else {
897 set max $ascplotvect(cols.$ascplotvect(curset))
898 for {set c 0} {$c <= $max } {incr c} {
899 set ${aname}($new,$c) ""
900 }
901 }
902 }
903 if {$rc=="col"} {
904 set new $ascplotvect(cols.$ascplotvect(curset))
905 if {$ascplot_ssvect(last) || $ascplot_ssvect(after) >= $new} {
906 set ascplot_ssvect(after) [expr $new -1]
907 }
908 set new [expr $ascplot_ssvect(after) +1]
909 ascplot_insertcol $ascplot_ssvect(after)
910 set ${aname}(-7,$new) $ascplot_ssvect(dtype)
911 set ${aname}(-6,$new) "NewCol$ascplot_ssvect(newcolnum)"
912 set ${aname}(-5,$new) "NewCol$ascplot_ssvect(newcolnum)"
913 set ${aname}(-4,NewCol$ascplot_ssvect(newcolnum)) $new
914 set ${aname}(-3,$new) "Col $new"
915 set ${aname}(-2,$new) "NewCol$ascplot_ssvect(newcolnum)"
916 set ${aname}(-1,$new) "NewCol$ascplot_ssvect(newcolnum)"
917 incr ascplot_ssvect(newcolnum)
918 if {$ascplot_ssvect(dtype)=="formula"} {
919 set ${aname}(-7,$new) $ascplot_ssvect(colformula)
920 ascplot_calccol $new
921 } else {
922 set max $ascplotvect(rows.$ascplotvect(curset))
923 for {set r 0} {$r <= $max } {incr r} {
924 set ${aname}($r,$new) ""
925 }
926 }
927 }
928 }
929 update
930 }
931 #
932 # proc ascplot_calccol {num}
933 #---------------------------------------------------------------------
934 # calculates and sets the col num cells using the formula stored in
935 # the top edge of the data array.
936 # works top down
937 #---------------------------------------------------------------------
938 proc ascplot_calccol {num} {
939 global ascplotvect
940 set cs $ascplotvect(curset)
941 set an $ascplotvect(array.$cs)
942 global $an
943 set ann "\$$an"
944 set n $ascplotvect(rows.$cs)
945 set f ""
946 set f1 ""
947 if {"[set ${an}(-7,$num)]" == "data"} {
948 error "No formula has been defined for this column."
949 } else {
950 set f "[set ${an}(-7,$num)]"
951 }
952 if { [catch {
953 set c $num
954 for {set r 0} {$r < $n} {incr r} {
955 regsub -all {(A\()([^,]*)(,)([^)]*)(\))} "$f" \
956 {ANAME([expr \2],[expr \4])} f1
957 regsub -all ANAME "$f1" $ann f
958 set q "ERR"
959 catch {set q "[expr $f]"}
960 set ${an}($r,$c) $q
961 }
962 } m]} {
963 error "Enormous error in calculating column."
964 }
965 }
966 #
967 # proc ascplot_calcrow {num}
968 #---------------------------------------------------------------------
969 # calculates and sets the row num cells using the formula stored in
970 # the left edge of the data array.
971 # works left 2 right
972 #---------------------------------------------------------------------
973 proc ascplot_calcrow {num} {
974 global ascplotvect
975 set cs $ascplotvect(curset)
976 set an $ascplotvect(array.$cs)
977 global $an
978 set ann "\$$an"
979 set n $ascplotvect(cols.$cs)
980 set f ""
981 set f1 ""
982 if {"[set ${an}($num,-2)]" == "data"} {
983 error "No formula has been defined for this row."
984 } else {
985 set f "[set ${an}($num,-2)]"
986 }
987 if { [catch {\
988 set r $num
989 for {set c 0} {$c < $n} {incr c} {
990 regsub -all {(A\()([^,]*)(,)([^)]*)(\))} "$f" \
991 {ANAME([expr \2],[expr \4])} f1
992 regsub -all ANAME "$f1" $ann f
993 set q "ERR"
994 catch {set q "[expr $f]"}
995 set ${an}($r,$c) $q
996 }
997 } m]} {
998 error "Enormous error in calculating row."
999 }
1000 }
1001
1002 #
1003 # proc ascplot_ssbinds {}
1004 #---------------------------------------------------------------------
1005 # puts the help message on table bindings
1006 #---------------------------------------------------------------------
1007 proc ascplot_ssbinds {} {
1008 global ascplotvect
1009 OKText .ascplot_ssbinds \
1010 " The Table class bindings that give the following default behaviour:
1011
1012 \[1\] Clicking the mouse button in a cell moves the selection to that cell.
1013
1014 \[2\] The left, right, up and down arrows move the selected cell.
1015
1016 \[3\] Control-leftarrow and Control-rightarrow move the insertion cursor within the cell.
1017
1018 \[4\] Backspace deletes the character before the insertion cursor.
1019
1020 \[5\] Delete deletes the character after the insertion cursor." \
1021 "Table Widget Bindings" 0 $ascplotvect(textfont) [getpos .ascplot] 15 70
1022 }
1023
1024 #
1025 # proc ascplot_sshelp {}
1026 #---------------------------------------------------------------------
1027 # puts the help message for ss use.
1028 #---------------------------------------------------------------------
1029 proc ascplot_sshelp {} {
1030 global ascplotvect
1031 OKText .ascplot_sshelp \
1032 "With the window you define a new column/row of data to be added to the data
1033 set currently displayed. If you wish to not add anything,
1034 you can turn on the Forget button and the add will be canceled when you hit
1035 OK.\n
1036 The column/row added will be inserted where specified unless you turn on the
1037 Insert at end button.\n
1038 The column/row added can be data entered manually,(edit the table
1039 yourself) or by a Tcl-like expression as specified by the Column/Row type.\n
1040 The formula is spreadsheet-like in that we allow absolute addressing and a
1041 form of relative cell addressing.\n
1042 The calculations are not dynamic, that is they are only evaluated when you
1043 explicitly tell us to. We do not intend to write a real spreadsheet as nobody
1044 wants a chapter in our thesis about spreadsheet implementation.\n
1045 Tcl does double precision, integer, and logical arithmetic
1046 just like C. The Tcl math operators are listed at the end.\n
1047 WARNING: All data in Tcl is stored as a string. If there is not
1048 a decimal point followed by a nonzero digit appearing in the cell,
1049 Tcl will assume the number is an integer. This may lead to unexpected
1050 results when division is used. Tcl does follow C-like (FORTRAN-like)
1051 rules when determining the math type of the result of a subexpression.
1052 So, 4/5.1 will return 0.78... while 4/5 returns zero since both are int.\n
1053 Not all the ASCEND math operators are supported by Tcl.\n
1054 Cell addressing examples (A(i,j) is the ijth cell value):\n
1055 A(1,2) --- this is absolute addressing.\n
1056 A(\$r,\$c) --- this is relative addressing. \$r and \$c are the row and column
1057 numbers of the cell in which the calculation is being done.
1058 A(\$r,1) --- this is mixed addressing. (value in cell in col 2 of this row)\n
1059 A(\$r-2,\$c-1) --- this is calculated addressing (value 2 rows up and 1 col left).
1060 Any integer expression is permitted in the subscripts of A.\n
1061 CELL ADDRESSES are those AFTER the row or column is inserted. Take this into
1062 account when writing your formulae.\n
1063 Tcl operators: (all have the same basic semantics as in C)\n
1064 man math in unix should tell you what these mean if you have not C book.\n\n
1065 (,),+,-,*,/,%\n
1066 ~,^,!,&,|,x?y:z\n
1067 <<,>>,<,>,<=,>=,==,!=,&&,||\n
1068 asin() acos() atan() atan2()\n
1069 sin() cos() tan()\n
1070 exp() sinh() cosh() tanh()\n
1071 pow() log() log10()\n
1072 sqrt() hypot() \n
1073 ceil() floor() round() fmod() abs()\n
1074 double() int() (these are casting operators)\n\n
1075 Last updated ballan@cs.cmu.edu 8/19/95." "Creating data" 0 \
1076 $ascplotvect(textfont) [getpos .ascplot] 20 70
1077 }
1078 #
1079 # proc ascplot_insertcol {after}
1080 #---------------------------------------------------------------------
1081 # Insert an empty column after the column number given
1082 # and fix up all the crap that shifts when columns move.
1083 # after should not be >= the number of columns in the data.
1084 #---------------------------------------------------------------------
1085 proc ascplot_insertcol {after} {
1086 global ascplotvect
1087 global ascplot_ssvect
1088 set cset $ascplotvect(curset)
1089 if {$after == $ascplotvect(cols.$cset) -1} {
1090 incr ascplotvect(cols.$cset)
1091 $ascplotvect(dataname) configure \
1092 -cols [expr $ascplotvect(cols.$cset) + 1]
1093 } else {
1094 set aname $ascplotvect(array.$cset)
1095 global $aname
1096 set right $ascplotvect(cols.$cset)
1097 set nr $ascplotvect(rows.$cset)
1098 # $ascplotvect(dataname) batch on // equivalent in 2.x?
1099 # move data, skipping anything in row -4 which is not col indexed
1100 for {set c [expr $right -1]} {$c > $after} {incr c -1} {
1101 for {set r -7} {$r < $nr} {incr r} {
1102 if {$r != -4} {
1103 catch {set ${aname}($r,$right) "[set ${aname}($r,$c)]"}
1104 }
1105 }
1106 set ${aname}(-3,$right) "Col $right"
1107 incr right -1
1108 }
1109 # fix depv
1110 set ll [$ascplotvect(depvname) size]
1111 for {set li 0} {$li < $ll} {incr li} {
1112 set line "[$ascplotvect(depvname) get $li]"
1113 set i "[string trim [lindex $line 0] ()]"
1114 incr i
1115 set line \
1116 "$i) [set ${aname}(-2,$i)] [set ${aname}(-5,$i)] [set ${aname}(-1,$i)]"
1117 $ascplotvect(depvname) delete $li $li
1118 $ascplotvect(depvname) insert $li $line
1119 }
1120 # fix vars
1121 set ll [$ascplotvect(varsname) size]
1122 for {set li 0} {$li < $ll} {incr li} {
1123 set line "[$ascplotvect(varsname) get $li]"
1124 set i "[string trim [lindex $line 0] ()]"
1125 incr i
1126 set line \
1127 "$i) [set ${aname}(-2,$i)] [set ${aname}(-5,$i)] [set ${aname}(-1,$i)]"
1128 $ascplotvect(varsname) delete $li $li
1129 $ascplotvect(varsname) insert $li $line
1130 }
1131 set ew $ascplotvect(indvname)
1132 $ew configure -state normal
1133 set line "[$ascplotvect(indvname) get]"
1134 if {$line != ""} {
1135 set i "[string trim [lindex $line 0] ()]"
1136 if {$i > $after} {
1137 incr i
1138 set line \
1139 "$i) [set ${aname}(-2,$i)] [set ${aname}(-5,$i)] [set ${aname}(-1,$i)]"
1140 $ew delete 0 end
1141 $ew insert end $line
1142 }
1143 }
1144 $ew configure -state disabled
1145 # fix vid2c
1146 set right $ascplotvect(cols.$cset)
1147 for {set c [expr $after +2]} {$c <= $right} {incr c} {
1148 set vid "[set ${aname}(-2,$c)]"
1149 set ${aname}(-4,$vid) "$c"
1150 }
1151 incr ascplotvect(cols.$cset)
1152 $ascplotvect(dataname) configure \
1153 -cols [expr $ascplotvect(cols.$cset) + 1]
1154 # $ascplotvect(dataname) batch off // equivalent in 2.x?
1155 # redraw everything dependent
1156 ascplot_setlegends
1157 update idletasks
1158 }
1159 }
1160 #
1161 # proc ascplot_insertrow {after}
1162 #---------------------------------------------------------------------
1163 # Insert an empty row after the number given
1164 # and fix up all the crap that shifts when rows move.
1165 # after should not be >= the number of rows in the data.
1166 #---------------------------------------------------------------------
1167 proc ascplot_insertrow {after} {
1168 global ascplotvect
1169 global ascplot_ssvect
1170 set cset $ascplotvect(curset)
1171 if {$after == $ascplotvect(rows.$cset) -1} {
1172 incr ascplotvect(rows.$cset)
1173 $ascplotvect(dataname) configure \
1174 -rows [expr $ascplotvect(rows.$cset) + 3]
1175 } else {
1176 set aname $ascplotvect(array.$cset)
1177 global $aname
1178 set bot $ascplotvect(rows.$cset)
1179 set nc $ascplotvect(cols.$cset)
1180 # $ascplotvect(dataname) batch on // equivalent in 2.x?
1181 for {set r [expr $bot -1]} {$r > $after} {incr r -1} {
1182 for {set c -2} {$c < $nc} {incr c} {
1183 catch {set ${aname}($bot,$c) "[set ${aname}($r,$c)]"}
1184 }
1185 set ${aname}($bot,-1) "Row $bot"
1186 incr bot -1
1187 }
1188 incr ascplotvect(rows.$cset)
1189 $ascplotvect(dataname) configure \
1190 -rows [expr $ascplotvect(rows.$cset) + 3]
1191 # $ascplotvect(dataname) batch off // equivalent in 2.x?
1192 update idletasks
1193 }
1194 }
1195 #---------------------------------------------------------------------
1196 #---------------------------------------------------------------------
1197
1198 #---------------------------------------------------------------------
1199 # ASCPLOT UTILITY FUNCTIONS (INTERNAL)
1200 #---------------------------------------------------------------------
1201 #
1202 # proc ascplot_open {}
1203 #---------------------------------------------------------------------
1204 # opens the ascplot window if not already up.
1205 #---------------------------------------------------------------------
1206 proc ascplot_open {} {
1207 global ascplotvect
1208 if {[catch {package require Tktable 2.5} err]} {
1209 error \
1210 "ASC_PLOT cannot locate the tkTable package.\ninternal message: $err"
1211 }
1212 if {![winfo exists .ascplot]} {
1213 ShowWindow.ascplot
1214 ascplot_bindwindow
1215 set ascplotvect(winopen) 1
1216 }
1217 }
1218
1219 #
1220 # proc ascplot_dook {}
1221 #---------------------------------------------------------------------
1222 # the ok button.
1223 #---------------------------------------------------------------------
1224 proc ascplot_dook {} {
1225 global ascplot_xgraphvect
1226 View_Save_SpecialWindow_Values ascplot
1227 ascplot_showtitles close
1228 catch {ascParPageClose ascplot_xgraphvect}
1229 ascplot_destroy "none"
1230 }
1231
1232 #
1233 # proc ascplot_destroy {all}
1234 #---------------------------------------------------------------------
1235 # nukes everything to do with the ascplot except the global array
1236 # ascplotvect. if $all =="all" nuke ascplotvect too.
1237 #---------------------------------------------------------------------
1238 proc ascplot_destroy {all} {
1239 global ascplotvect
1240 set na $ascplotvect(nsets)
1241 for {set i 0} {$i < $na} {incr i} {
1242 global $ascplotvect(array.$i)
1243 catch {unset $ascplotvect(array.$i)}
1244 set ascplotvect(rows.$i) 0
1245 set ascplotvect(cols.$i) 0
1246 }
1247 set ascplotvect(curset) -1
1248 set ascplotvect(nsets) 0
1249 set ascplotvect(nfiles) 0
1250 if {"$all"=="all"} {
1251 unset ascplotvect
1252 }
1253 catch {destroy .ascplot}
1254 set ascplotvect(winopen) 0
1255 }
1256
1257 #
1258 # proc ascplot_get_array_name {}
1259 #---------------------------------------------------------------------
1260 # makes up a unique array name and returns it.
1261 # doesn't check for uniqueness, but what are the odds?
1262 #---------------------------------------------------------------------
1263 proc ascplot_get_array_name {} {
1264 global ascplotvect
1265 if {![info exist ascplotvect(setctr)]} {
1266 set ascplotvect(setctr) 0
1267 }
1268 set an "plotan$ascplotvect(setctr)uid"
1269 global $an
1270 set ${an}(isarray) 1
1271 incr ascplotvect(setctr)
1272 return $an
1273 }
1274 #
1275 #
1276 # proc ascplot_parse_file {filename}
1277 #---------------------------------------------------------------------
1278 # Here we use an idiots machine written in tcl which is linebased.
1279 # This function takes care of the file io checking and figuring out
1280 # where the data goes.
1281 # We use a command called stringcompact which is in C for speed.
1282 # returns < 0 if error. returns nfile (number of new file) OTHERWISE.
1283 #---------------------------------------------------------------------
1284 proc ascplot_parse_file {filename} {
1285 global ascplotvect
1286 set ascplotvect(filename) $filename
1287 if {![file exists $filename]} {
1288 ascplot_message "ERROR File Not Found: $filename"
1289 return -1
1290 }
1291 if {![file readable $filename]} {
1292 ascplot_message "ERROR File Not Readable: $filename"
1293 return -1
1294 }
1295 if {![file isfile $filename]} {
1296 ascplot_message "ERROR File Not Text: $filename"
1297 return -1
1298 }
1299 set nfile $ascplotvect(nfiles)
1300 for {set i 0} {$i < $nfile} {incr i} {
1301 if {"$filename"=="$ascplotvect(file.$i)" && $ascplotvect(filecnt.$i) > 0} {
1302 ascplot_message "ERROR File Already Loaded: $filename\nUse Update instead"
1303 return -1
1304 }
1305 }
1306 set fid [open $filename r]
1307 close $fid
1308 set fid [open $filename r]
1309 set nset $ascplotvect(nsets)
1310 set firstline i
1311 if {[gets $fid firstline]==-1} {
1312 ascplot_message "ERROR File Empty: $filename"
1313 return -1
1314 }
1315 set firstline "[stringcompact $firstline]"
1316 set ascplotvect(file.$nfile) $filename
1317 set ascplotvect(filecnt.$nfile) 0
1318 ascplot_parse_data $fid $nfile $nset $firstline
1319 close $fid
1320 incr ascplotvect(nfiles)
1321 return $nfile
1322 }
1323
1324 #
1325 # proc ascplot_parse_data {fid nfile nset firstline}
1326 #---------------------------------------------------------------------
1327 # the driver for ascplot_parse_data_stage
1328 # calls itself until eof reached. eats 1 data set per call.
1329 #---------------------------------------------------------------------
1330 proc ascplot_parse_data {fid nfile nset fl} {
1331 global ascplotvect
1332 set notdone 1
1333 set emptyset 0
1334 # find set beginning
1335 set ascplotvect(set.$nset) "$nfile $nset"
1336 set c [ascplot_parse_data_stage $fid $nfile $nset top $fl]
1337 set ascplotvect(topline.$nset) "[lindex $c 1]"
1338 set ascplotvect(array.$nset) "[ascplot_get_array_name]"
1339 set aname "$ascplotvect(array.$nset)"
1340 global $aname
1341 if {[lindex $c 0]==-1} {
1342 set ascplotvect(rows.$nset) 0
1343 set ascplotvect(cols.$nset) 0
1344 return
1345 }
1346 # get next line
1347 if {[gets $fid fl]==-1} {
1348 set ascplotvect(rows.$nset) 0
1349 set ascplotvect(cols.$nset) 0
1350 return
1351 }
1352 set fl "[stringcompact $fl]"
1353 # eat titles
1354 set c [ascplot_parse_data_stage $fid $nfile $nset title $fl]
1355 if {[lindex $c 0]==1} {
1356 set ascplotvect(rows.$nset) 0
1357 set ascplotvect(cols.$nset) 0
1358 set emptyset 1
1359 }
1360 if {[lindex $c 0]==-1} {
1361 return
1362 }
1363 set fl "[lindex $c 1]"
1364 # fl should now be first line of column info
1365 # get col names
1366 if {!$emptyset} {
1367 set c [ascplot_parse_data_stage $fid $nfile $nset var $fl]
1368 if {[lindex $c 0]==-1} {
1369 set ascplotvect(rows.$nset) 0
1370 set ascplotvect(cols.$nset) 0
1371 return
1372 }
1373 set fl "[lindex $c 1]"
1374 if {![info exists ${aname}(-2,0)] || \
1375 "[lindex $fl 0]" != "[set ${aname}(-2,0)]" } {
1376 puts stderr "Insane dataset ($nset) found. skipping to next."
1377 set ascplotvect(rows.$nset) 0
1378 set ascplotvect(cols.$nset) 0
1379 set emptyset 1
1380 }
1381 }
1382 # eat to shortid line or whitespace
1383 if {!$emptyset} {
1384 set c [ascplot_parse_data_stage $fid $nfile $nset names $fl]
1385 if {[lindex $c 0]==-1} {
1386 set ascplotvect(rows.$nset) 0
1387 return
1388 }
1389 set cc 0
1390 set lim $ascplotvect(cols.$nset)
1391 foreach i $fl {
1392 if {$cc >= $lim || "$i" != "[set ${aname}(-2,$cc)]"} {
1393 puts stderr "Insane dataset ($nset) found. skipping to next."
1394 set ascplotvect(rows.$nset) 0
1395 set emptyset 1
1396 break
1397 }
1398 incr cc
1399 }
1400 if {[gets $fid fl]==-1} {
1401 set ascplotvect(rows.$nset) 0
1402 return
1403 }
1404 set fl "[stringcompact $fl]"
1405 }
1406 # eat --- line if present
1407 if {!$emptyset} {
1408 set c [ascplot_parse_data_stage $fid $nfile $nset spacer $fl]
1409 if {[lindex $c 0]==-1} {
1410 set ascplotvect(rows.$nset) 0
1411 return
1412 }
1413 if {[llength [lindex $c 1]] != $ascplotvect(cols.$nset)} {
1414 puts stderr "Insane dataset ($nset) found. skipping to next."
1415 set ascplotvect(rows.$nset) 0
1416 set emptyset 1
1417 } else {
1418 if {"[string range "[lindex $c 1]" 0 1]"=="--"} {
1419 if {[gets $fid fl]==-1} {
1420 set ascplotvect(rows.$nset) 0
1421 return
1422 }
1423 set fl "[stringcompact $fl]"
1424 }
1425 }
1426 }
1427 # eat data
1428 if {!$emptyset} {
1429 set c [ascplot_parse_data_stage $fid $nfile $nset data $fl]
1430 incr ascplotvect(filecnt.$nfile)
1431 }
1432 incr nset
1433 incr ascplotvect(nsets)
1434 if {[lindex $c 0]==-1} {
1435 set notdone 0
1436 } else {
1437 set fl "[lindex $c 1]"
1438 }
1439 if {$notdone} {
1440 ascplot_parse_data $fid $nfile $nset $fl
1441 }
1442 }
1443 #
1444 # proc ascplot_parse_data_stage {fid nfile nset mode firstline}
1445 #---------------------------------------------------------------------
1446 # Heres the stupid little linebased parser in TCL
1447 # fid must be an open file identifier
1448 # nfile must be the number of the file we are working on in ascplotvect
1449 # nset must be the number of the set we are attempting to create
1450 # mode is one of several. they include:
1451 # top: we expect we are about to find a new set
1452 # title: we expect to be eating a title line (anything with a : in it)
1453 # that is not a top line
1454 # var: we expect to be eating a variable definition line which is tcl
1455 # list of shortname longname units
1456 # names: we expect to be eating a list of names matching the vars
1457 # spacer: we expect to be eating a list of --- matching the vars
1458 # data: we expect to be eating a list of numbers matching the vars
1459 # firstline is the current first line of the file
1460 #
1461 # The return of ascplot_parse_data_stage is a list pair: code {firstline}
1462 # code 0 means everything ok, code != 0 implies problem.
1463 # Firstline is the line the parser advanced to which caused it to
1464 # return.
1465 # side effects: updates lots of stuff in ascplotvect
1466 # with a successful set read
1467 # codes:
1468 # -1 : EOF reached unexpectedly
1469 # algorithm states (1pass) {the error exits not included}
1470 # top: get DATASET head
1471 # exit condition is line starting with DATASET found
1472 # title: skip titles but backup to top if DATASET seen again
1473 # exit condition is nonblank line w/o a : in it
1474 # var: get list of column header triples {shortid} {longid} {units}
1475 # exit condition is nonblank line without triplet or with shortid
1476 # repeating a previous shortid or apparent shortid starting with --
1477 # names: expect a line of shortid matching var list
1478 # spacer: optional expect a line with nvars elements looking like ---
1479 # data: get a data line nvars long
1480 # exit condition is nonblank line w/o nvars items,
1481 # or a nonnumeric item or EOF
1482 # All lines are hit with stringcompact before analysis, so extra
1483 # whitespace/tabs make no difference. input firstline should be
1484 # compacted.
1485 #---------------------------------------------------------------------
1486 proc ascplot_parse_data_stage {fid nf ns mo fl} {
1487 global ascplotvect
1488 # puts "$mo : $fl"
1489 switch $mo {
1490 {data} {
1491 # puts "apd data" ;#comment normally
1492 set cc $ascplotvect(cols.$ns)
1493 # puts "cc= $cc" ;#comment normally
1494 set rc 0
1495 set notdone 1
1496 set aname $ascplotvect(array.$ns)
1497 global $aname
1498 while {$notdone > 0} {
1499 # puts "$fl" ;#comment normally
1500 if {"[string range $fl 0 6]"=="DATASET"} {
1501 set notdone 0
1502 break
1503 }
1504 set w "[llength $fl]"
1505 # here we want a 3 Case equivalent set of ifs
1506 # Case cc==w parseline, Case cc=0 eat line, default punt
1507 if {$w==$cc} {
1508 set ic 0
1509 set ${aname}($rc,-2) "data"
1510 set ${aname}($rc,-1) "Row $rc"
1511 foreach i $fl {
1512 set ${aname}($rc,$ic) "$i"
1513 incr ic
1514 }
1515 incr rc
1516 if {[gets $fid fl]==-1} {
1517 set notdone -1
1518 }
1519 set fl "[stringcompact $fl]"
1520 } else {
1521 if {$w != 0} {
1522 # default case
1523 set notdone 0
1524 } else {
1525 # empty line case
1526 if {[gets $fid fl]==-1} {
1527 set notdone -1
1528 }
1529 set fl "[stringcompact $fl]"
1530 }
1531 }
1532 # endwhile
1533 }
1534 set ascplotvect(rows.$ns) $rc
1535 return [list $notdone $fl]
1536 # end data case
1537 }
1538 {var} {
1539 # puts "apd var $fl"
1540 set ascplotvect(cols.$ns) 0
1541 set cc 0
1542 set firstid ""
1543 global $ascplotvect(array.$ns)
1544 set aname $ascplotvect(array.$ns)
1545 if {"$fl"!=""} {
1546 if {[llength $fl]!=3} {
1547 return [list 1 $fl]
1548 } else {
1549 set vid [lindex $fl 0]
1550 set ${aname}(-7,$cc) "data"
1551 set ${aname}(-6,$cc) "[lrange $fl 1 2]"
1552 set ${aname}(-5,$cc) "[lindex $fl 1]"
1553 set ${aname}(-4,$vid) "$cc"
1554 set ${aname}(-3,$cc) "Col $cc"
1555 set ${aname}(-2,$cc) "$vid"
1556 set ${aname}(-1,$cc) "[lindex $fl 2]"
1557 set firstid $vid
1558 incr cc
1559 }
1560 }
1561 while {[gets $fid fl]!=-1} {
1562 set fl "[stringcompact $fl]"
1563 # puts "varwhile $fl"
1564 if {"$fl"==""} {
1565 continue
1566 }
1567 set vid "[lindex $fl 0]"
1568 if {[llength $fl]!=3 || "$vid"=="$firstid" || \
1569 "--"=="[string range $vid 0 1]"} {
1570 set ascplotvect(cols.$ns) $cc
1571 return [list 0 $fl]
1572 } else {
1573 set ${aname}(-7,$cc) "data"
1574 set ${aname}(-6,$cc) "[lrange $fl 1 2]"
1575 set ${aname}(-5,$cc) "[lindex $fl 1]"
1576 set ${aname}(-4,$vid) "$cc"
1577 set ${aname}(-3,$cc) "Col $cc"
1578 set ${aname}(-2,$cc) "$vid"
1579 set ${aname}(-1,$cc) "[lindex $fl 2]"
1580 incr cc
1581 }
1582 }
1583 set ascplotvect(cols.$ns) $cc
1584 return [list 0 $fl]
1585 # END var case
1586 }
1587 {title} {
1588 # puts "apd title"
1589 set skip 0
1590 set data 0
1591 while {[string first : $fl] > -1 && \
1592 "[string range $fl 0 6]"!="DATASET"} {
1593 if {[gets $fid fl]==-1} {
1594 return {-1 {}}
1595 }
1596 set fl "[stringcompact $fl]"
1597 incr skip
1598 }
1599 # puts "skipped $skip title lines"
1600 if {"[string range $fl 0 6]"!="DATASET"} {
1601 return "[list 0 $fl]"
1602 } else {
1603 return "[list 1 $fl]"
1604 }
1605 # END title case
1606 }
1607 {top} {
1608 # puts "apd top"
1609 set ascplotvect(rows.$ns) 0
1610 set skip 0
1611 while {"[string range $fl 0 6]"!="DATASET"} {
1612 if {[gets $fid fl]==-1} {
1613 return {-1 {}}
1614 }
1615 set fl "[stringcompact $fl]"
1616 incr skip
1617 }
1618 # puts "skipped $skip lines"
1619 return [list 0 $fl]
1620 # END top case
1621 }
1622 {names} -
1623 {spacer} {
1624 # puts "apd $mo"
1625 while {"$fl"==""} {
1626 if {[gets $fid fl]==-1} {
1627 return {-1 {}}
1628 }
1629 set fl "[stringcompact $fl]"
1630 }
1631 return [list 0 $fl]
1632 # END names/spacer cases
1633 }
1634 default {
1635 puts "apd unknown mode"
1636 return {1 {}}
1637 }
1638 }
1639 }
1640
1641 #
1642 # proc ascplot_drawsets {}
1643 #---------------------------------------------------------------------
1644 # redraws the listbox for data sets. deleted/empty data sets are
1645 # not shown. updates indexing arrays which convert list# to set # and vv.
1646 # works with data sets indexed starting at 0
1647 #---------------------------------------------------------------------
1648 proc ascplot_drawsets {} {
1649 global ascplotvect
1650 set ascplotvect(list2set) ""
1651 set nsets $ascplotvect(nsets)
1652 set lc 0
1653 $ascplotvect(setsname) delete 0 end
1654 for {set i 0} {$i < $nsets} {incr i} {
1655 if {$ascplotvect(rows.$i) > 0} {
1656 lappend ascplotvect(list2set) $i
1657 set j "[lindex $ascplotvect(set.$i) 0]"
1658 set line \
1659 "($i) [file tail $ascplotvect(file.$j)] \{$ascplotvect(topline.$i)\}"
1660 $ascplotvect(setsname) insert end $line
1661 }
1662 }
1663 }
1664 #
1665 # proc ascplot_setlegends {}
1666 #---------------------------------------------------------------------
1667 # updates the legends from the array names for them based on the current
1668 # set of dependent variables.
1669 #---------------------------------------------------------------------
1670 proc ascplot_setlegends {} {
1671 global ascplotvect
1672 set aname $ascplotvect(array.$ascplotvect(curset))
1673 global $aname
1674 global ascplot_xgraphvect
1675 if {[winfo depth .]==1} {
1676 set mono 1
1677 } else {
1678 set mono 0
1679 }
1680 set pp ""
1681 catch {set pp "$ascplotvect(plotter)"}
1682 set lmax [$ascplotvect(depvname) size]
1683 set ascplotvect(ncurves) $lmax
1684 set ascplotvect(namelist) "$ascplotvect(baselist)"
1685 set ascplotvect(cancellable) 0
1686 set cmax 0
1687 switch $pp {
1688 {xgraph} {
1689 if {$mono} {
1690 set cmax 8
1691 } else {
1692 set cmax 64
1693 }
1694 }
1695 default {
1696 error "No plotter selected"
1697 }
1698 }
1699 for {set i 0} {$i < $lmax} {incr i} {
1700 set line "[$ascplotvect(depvname) get $i]"
1701 set col "[string trim [lindex $line 0] ()]"
1702 set ascplotvect(legend$i) "[set ${aname}(-6,$col)]"
1703 set ascplotvect(legend$i.label) "Column $col legend"
1704 lappend ascplotvect(namelist) "legend$i"
1705 }
1706 if $ascplotvect(uplegend) {
1707 ascplot_showtitles open
1708 }
1709 update
1710 if {$lmax > $cmax} {
1711 error \
1712 "Number of dependent variables ($lmax) > distinguishable curves ($cmax)"
1713 }
1714 }
1715 #
1716 # proc ascplot_message {m}
1717 #---------------------------------------------------------------------
1718 # sets the plot message to m, clearing any previous
1719 #---------------------------------------------------------------------
1720 proc ascplot_message {m} {
1721 global ascplotvect
1722 $ascplotvect(textname) delete 1.0 end
1723 $ascplotvect(textname) insert end "HINT:\n"
1724 $ascplotvect(textname) insert end $m
1725 }
1726
1727 #
1728 # proc ascplot_message_append {m}
1729 #---------------------------------------------------------------------
1730 # appends the plot message with \n$m
1731 #---------------------------------------------------------------------
1732 proc ascplot_message_append {m} {
1733 global ascplotvect
1734 $ascplotvect(textname) insert end "\n$m"
1735 }
1736
1737 #
1738 # proc ascplot_bindwindow {}
1739 #---------------------------------------------------------------------
1740 # sets up bindings on .ascplot widgets.
1741 # sets up defaults on xgraphvect
1742 #---------------------------------------------------------------------
1743 proc ascplot_bindwindow {} {
1744 global ascplotvect
1745
1746 set ascplotvect(filetypes) {
1747 {{ASCII data} {.dat} }
1748 {{GNUplot} {.gnuplot .gpl} }
1749 {{xgraph} {.xgraph .xg} }
1750 {{ASCII data} {.dat} }
1751 {{Most} {.*} }
1752 {{All} {*} }
1753 }
1754
1755 # kill all the selection exports
1756 $ascplotvect(varsname) configure -exportselection 0
1757 $ascplotvect(depvname) configure -exportselection 0
1758 $ascplotvect(indvname) configure -exportselection 0
1759 $ascplotvect(setsname) configure -exportselection 0
1760 $ascplotvect(textname) configure -exportselection 0
1761
1762 # bind to raise window from label or messagebox
1763 bind $ascplotvect(textname) <B1-ButtonRelease> {raise .ascplot}
1764
1765 bind $ascplotvect(depvname) <Any-Leave> {
1766 global ascplotvect
1767 set ascplotvect(sel.dep) "[%W curselection]"
1768 }
1769 bind $ascplotvect(setsname) <Any-Leave> {
1770 global ascplotvect
1771 set ascplotvect(sel.dat) "[%W curselection]"
1772 }
1773 bind $ascplotvect(setsname) <Double-1> {
1774 %W select set [%W nearest %y]
1775 set ascplotvect(sel.dat) "[%W curselection]"
1776 ascplot_seldataset
1777 }
1778 bind $ascplotvect(varsname) <Any-Leave> {
1779 global ascplotvect
1780 set ascplotvect(sel.var) "[%W curselection]"
1781 }
1782 bind $ascplotvect(dataname) <Any-Enter> {
1783 ascplot_widget_message %W
1784 }
1785 bind $ascplotvect(setsname) <Any-Enter> {
1786 ascplot_widget_message %W
1787 }
1788 bind $ascplotvect(varsname) <Any-Enter> {
1789 ascplot_widget_message %W
1790 }
1791 bind $ascplotvect(depvname) <Any-Enter> {
1792 ascplot_widget_message %W
1793 }
1794 bind $ascplotvect(indvname) <Any-Enter> {
1795 ascplot_widget_message %W
1796 }
1797 bind .ascplot.top_frm.varfrm.varsel.ctrbtns.btop <Any-Enter> {
1798 ascplot_widget_message %W
1799 }
1800 bind .ascplot.top_frm.varfrm.varsel.ctrbtns.bmid <Any-Enter> {
1801 ascplot_widget_message %W
1802 }
1803 bind .ascplot.top_frm.varfrm.varsel.ctrbtns.bleft <Any-Enter> {
1804 ascplot_widget_message %W
1805 }
1806 bind .ascplot.top_frm.varfrm.varsel.ctrbtns.bright <Any-Enter> {
1807 ascplot_widget_message %W
1808 }
1809 trace variable ascplotvect(curset) w ascplot_ablebtns
1810 ascplot_disableunimplemented
1811 # Pane binding the first one seems to mess up the window. don't know why.
1812 # HPane-Bind .ascplot top_frm bot_frm 12 0.98
1813 HPane-Bind .ascplot.top_frm datasets varfrm 15 0.98
1814 # set a min pixel height to avoid tk core dump in message textbox
1815 # set minpix [.ascplot.bot_frm.message lineheight] dont work
1816 # HPane-Bind .ascplot.bot_frm message table_frm 15 0.98 $minpix
1817 # kluge
1818 HPane-Bind .ascplot.bot_frm message table_frm 15 0.98 17
1819 ascplot_init_widgets
1820 }
1821 proc ascplot_ablebtns {n1 n2 op} {
1822 global ascplotvect
1823 if {[winfo exists .ascplot]} {
1824 if {$ascplotvect(curset) >= 0} {
1825 .ascplot.menubar.execute entryconfigure 0 -state normal
1826 .ascplot.menubar.execute entryconfigure 1 -state normal
1827 .ascplot.menubar.execute entryconfigure 3 -state normal
1828 .ascplot.menubar.execute entryconfigure 4 -state normal
1829 .ascplot.menubar.execute entryconfigure 5 -state normal
1830 .ascplot.menubar.execute entryconfigure 6 -state normal
1831 .ascplot.menubar.file entryconfigure 2 -state normal
1832 .ascplot.menubar.edit entryconfigure 0 -state normal
1833 .ascplot.menubar.display entryconfigure 0 -state normal
1834 .ascplot.menubar.display entryconfigure 2 -state normal
1835 update
1836 } else {
1837 .ascplot.menubar.execute entryconfigure 0 -state disabled
1838 .ascplot.menubar.execute entryconfigure 1 -state disabled
1839 .ascplot.menubar.execute entryconfigure 3 -state disabled
1840 .ascplot.menubar.execute entryconfigure 4 -state disabled
1841 .ascplot.menubar.execute entryconfigure 5 -state disabled
1842 .ascplot.menubar.execute entryconfigure 6 -state disabled
1843 .ascplot.menubar.edit entryconfigure 0 -state disabled
1844 .ascplot.menubar.display entryconfigure 0 -state disabled
1845 .ascplot.menubar.display entryconfigure 2 -state disabled
1846 }
1847 }
1848 }
1849 #
1850 # proc ascplot_widget_message {w}
1851 #---------------------------------------------------------------------
1852 # sets the text message that goes with widget w.
1853 #---------------------------------------------------------------------
1854 proc ascplot_widget_message {w} {
1855 global ascplotvect
1856 if {"$w"=="$ascplotvect(textname)"} {
1857 ascplot_message "Information about the current box or button appears here."
1858 return
1859 }
1860 if {"$w"=="$ascplotvect(dataname)"} {
1861 ascplot_message \
1862 "Spreadsheet-like list of data in the selected set shown here when requested
1863 from Display menu."
1864 return
1865 }
1866 if {"$w"=="$ascplotvect(setsname)"} {
1867 ascplot_message \
1868 "List of currently loaded data sets. Select a set to use by double clicking
1869 mouse button one (One is normally the left mouse button.) Large data sets take
1870 a fair amount of memory and should be unloaded once they are no longer needed."
1871 return
1872 }
1873 if {"$w"=="$ascplotvect(varsname)"} {
1874 ascplot_message \
1875 "List of unused variables in the data set. Each appears as:
1876 Col# colid varname varunits.
1877 To make a curve of the variable, select it and hit the >> button."
1878 return
1879 }
1880 if {"$w"=="$ascplotvect(depvname)"} {
1881 ascplot_message "List of variables to be plotted on the Y axis.
1882 To remove a variable from the list, select it and hit the << button."
1883 return
1884 }
1885 if {"$w"=="$ascplotvect(indvname)"} {
1886 ascplot_message \
1887 "The independent variable in the plot. This can be changed by selecting a new
1888 one from either list and hitting that list's \"V\" button in the center to
1889 trade with the independent variable."
1890 return
1891 }
1892 if {"$w"==".ascplot.top_frm.varfrm.varsel.ctrbtns.btop"} {
1893 ascplot_message \
1894 "Adds currently selected unused variable to the plotted var list."
1895 return
1896 }
1897 if {"$w"==".ascplot.top_frm.varfrm.varsel.ctrbtns.bmid"} {
1898 ascplot_message \
1899 "Moves currently selected plotted vars to the unused list."
1900 return
1901 }
1902 if {"$w"==".ascplot.top_frm.varfrm.varsel.ctrbtns.bleft"} {
1903 ascplot_message \
1904 "Makes first currently selected unused variable the x axis variable."
1905 return
1906 }
1907 if {"$w"==".ascplot.top_frm.varfrm.varsel.ctrbtns.bright"} {
1908 ascplot_message \
1909 "Makes first selected plotted y variable into the x variable."
1910 return
1911 }
1912 error "ascplot_widget_message called with bad widget $w"
1913 }
1914 #
1915 # proc ascplot_init_widgets {}
1916 #---------------------------------------------------------------------
1917 # call ascplot_init_widgets after loading widgets and initing plot window
1918 #---------------------------------------------------------------------
1919 proc ascplot_init_widgets {} {
1920 global ascplotvect AscConfirm ascParPageVect
1921 # file select
1922 # confirm button
1923 set AscConfirm(font) $ascplotvect(btnfont)
1924 # parms page
1925 set ascParPageVect(btn_font) $ascplotvect(btnfont)
1926 set ascParPageVect(lbl_font) $ascplotvect(btnfont)
1927 ascplot_setxgraphdef
1928 ascplot_setssdef
1929 }
1930 #
1931 # proc ascplot_disableunimplemented {}
1932 #---------------------------------------------------------------------
1933 # disables all unimplemented buttons and startup unwanted buttons.
1934 #---------------------------------------------------------------------
1935 proc ascplot_disableunimplemented {} {
1936 # no display.loadoldplot
1937 .ascplot.menubar.display entryconfigure 3 -state disabled
1938 .ascplot.menubar.display entryconfigure 4 -state disabled
1939 .ascplot.menubar.display entryconfigure 5 -state disabled
1940 # no xmgr/gnuplot
1941 .ascplot.menubar.options.graph entryconfigure 1 -state disabled
1942 .ascplot.menubar.options.graph entryconfigure 2 -state disabled
1943 # no save data set or unload
1944 .ascplot.menubar.file entryconfigure 1 -state disabled
1945 .ascplot.menubar.file entryconfigure 2 -state disabled
1946 .ascplot.menubar.edit entryconfigure 0 -state disabled
1947
1948 # disable plotting/calculating until data exists
1949 .ascplot.menubar.execute entryconfigure 0 -state disabled
1950 .ascplot.menubar.execute entryconfigure 1 -state disabled
1951 .ascplot.menubar.execute entryconfigure 3 -state disabled
1952 .ascplot.menubar.execute entryconfigure 4 -state disabled
1953 .ascplot.menubar.execute entryconfigure 5 -state disabled
1954 .ascplot.menubar.execute entryconfigure 6 -state disabled
1955 # disable showdata until data exists
1956 .ascplot.menubar.display entryconfigure 0 -state disabled
1957 .ascplot.menubar.display entryconfigure 2 -state disabled
1958 }
1959
1960 #
1961 # proc ascplot_genericok {}
1962 #---------------------------------------------------------------------
1963 # rescues any legend info that has been changed interactively for later
1964 # reuse.
1965 #---------------------------------------------------------------------
1966 proc ascplot_genericok {} {
1967 global ascplotvect
1968 set aname $ascplotvect(array.$ascplotvect(curset))
1969 for {set i 0} {$i < $ascplotvect(ncurves)} {incr i} {
1970 set col "[lindex $ascplotvect(legend$i.label) 1]"
1971 set ${aname}(-6,$col) "$ascplotvect(legend$i)"
1972 }
1973 # mark window as down, as it is about to be
1974 set ascplotvect(uplegend) 0
1975 }
1976 #---------------------------------------------------------------------
1977 #---------------------------------------------------------------------
1978 proc ascplot_xgraphok {} {
1979 global ascplotvect
1980 set ascplotvect(upxgraph) 0
1981 }
1982 #
1983 # proc ascplot_setxgraphdef {}
1984 #---------------------------------------------------------------------
1985 # here we set the defaults for ascplot_xgraphvect
1986 # most are just as defaulted in by xgraph as shown with xgraph -db
1987 #---------------------------------------------------------------------
1988 proc ascplot_setxgraphdef {} {
1989 global ascplot_xgraphvect
1990 set ascplot_xgraphvect(namelist) \
1991 [list \
1992 BarGraph NoLines LogX LogY BoundBox Ticks \
1993 Markers PixelMarkers LargePixels StyleMarkers ReverseVideo Debug \
1994 XLowLimit XHighLimit YLowLimit YHighLimit \
1995 BarWidth BarBase \
1996 BorderSize GridSize LineWidth ZeroWidth GridStyle ZeroStyle \
1997 LabelFont TitleFont \
1998 Device FileOrDev Disposition \
1999 Style0 Style1 Style2 Style3 Style4 Style5 Style6 Style7 \
2000 Color0 Color1 Color2 Color3 Color4 Color5 Color6 Color7 \
2001 Border ZeroColor Command]
2002 set ascplot_xgraphvect(title) "XGraph Control"
2003 set ascplot_xgraphvect(cancellable) 1
2004 set ascplot_xgraphvect(toplevel) ".xgraph"
2005 set ascplot_xgraphvect(maxlines) "20"
2006 set ascplot_xgraphvect(entrywidth) "40"
2007 set ascplot_xgraphvect(npages) "4"
2008 set ascplot_xgraphvect(grab) "0"
2009 set ascplot_xgraphvect(helpcommand) "error {See the XGraph man page}"
2010 set ascplot_xgraphvect(whenokcommand) "ascplot_xgraphok"
2011 # page layout
2012 set ascplot_xgraphvect(BarGraph.page) 1
2013 set ascplot_xgraphvect(NoLines.page) 1
2014 set ascplot_xgraphvect(LogX.page) 1
2015 set ascplot_xgraphvect(LogY.page) 1
2016 set ascplot_xgraphvect(XHighLimit.page) 1
2017 set ascplot_xgraphvect(YHighLimit.page) 1
2018 set ascplot_xgraphvect(XLowLimit.page) 1
2019 set ascplot_xgraphvect(YLowLimit.page) 1
2020 set ascplot_xgraphvect(ReverseVideo.page) 1
2021 set ascplot_xgraphvect(Debug.page) 1
2022 set ascplot_xgraphvect(BoundBox.page) 2
2023 set ascplot_xgraphvect(Ticks.page) 2
2024 set ascplot_xgraphvect(Markers.page) 2
2025 set ascplot_xgraphvect(PixelMarkers.page) 2
2026 set ascplot_xgraphvect(LargePixels.page) 2
2027 set ascplot_xgraphvect(StyleMarkers.page) 2
2028 set ascplot_xgraphvect(BarBase.page) 2
2029 set ascplot_xgraphvect(BarWidth.page) 2
2030 set ascplot_xgraphvect(BorderSize.page) 2
2031 set ascplot_xgraphvect(GridSize.page) 2
2032 set ascplot_xgraphvect(ZeroWidth.page) 2
2033 set ascplot_xgraphvect(LineWidth.page) 2
2034 set ascplot_xgraphvect(LabelFont.page) 3
2035 set ascplot_xgraphvect(TitleFont.page) 3
2036 set ascplot_xgraphvect(Color0.page) 3
2037 set ascplot_xgraphvect(Color1.page) 3
2038 set ascplot_xgraphvect(Color2.page) 3
2039 set ascplot_xgraphvect(Color3.page) 3
2040 set ascplot_xgraphvect(Color4.page) 3
2041 set ascplot_xgraphvect(Color5.page) 3
2042 set ascplot_xgraphvect(Color6.page) 3
2043 set ascplot_xgraphvect(Color7.page) 3
2044 set ascplot_xgraphvect(ZeroColor.page) 3
2045 set ascplot_xgraphvect(Border.page) 3
2046 set ascplot_xgraphvect(Device.page) 4
2047 set ascplot_xgraphvect(Disposition.page) 4
2048 set ascplot_xgraphvect(FileOrDev.page) 4
2049 set ascplot_xgraphvect(GridStyle.page) 4
2050 set ascplot_xgraphvect(ZeroStyle.page) 4
2051 set ascplot_xgraphvect(Style0.page) 4
2052 set ascplot_xgraphvect(Style1.page) 4
2053 set ascplot_xgraphvect(Style2.page) 4
2054 set ascplot_xgraphvect(Style3.page) 4
2055 set ascplot_xgraphvect(Style4.page) 4
2056 set ascplot_xgraphvect(Style5.page) 4
2057 set ascplot_xgraphvect(Style6.page) 4
2058 set ascplot_xgraphvect(Style7.page) 4
2059
2060
2061 # booleans
2062 set ascplot_xgraphvect(BarGraph) 0
2063 set ascplot_xgraphvect(BarGraph.type) bool
2064 set ascplot_xgraphvect(NoLines) 0
2065 set ascplot_xgraphvect(NoLines.type) bool
2066 set ascplot_xgraphvect(LogX) 0
2067 set ascplot_xgraphvect(LogX.type) bool
2068 set ascplot_xgraphvect(LogY) 0
2069 set ascplot_xgraphvect(LogY.type) bool
2070 set ascplot_xgraphvect(BoundBox) 0
2071 set ascplot_xgraphvect(BoundBox.type) bool
2072 set ascplot_xgraphvect(Ticks) 0
2073 set ascplot_xgraphvect(Ticks.type) bool
2074 set ascplot_xgraphvect(Markers) 1
2075 set ascplot_xgraphvect(Markers.type) bool
2076 set ascplot_xgraphvect(PixelMarkers) 0
2077 set ascplot_xgraphvect(PixelMarkers.type) bool
2078 set ascplot_xgraphvect(LargePixels) 0
2079 set ascplot_xgraphvect(LargePixels.type) bool
2080 set ascplot_xgraphvect(StyleMarkers) 0
2081 set ascplot_xgraphvect(StyleMarkers.type) bool
2082 set ascplot_xgraphvect(ReverseVideo) 0
2083 set ascplot_xgraphvect(ReverseVideo.type) bool
2084 set ascplot_xgraphvect(Debug) 0
2085 set ascplot_xgraphvect(Debug.type) bool
2086 # reals
2087 set ascplot_xgraphvect(XHighLimit) 0
2088 set ascplot_xgraphvect(XHighLimit.type) real
2089 set ascplot_xgraphvect(YHighLimit) 0
2090 set ascplot_xgraphvect(YHighLimit.type) real
2091 set ascplot_xgraphvect(XLowLimit) 1
2092 set ascplot_xgraphvect(XLowLimit.type) real
2093 set ascplot_xgraphvect(YLowLimit) 1
2094 set ascplot_xgraphvect(YLowLimit.type) real
2095 set ascplot_xgraphvect(BarBase) 0
2096 set ascplot_xgraphvect(BarBase.type) real
2097 set ascplot_xgraphvect(BarWidth) -1.0
2098 set ascplot_xgraphvect(BarWidth.type) real
2099 # ints
2100 set ascplot_xgraphvect(BorderSize) 2
2101 set ascplot_xgraphvect(BorderSize.lo) 0
2102 set ascplot_xgraphvect(BorderSize.hi) 10
2103 set ascplot_xgraphvect(BorderSize.type) int
2104 set ascplot_xgraphvect(GridSize) 0
2105 set ascplot_xgraphvect(GridSize.lo) 0
2106 set ascplot_xgraphvect(GridSize.hi) 10
2107 set ascplot_xgraphvect(GridSize.type) int
2108 set ascplot_xgraphvect(ZeroWidth) 3
2109 set ascplot_xgraphvect(ZeroWidth.lo) 0
2110 set ascplot_xgraphvect(ZeroWidth.hi) 10
2111 set ascplot_xgraphvect(ZeroWidth.type) int
2112 set ascplot_xgraphvect(ZeroWidth.label) ZeroWidth
2113 set ascplot_xgraphvect(LineWidth) 0
2114 set ascplot_xgraphvect(LineWidth.lo) 0
2115 set ascplot_xgraphvect(LineWidth.hi) 10
2116 set ascplot_xgraphvect(LineWidth.type) int
2117 # strings
2118 global tcl_platform env ascUtilVect
2119 if {[string compare $tcl_platform(platform) windows]==0} {
2120 if {[info exists ascUtilVect(plot_command)] && \
2121 [string compare $ascUtilVect(plot_type) "xgraph"]==0} {
2122 set ascplot_xgraphvect(Command) $ascUtilVect(plot_command)
2123 } else {
2124 set ascplot_xgraphvect(Command) "{tkxgraph.exe} -- -f"
2125 }
2126 } else {
2127 set ascplot_xgraphvect(Command) "xgraph"
2128 }
2129 set ascplot_xgraphvect(Command.type) string
2130 global ascUtilVect
2131 set ascplot_xgraphvect(LabelFont) "helvetica-12"
2132 set ascplot_xgraphvect(LabelFont.type) string
2133 set ascplot_xgraphvect(TitleFont) "helvetica-18"
2134 set ascplot_xgraphvect(TitleFont.type) string
2135 set ascplot_xgraphvect(Device) Postscript
2136 set ascplot_xgraphvect(Device.type) string
2137 set ascplot_xgraphvect(Device.choices) "Postscript HPGL Idraw"
2138 set ascplot_xgraphvect(Disposition) "To Device"
2139 set ascplot_xgraphvect(Disposition.type) string
2140 set ascplot_xgraphvect(Disposition.choices) "{To Device} {To File}"
2141 set oname default
2142 catch {set oname $env(PRINTER)}
2143 set ascplot_xgraphvect(FileOrDev) $oname
2144 set ascplot_xgraphvect(FileOrDev.type) string
2145 # bins
2146 set ascplot_xgraphvect(GridStyle) 10
2147 set ascplot_xgraphvect(GridStyle.hi) 31
2148 set ascplot_xgraphvect(GridStyle.type) bin
2149 set ascplot_xgraphvect(GridStyle.label) "GridStyle bits"
2150 set ascplot_xgraphvect(ZeroStyle) 1
2151 set ascplot_xgraphvect(ZeroStyle.hi) 31
2152 set ascplot_xgraphvect(ZeroStyle.type) bin
2153 set ascplot_xgraphvect(ZeroStyle.label) "ZeroStyle bits"
2154 set ascplot_xgraphvect(Style0) 1
2155 set ascplot_xgraphvect(Style0.hi) 31
2156 set ascplot_xgraphvect(Style0.type) bin
2157 set ascplot_xgraphvect(Style0.label) "LineStyle 0 bits"
2158 set ascplot_xgraphvect(Style1) 10
2159 set ascplot_xgraphvect(Style1.hi) 31
2160 set ascplot_xgraphvect(Style1.type) bin
2161 set ascplot_xgraphvect(Style1.label) "LineStyle 1 bits"
2162 set ascplot_xgraphvect(Style2) 11110000
2163 set ascplot_xgraphvect(Style2.hi) 31
2164 set ascplot_xgraphvect(Style2.type) bin
2165 set ascplot_xgraphvect(Style2.label) "LineStyle 2 bits"
2166 set ascplot_xgraphvect(Style3) "010111"
2167 set ascplot_xgraphvect(Style3.hi) 31
2168 set ascplot_xgraphvect(Style3.type) bin
2169 set ascplot_xgraphvect(Style3.label) "LineStyle 3 bits"
2170 set ascplot_xgraphvect(Style4) 1110
2171 set ascplot_xgraphvect(Style4.hi) 31
2172 set ascplot_xgraphvect(Style4.type) bin
2173 set ascplot_xgraphvect(Style4.label) "LineStyle 4 bits"
2174 set ascplot_xgraphvect(Style5) 1111111100000000
2175 set ascplot_xgraphvect(Style5.hi) 31
2176 set ascplot_xgraphvect(Style5.type) bin
2177 set ascplot_xgraphvect(Style5.label) "LineStyle 5 bits"
2178 set ascplot_xgraphvect(Style6) 11001111
2179 set ascplot_xgraphvect(Style6.hi) 31
2180 set ascplot_xgraphvect(Style6.type) bin
2181 set ascplot_xgraphvect(Style6.label) "LineStyle 6 bits"
2182 set ascplot_xgraphvect(Style7) "0011000111"
2183 set ascplot_xgraphvect(Style7.hi) 31
2184 set ascplot_xgraphvect(Style7.type) bin
2185 set ascplot_xgraphvect(Style7.label) "LineStyle 7 bits"
2186
2187 # x strings
2188 if {[winfo depth .]==1} {
2189 set ascplot_xgraphvect(Color0) "black"
2190 set ascplot_xgraphvect(Color0.type) string
2191 set ascplot_xgraphvect(Color0.label) "Line Color 0"
2192 set ascplot_xgraphvect(Color1) "black"
2193 set ascplot_xgraphvect(Color1.type) string
2194 set ascplot_xgraphvect(Color1.label) "Line Color 1"
2195 set ascplot_xgraphvect(Color2) "black"
2196 set ascplot_xgraphvect(Color2.type) string
2197 set ascplot_xgraphvect(Color2.label) "Line Color 2"
2198 set ascplot_xgraphvect(Color3) "black"
2199 set ascplot_xgraphvect(Color3.type) string
2200 set ascplot_xgraphvect(Color3.label) "Line Color 3"
2201 set ascplot_xgraphvect(Color4) "black"
2202 set ascplot_xgraphvect(Color4.type) string
2203 set ascplot_xgraphvect(Color4.label) "Line Color 4"
2204 set ascplot_xgraphvect(Color5) "black"
2205 set ascplot_xgraphvect(Color5.type) string
2206 set ascplot_xgraphvect(Color5.label) "Line Color 5"
2207 set ascplot_xgraphvect(Color6) "black"
2208 set ascplot_xgraphvect(Color6.type) string
2209 set ascplot_xgraphvect(Color6.label) "Line Color 6"
2210 set ascplot_xgraphvect(Color7) "black"
2211 set ascplot_xgraphvect(Color7.type) string
2212 set ascplot_xgraphvect(Color7.label) "Line Color 7"
2213 set ascplot_xgraphvect(ZeroColor) "black"
2214 set ascplot_xgraphvect(ZeroColor.type) string
2215 set ascplot_xgraphvect(ZeroColor.label) "ZeroColor"
2216 set ascplot_xgraphvect(Border) "white"
2217 set ascplot_xgraphvect(Border.type) string
2218 set ascplot_xgraphvect(Border.label) "BorderColor"
2219 } else {
2220 set ascplot_xgraphvect(Color0) "red"
2221 set ascplot_xgraphvect(Color0.type) string
2222 set ascplot_xgraphvect(Color0.label) "Line Color 0"
2223 set ascplot_xgraphvect(Color1) "green"
2224 set ascplot_xgraphvect(Color1.type) string
2225 set ascplot_xgraphvect(Color1.label) "Line Color 1"
2226 set ascplot_xgraphvect(Color2) "blue"
2227 set ascplot_xgraphvect(Color2.type) string
2228 set ascplot_xgraphvect(Color2.label) "Line Color 2"
2229 set ascplot_xgraphvect(Color3) "yellow"
2230 set ascplot_xgraphvect(Color3.type) string
2231 set ascplot_xgraphvect(Color3.label) "Line Color 3"
2232 set ascplot_xgraphvect(Color4) "cyan"
2233 set ascplot_xgraphvect(Color4.type) string
2234 set ascplot_xgraphvect(Color4.label) "Line Color 4"
2235 set ascplot_xgraphvect(Color5) "sienna"
2236 set ascplot_xgraphvect(Color5.type) string
2237 set ascplot_xgraphvect(Color5.label) "Line Color 5"
2238 set ascplot_xgraphvect(Color6) "orange"
2239 set ascplot_xgraphvect(Color6.type) string
2240 set ascplot_xgraphvect(Color6.label) "Line Color 6"
2241 set ascplot_xgraphvect(Color7) "coral"
2242 set ascplot_xgraphvect(Color7.type) string
2243 set ascplot_xgraphvect(Color7.label) "Line Color 7"
2244 set ascplot_xgraphvect(ZeroColor) "white"
2245 set ascplot_xgraphvect(ZeroColor.type) string
2246 set ascplot_xgraphvect(ZeroColor.label) "ZeroColor"
2247 set ascplot_xgraphvect(Border) "black"
2248 set ascplot_xgraphvect(Border.type) string
2249 set ascplot_xgraphvect(Border.label) "BorderColor"
2250 }
2251 }
2252 # define setpos and other ascend procs if not here already
2253 # for documentation see ascend files DisplayProc.tcl and generalk.tcl
2254 if {"[info procs setpos]" == "" || "[info procs FileUniqueName]" == ""} {
2255 proc setpos {master {offsetx "70"} {offsety "70"}} {
2256 set xpos [expr [winfo rootx $master] + $offsetx]
2257 set ypos [expr [winfo rooty $master] + $offsety]
2258 return "+$xpos+$ypos"
2259 }
2260 proc getpos {master} {
2261 set list [split [wm geometry $master] +]
2262 set xpos [lindex $list 1]
2263 set ypos [lindex $list 2]
2264 return "+$xpos+$ypos"
2265 }
2266 proc FileUniqueName {{prefix "/tmp/"}} {
2267 set pidvar [pid]
2268 set datevar [clock format [clock seconds] -format %y%m%d%H%M%S]
2269 set fid "$prefix$pidvar\.$datevar"
2270 set ifid $fid
2271 set i 1
2272 while {[file exists $ifid]} {set ifid "$fid\.$i" ; incr i}
2273 return $ifid
2274 }
2275 }
2276
2277
2278 #---------------------------------------------------------------------
2279 #---------------------------------------------------------------------
2280 # an ascplot script language
2281 #---------------------------------------------------------------------
2282 #---------------------------------------------------------------------
2283 #
2284 # proc ascplot {keyword args}
2285 #---------------------------------------------------------------------
2286 # simple parser of ascplot commands. distributes according to
2287 # keyword.
2288 #---------------------------------------------------------------------
2289 proc ascplot {keyword args} {
2290 set list [list \
2291 load \
2292 view \
2293 useset \
2294 independent \
2295 dependent \
2296 legend \
2297 insert \
2298 setcell \
2299 calc \
2300 write \
2301 title \
2302 xtitle \
2303 ytitle \
2304 help \
2305 show \
2306 ]
2307 if {[lsearch -exact $list $keyword] == -1} {
2308 error "ascplot: Unrecognized keyword $keyword."
2309 }
2310 }
2311
2312
2313 # Module: oktext.tcl
2314 # Tcl version: 8.0
2315 # Tk version: 8.0
2316 # XF version: 2.2
2317 #
2318 # (C) Benjamin A Allan, August 1995
2319 # This widget is placed in the public domain.
2320
2321 # module contents
2322 global moduleList
2323 global autoLoadList
2324 set moduleList(oktext.tcl) { $top}
2325 set autoLoadList(oktext.tcl) {0}
2326
2327
2328 # procedure to show window $top
2329 # This widget displays a textbox and an ok button
2330 # The text box fill itself with the string given
2331 # in the font specified.
2332 # Color are the class defaults.
2333 # Usage:
2334 # OKText toplevel string title grab font geometry height width
2335 # toplevel: the widget name
2336 # string: message to put in the box
2337 # title: window title
2338 # grab: 0 nograb, 1 grab until OK pressed. (not implemented)
2339 # font: text font
2340 # geometry: window geom to attempt
2341 # height: lines in text
2342 # width: width of text
2343 # if toplevel is already up, it is destroyed first.
2344 proc OKText {top message title grab font geom ht wid} {
2345
2346 # build widget $top
2347 catch "destroy $top"
2348 toplevel $top
2349
2350 # Window manager configurations
2351 global tk_version
2352 wm positionfrom $top ""
2353 wm sizefrom $top ""
2354 wm maxsize $top 1500 1500
2355 wm minsize $top 10 10
2356 wm geometry $top $geom
2357 wm title $top $title
2358
2359
2360 # build widget $top.ok_btn
2361 button $top.ok_btn \
2362 -text {OK} \
2363 -font $font \
2364 -command "destroy $top; update"
2365
2366 # build widget $top.text_frm
2367 frame $top.text_frm \
2368 -relief {raised}
2369
2370 # build widget $top.text_frm.scrollbar1
2371 scrollbar $top.text_frm.scrollbar1 \
2372 -command "$top.text_frm.text2 yview" \
2373 -relief {raised}
2374
2375 # build widget $top.text_frm.text2
2376 text $top.text_frm.text2 \
2377 -exportselection {0} \
2378 -font $font \
2379 -height $ht \
2380 -width $wid \
2381 -wrap {word} \
2382 -yscrollcommand "$top.text_frm.scrollbar1 set"
2383 # bindings
2384 bind $top.text_frm.text2 <Any-Key> {catch {NoFunction} }
2385
2386 # pack widget $top.text_frm
2387 pack append $top.text_frm \
2388 $top.text_frm.scrollbar1 {right frame center filly} \
2389 $top.text_frm.text2 {top frame center expand fill}
2390
2391 # pack widget $top
2392 pack append $top \
2393 $top.text_frm {top frame center expand fill} \
2394 $top.ok_btn {top frame center fill}
2395
2396 $top.text_frm.text2 insert end $message
2397
2398
2399 }
2400
2401
2402
2403 # Internal procedures
2404
2405 # eof
2406 #
2407

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