Attachment 'fsgdfPlot.tcl'
Download 1 ##
2 ## fsgdfPlot.tcl
3 ##
4 ## CVS Revision Info:
5 ## $Author: nicks $
6 ## $Date: 2008/01/03 13:45:36 $
7 ## $Revision: 1.24.2.2 $
8 ##
9 ## Original Author: Kevin Teich
10 ##
11 ## Copyright (C) 2006-2007,
12 ## The General Hospital Corporation (Boston, MA).
13 ## All rights reserved.
14 ##
15 ## Distribution, usage and copying of this software is covered under the
16 ## terms found in the License Agreement file named 'COPYING' found in the
17 ## FreeSurfer source code root directory, and duplicated here:
18 ## https://surfer.nmr.mgh.harvard.edu/fswiki/FreeSurferOpenSourceLicense
19 ##
20 ## General inquiries: freesurfer@nmr.mgh.harvard.edu
21 ## Bug reports: analysis-bugs@nmr.mgh.harvard.edu
22 ##
23
24 package require Tix;
25 package require BLT;
26
27 # Make sure the gdf functions we need have been declared.
28 set gbLibLoaded 0
29 if { [info commands gdfRead] == "gdfRead" } {
30 set gbLibLoaded 1
31 } else {
32 puts "Couldn't find gdf commands."
33 }
34
35
36 # This function finds a file from a list of directories.
37 proc FindFile { ifnFile ilDirs } {
38 foreach sPath $ilDirs {
39 set sFullFileName [ file join $sPath $ifnFile ]
40 if { [file readable $sFullFileName] } {
41 puts "Reading $sFullFileName"
42 return $sFullFileName
43 }
44 }
45 puts "Couldn't find $ifnFile: Not in $ilDirs"
46 return ""
47 }
48
49
50 # Also look for tkUtils.tcl.
51 set sDefaultScriptsDir ""
52 catch { set sDefaultScriptsDir "$env(FREESURFER_HOME)/lib/tcl" }
53 set sUtilsDir ""
54 catch { set sUtilsDir "$env(TKUTILS_SCRIPTS_DIR)" }
55
56 set fnUtils \
57 [FindFile tkUtils.tcl \
58 [list $sUtilsDir "." "../scripts" $sDefaultScriptsDir]]
59 if { [string compare $fnUtils ""] == 0 } { exit }
60 source $fnUtils
61
62
63 # This is a description of the data arrays used throughout this code.
64 # gGDF - information gleaned from the header file.
65 # lID - list of IDs
66 # ID
67 # bReadHeader - whether or not his GDF is parsed correctly
68 # title - title of the graph
69 # measurementName - label for the measurement
70 # subjectName - subject name
71 # dataFileName - data file name
72 # cClasses - number of classes
73 # classes,n - n is 0 -> cClasses
74 # label - label for this class
75 # marker - marker for this class
76 # color - color for this class
77 # cSubjects - number of subjects
78 # subjects,n - n is 0 -> num subjects in this class
79 # index - index of the subject
80 # classes,label - label is the label
81 # index - index is the index of this label
82 # cVariables - number of variables
83 # variables,n - n is 0 -> cVariables
84 # label - label for this variable
85 # nDefaultVariable - index of default variable
86 # cSubjects - number of subjects
87 # subjects,n - n is 0 -> cSubjects
88 # id - label of this subject
89 # nClass - index of class of this subject
90 # variables,n - n is 0 -> cVariables
91 # value - value for this variable for this subject
92 # gPlot - information about the plot, including current state.n
93 # ID
94 # state
95 # nVariable - the index of the current variable
96 # info - the info string displayed in lwInfo
97 # focusInfo - the info string displayed for the focused item
98 # lPoints - list of points
99 # pointsChanged - dirty flag for points
100 # data,subjects,n - where n is 0 -> cSubjects
101 # variable - variable value for this subject (for state,nVariable)
102 # measurement - measurement value for this subject
103 # stdDev - standard deviation for this subject
104 # hiElement - name of hilighted element in plot
105 # subjects,n - where n is 0 -> cSubjects
106 # visible - whether or not is visible
107 # classes,n - where n is 0 -> cClasses
108 # visible - whether or not is visible
109 # mean - mean measurement for subects in this class
110 # stdDev - stdDev for subjects in this class
111 # legend - subject or class
112 # bTryRegressionLine - whether or not to try getting the offset/slope
113 # gWidgets - names of widgets
114 # ID
115 # wwTop - the top window
116 # gwPlot - the graph widget
117 # lwInfo - the info label widget
118 # bWindowBuilt - boolean indicating if the window has been built
119 # state
120 # window
121 # geometry - if hidden and reshown, will appear with same geometry
122
123 # constant values for stuff
124 set kValid(lMarkers) {square circle diamond plus cross splus scross triangle}
125 set kValid(lColors) {red blue green yellow black purple orange pink brown}
126
127 # Builds the main window. Assumes the header is already read.
128 proc FsgdfPlot_BuildWindow { iID } {
129 global gWidgets gGDF gPlot
130
131 set wwTop .fsgdf-$iID
132 set gwPlot $wwTop.gwPlot
133 set lwInfo $wwTop.lwInfo
134 set owVar $wwTop.owVar
135 set owLegendMode $wwTop.owLegendMode
136 set lwFocus $wwTop.lwFocus
137 set fwClassConfig $wwTop.fwClassConfig
138
139
140 # Make the to window and set its title.
141 toplevel $wwTop -height 500 -width 500
142 wm title $wwTop $gGDF($iID,title)
143
144 # Make the graph.
145 blt::graph $gwPlot \
146 -title $gGDF($iID,title) \
147 -plotbackground white \
148 -relief raised -border 2
149
150 # Bind our callbacks.
151 $gwPlot legend bind all <Enter> [list FsgdfPlot_CBLegendEnter $iID %W]
152 $gwPlot legend bind all <Leave> [list FsgdfPlot_CBLegendLeave $iID %W]
153 $gwPlot legend bind all <ButtonPress-1> [list FsgdfPlot_CBLegendClick $iID %W]
154 bind $gwPlot <Motion> [list FsgdfPlot_CBGraphMotion $iID %W %x %y]
155 bind $gwPlot <Destroy> [list FsgdfPlot_CBCloseWindow $iID]
156
157 # Hooking up the zoom functions seems to break some of the other
158 # bindings. Needs more work.
159 # Blt_ZoomStack $gwPlot
160
161 # Set the y axis label to the measurement name.
162 $gwPlot axis configure y -title $gGDF($iID,measurementName)
163
164 # Make the info label.
165 set gPlot($iID,state,info) ""
166 tkuMakeActiveLabel $lwInfo \
167 -variable gPlot($iID,state,info)
168
169 # Make the variable menu.
170 tixOptionMenu $owVar \
171 -command "FsgdfPlot_SetVariable $iID" \
172 -options "label.font [tkuLabelFont]"
173
174 # Make the mode menu.
175 tixOptionMenu $owLegendMode \
176 -command "FsgdfPlot_SetMode $iID" \
177 -options "label.font [tkuLabelFont]"
178 $owLegendMode config -disablecallback 1
179 $owLegendMode add command subject -label "View by subject"
180 $owLegendMode add command class -label "View by class"
181 $owLegendMode config -disablecallback 0
182
183 # Make the focus label.
184 set gPlot($iID,state,focusInfo) ""
185 tkuMakeActiveLabel $lwFocus \
186 -variable gPlot($iID,state,focusInfo)
187
188 # Make a frame for the class controls, which we'll fill in later.
189 tixLabelFrame $fwClassConfig -label "Configure Classes"
190
191 # Place everythingin the window.
192 grid $gwPlot -column 0 -row 0 -columnspan 3 -sticky news
193 grid $lwInfo -column 0 -row 1 -sticky nwe
194 grid $owLegendMode -column 1 -row 1 -sticky se
195 grid $owVar -column 2 -row 1 -sticky se
196 grid $lwFocus -column 0 -row 2 -columnspan 3 -sticky nwe
197 grid $fwClassConfig -column 0 -row 3 -columnspan 3 -sticky ews
198 grid columnconfigure $wwTop 0 -weight 1
199 grid columnconfigure $wwTop 1 -weight 0
200 grid columnconfigure $wwTop 2 -weight 0
201 grid rowconfigure $wwTop 0 -weight 1
202 grid rowconfigure $wwTop 1 -weight 0
203 grid rowconfigure $wwTop 2 -weight 0
204 grid rowconfigure $wwTop 3 -weight 0
205
206 # Set the names in the gWidgets array.
207 set gWidgets($iID,wwTop) $wwTop
208 set gWidgets($iID,gwPlot) $gwPlot
209 set gWidgets($iID,lwInfo) $lwInfo
210 set gWidgets($iID,lwFocus) $lwFocus
211 set gWidgets($iID,owVar) $owVar
212 set gWidgets($iID,fwClassConfig) [$fwClassConfig subwidget frame]
213
214 # Build the dynamic window elements for the window.
215 FsgdfPlot_BuildDynamicWindowElements $iID
216
217 # Set the variable menu value to the header's default variable
218 # index.
219 $owVar config -disablecallback 1
220 $owVar config -value $gGDF($iID,nDefaultVariable)
221 set gPlot($iID,state,nVariable) $gGDF($iID,nDefaultVariable)
222 $owVar config -disablecallback 0
223
224 # Set our initial legen mode to class.
225 $owLegendMode config -disablecallback 1
226 $owLegendMode config -value class
227 set gPlot($iID,state,legend) class
228 $owLegendMode config -disablecallback 0
229
230 # Create the pen for our active element.
231 $gwPlot pen create activeElement \
232 -symbol circle -color red -pixels 0.2i -fill ""
233
234 # Note that the window has been built.
235 set gWidgets($iID,bWindowBuilt) 1
236 }
237
238 # Builds the window elements that are dependant on data, including the
239 # variable menu and the class configuration section.
240 proc FsgdfPlot_BuildDynamicWindowElements { iID } {
241 global gGDF gWidgets kValid
242
243 # First delete all entries in the menu. Then for each variable,
244 # make an entry with that variable's label. The command for the
245 # menu has already been set.
246 $gWidgets($iID,owVar) config -disablecallback 1
247 set lEntries [$gWidgets($iID,owVar) entries]
248 foreach entry $lEntries {
249 $gWidgets($iID,owVar) delete $entry
250 }
251 for { set nVar 0 } { $nVar < $gGDF($iID,cVariables) } { incr nVar } {
252 $gWidgets($iID,owVar) add command $nVar \
253 -label "$gGDF($iID,variables,$nVar,label)"
254 }
255 $gWidgets($iID,owVar) config -disablecallback 0
256
257 # Fill out the class config frame. For each class, make an entry
258 # with an option widget for colors and one for markers. Set up the
259 # entries appropriately and bind it to the right variable.
260 for { set nClass 0 } { $nClass < $gGDF($iID,cClasses) } { incr nClass } {
261
262 set lw $gWidgets($iID,fwClassConfig).lw$nClass
263 set owMarker $gWidgets($iID,fwClassConfig).owMarker$nClass
264 set owColor $gWidgets($iID,fwClassConfig).owColor$nClass
265
266 tkuMakeNormalLabel $lw \
267 -label $gGDF($iID,classes,$nClass,label) \
268 -anchor e
269
270 tixOptionMenu $owMarker \
271 -command "FsgdfPlot_SetNthClassMarker $iID $nClass" \
272 -options "label.font [tkuLabelFont]"
273 $owMarker config -disablecallback 1
274 foreach marker $kValid(lMarkers) {
275 $owMarker add command $marker -label $marker
276 }
277 $owMarker config -value $gGDF($iID,classes,$nClass,marker)
278 $owMarker config -disablecallback 0
279
280 tixOptionMenu $owColor \
281 -command "FsgdfPlot_SetNthClassColor $iID $nClass" \
282 -options "label.font [tkuLabelFont]"
283 $owColor config -disablecallback 1
284 foreach color $kValid(lColors) {
285 $owColor add command $color -label $color
286 }
287 $owColor config -value $gGDF($iID,classes,$nClass,color)
288 $owColor config -disablecallback 0
289
290 # We're packing them in two columns (of three columns each).
291 set nCol [expr ($nClass % 2) * 3]
292 set nRow [expr $nClass / 2]
293 grid $lw -column $nCol -row $nRow -sticky ew
294 grid $owMarker -column [expr $nCol + 1] -row $nRow -sticky ew
295 grid $owColor -column [expr $nCol + 2] -row $nRow -sticky ew
296 }
297 grid columnconfigure $gWidgets($iID,fwClassConfig) 0 -weight 1
298 grid columnconfigure $gWidgets($iID,fwClassConfig) 1 -weight 0
299 grid columnconfigure $gWidgets($iID,fwClassConfig) 2 -weight 0
300 grid columnconfigure $gWidgets($iID,fwClassConfig) 3 -weight 1
301 grid columnconfigure $gWidgets($iID,fwClassConfig) 4 -weight 0
302 grid columnconfigure $gWidgets($iID,fwClassConfig) 5 -weight 0
303 }
304
305
306 # Parse the header file, using the gdf functions to read it and pull
307 # data out of it. Returns -1 if there was an error, else it returns an
308 # ID number for the fsgdf.
309 proc FsgdfPlot_ParseHeader { ifnHeader } {
310 global gGDF gPlot gWidgets kValid
311
312 # Make sure the file exists and has a PlotFile line. If not, we
313 # can't graph it.
314 if { ![file readable $ifnHeader] } {
315 puts "FSGD file doesn't exist or isn't readable."
316 return -1
317 }
318
319 set bFound 0
320 set fHeader [open $ifnHeader "r"]
321 while { [gets $fHeader sLine] >= 0 } {
322 if { [regexp -- PlotFile $sLine] } {
323 set bFound 1
324 break
325 }
326 }
327 if { !$bFound } {
328 puts "FSGD file doesn't contain a PlotFile entry."
329 return -1
330 }
331
332 # Generate a new ID.
333 set ID 0
334 while { [lsearch -exact $gGDF(lID) $ID] != -1 } { incr ID }
335
336 set err [catch {set gGDF($ID,object) [gdfRead $ifnHeader 1]}]
337 if { $err } {
338 puts "Couldn't init GDF."
339 return -1
340 }
341
342 # Grab all the data and put it into our TCL object. All these gdf*
343 # functions return a list of results. The first is an integer
344 # representing a result code. The second -> whatever is the actual
345 # result of the function.
346 set lResults [gdfGetTitle $gGDF($ID,object) ignore]
347 set err [lindex $lResults 0]
348 if { 0 == $err } {
349 set gGDF($ID,title) [lindex $lResults 1]
350 } else {
351 puts "WARNING: Could not get the graph title."
352 set gGDF($ID,title) "Untitled graph"
353 }
354
355 set lResults [gdfGetMeasurementName $gGDF($ID,object) ignore]
356 set err [lindex $lResults 0]
357 if { 0 == $err } {
358 set gGDF($ID,measurementName) [lindex $lResults 1]
359 } else {
360 puts "WARNING: Could not get the measurement label."
361 set gGDF($ID,measurementName) "Measurement"
362 }
363
364 set lResults [gdfGetSubjectName $gGDF($ID,object) ignore]
365 set err [lindex $lResults 0]
366 if { 0 == $err } {
367 set gGDF($ID,subjectName) [lindex $lResults 1]
368 } else {
369 puts "WARNING: Could not get the subject name."
370 set gGDF($ID,subjectName) "Unknown"
371 }
372
373
374 set lResults [gdfGetDataFileName $gGDF($ID,object) ignore]
375 set err [lindex $lResults 0]
376 if { 0 == $err } {
377 set gGDF($ID,dataFileName) [lindex $lResults 1]
378 } else {
379 puts "WARNING: Could not get the data file name."
380 set gGDF($ID,dataFileName) "Unknown"
381 }
382
383
384 set lResults [gdfGetNumClasses $gGDF($ID,object)]
385 set err [lindex $lResults 0]
386 if { 0 == $err } {
387 set gGDF($ID,cClasses) [lindex $lResults 1]
388
389 # If they didn't specify color or marker for the class, use
390 # these and increment so all the classes are different.
391 set nColor 0
392 set nMarker 0
393
394 for { set nClass 0 } { $nClass < $gGDF($ID,cClasses) } { incr nClass } {
395
396 set lResults [gdfGetNthClassLabel $gGDF($ID,object) $nClass ignore]
397 set err [lindex $lResults 0]
398 if { 0 == $err } {
399 set gGDF($ID,classes,$nClass,label) [lindex $lResults 1]
400 } else {
401 puts "WARNING: Could not get ${nClass}th label."
402 set gGDF($ID,classes,$nClass,label) "Class $nClass"
403 }
404
405 set lResults [gdfGetNthClassMarker $gGDF($ID,object) $nClass ignore]
406 set err [lindex $lResults 0]
407 if { 0 == $err } {
408 set gGDF($ID,classes,$nClass,marker) [lindex $lResults 1]
409 } else {
410 puts "WARNING: Could not get ${nClass}th label."
411 set gGDF($ID,classes,$nClass,marker) ""
412 }
413
414
415 # Look for the marker in the array of valid markers. If
416 # it's not found, output a warning and set it to the
417 # default.
418 set n [lsearch -exact $kValid(lMarkers) $gGDF($ID,classes,$nClass,marker)]
419 if { $n == -1 } {
420 puts "WARNING: Marker for class $gGDF($ID,classes,$nClass,label) was invalid."
421 set gGDF($ID,classes,$nClass,marker) \
422 [lindex $kValid(lMarkers) $nMarker]
423 incr nMarker
424 if { $nMarker >= [llength $kValid(lMarkers)] } {set nMarker 0 }
425 }
426
427 set lResults [gdfGetNthClassColor $gGDF($ID,object) $nClass ignore]
428 set err [lindex $lResults 0]
429 if { 0 == $err } {
430 set gGDF($ID,classes,$nClass,color) [lindex $lResults 1]
431 } else {
432 puts "WARNING: Could not get ${nClass}th label."
433 set gGDF($ID,classes,$nClass,color) ""
434 }
435
436
437 # Look for the coclor in the array of valid color. If
438 # it's not found, output a warning and set it to the
439 # default.
440 set n [lsearch -exact $kValid(lColors) \
441 $gGDF($ID,classes,$nClass,color)]
442 if { $n == -1 } {
443 puts "WARNING: Color for class $gGDF($ID,classes,$nClass,label) was invalid."
444 set gGDF($ID,classes,$nClass,color) \
445 [lindex $kValid(lColors) $nColor]
446 incr nColor
447 if { $nColor >= [llength $kValid(lColors)] } { set nColor 0 }
448 }
449
450 # This is the reverse lookup for a class label -> index.
451 set gGDF($ID,classes,$gGDF($ID,classes,$nClass,label),index) $nClass
452
453 # Initialize all classes as visible.
454 set gPlot($ID,state,classes,$nClass,visible) 1
455 }
456 } else {
457 puts "ERROR: Could not get number of classes."
458 return -1
459 }
460
461
462 set lResults [gdfGetNumVariables $gGDF($ID,object)]
463 set err [lindex $lResults 0]
464 if { 0 == $err } {
465 set gGDF($ID,cVariables) [lindex $lResults 1]
466
467 for { set nVariable 0 } \
468 { $nVariable < $gGDF($ID,cVariables) } { incr nVariable } {
469
470 set lResults [gdfGetNthVariableLabel $gGDF($ID,object) $nVariable ignore]
471 set err [lindex $lResults 0]
472 if { 0 == $err } {
473 set gGDF($ID,variables,$nVariable,label) [lindex $lResults 1]
474 } else {
475 puts "WARNING: Could not get ${nClass}th label."
476 set gGDF($ID,variables,$nVariable,label) "Variable $nVariable"
477 }
478
479 }
480 } else {
481 puts "ERROR: Could not get number of variables."
482 return -1
483 }
484
485
486 set lResults [gdfGetDefaultVariable $gGDF($ID,object) ignore]
487 set err [lindex $lResults 0]
488 if { 0 == $err } {
489 set gGDF($ID,defaultVariable) [lindex $lResults 1]
490 } else {
491 puts "WARNING: Could not get default variable."
492 set gGDF($ID,defaultVariable) $gGDF($ID,variables,0,label)
493 }
494
495 set lResults [gdfGetDefaultVariableIndex $gGDF($ID,object)]
496 set err [lindex $lResults 0]
497 if { 0 == $err } {
498 set gGDF($ID,nDefaultVariable) [lindex $lResults 1]
499 } else {
500 puts "WARNING: Could not get default variable index."
501 set gGDF($ID,defaultVariable) 0
502 }
503
504 set lResults [gdfGetNumSubjects $gGDF($ID,object)]
505 set err [lindex $lResults 0]
506 if { 0 == $err } {
507 set gGDF($ID,cSubjects) [lindex $lResults 1]
508
509 for { set nSubject 0 } \
510 { $nSubject < $gGDF($ID,cSubjects) } { incr nSubject } {
511
512 set lResults [gdfGetNthSubjectID $gGDF($ID,object) $nSubject ignore]
513 set err [lindex $lResults 0]
514 if { 0 == $err } {
515 set gGDF($ID,subjects,$nSubject,id) [lindex $lResults 1]
516 } else {
517 puts "WARNING: Could not get ${nSubject}th subject."
518 set gGDF($ID,classes,$nClass,label) "Subject $nSubject"
519 }
520
521 set lResults [gdfGetNthSubjectClass $gGDF($ID,object) $nSubject]
522 set err [lindex $lResults 0]
523 if { 0 == $err } {
524 set gGDF($ID,subjects,$nSubject,nClass) [lindex $lResults 1]
525 } else {
526 puts "WARNING: Could not get ${nSubject}th subject."
527 set gGDF($ID,classes,$nClass,label) 0
528 }
529
530
531 for { set nVariable 0 } \
532 { $nVariable < $gGDF($ID,cVariables) } { incr nVariable } {
533
534 set lResults [gdfGetNthSubjectNthValue $gGDF($ID,object) $nSubject $nVariable]
535 set err [lindex $lResults 0]
536 if { 0 == $err } {
537 set gGDF($ID,subjects,$nSubject,variables,$nVariable,value) \
538 [lindex $lResults 1]
539 } else {
540 puts "WARNING: Could not value for ${nSubject}th subject ${nVariable}th variable."
541 set gGDF($ID,subjects,$nSubject,variables,$nVariable,value) 0
542 }
543 }
544
545 # Initialize all subjects as visible.
546 set gPlot($ID,state,subjects,$nSubject,visible) 1
547 }
548 } else {
549 puts "ERROR: Could not get number of subjects."
550 return -1
551 }
552
553
554 # This groups the subjects by the class they are in. For each
555 # class, for each subject, if the subject is in the class, assign
556 # the subject index to that subject-in-class index.
557 for { set nClass 0 } { $nClass < $gGDF($ID,cClasses) } { incr nClass } {
558 set nSubjInClass 0
559 for { set nSubj 0 } { $nSubj < $gGDF($ID,cSubjects) } { incr nSubj } {
560 if { $gGDF($ID,subjects,$nSubj,nClass) == $nClass } {
561 set gGDF($ID,classes,$nClass,subjects,$nSubjInClass,index) $nSubj
562 incr nSubjInClass
563 }
564 }
565 set gGDF($ID,classes,$nClass,cSubjects) $nSubjInClass
566 }
567
568 # We now have a header.
569 set gGDF($ID,bReadHeader) 1
570
571 # Start out trying to find the offset/slope for a class/var.
572 set gPlot($ID,state,bTryRegressionLine) 1
573
574 # If we have a window, build the dynamic elements.
575 if { [info exists gWidgets($ID,bWindowBuilt)] &&
576 $gWidgets($ID,bWindowBuilt) } {
577 FsgdfPlot_BuildDynamicWindowElements $ID
578 }
579
580 if { 0 } {
581 puts "$gGDF($ID,cClasses) classes:"
582 for { set nClass 0 } { $nClass < $gGDF($ID,cClasses) } { incr nClass } {
583 puts "$nClass: label=$gGDF($ID,classes,$nClass,label) marker=$gGDF($ID,classes,$nClass,marker) color=$gGDF($ID,classes,$nClass,color) reverse index=$gGDF($ID,classes,$gGDF($ID,classes,$nClass,label),index)"
584 }
585
586 puts "$gGDF($ID,cVariables) variables:"
587 for { set nVar 0 } { $nVar < $gGDF($ID,cVariables) } { incr nVar } {
588 puts "$nVar: label=$gGDF($ID,variables,$nVar,label)"
589 }
590
591 puts "$gGDF($ID,cSubjects) subjects:"
592 for { set nSubj 0 } { $nSubj < $gGDF($ID,cSubjects) } { incr nSubj } {
593 puts "$nSubj: id=$gGDF($ID,subjects,$nSubj,id) class=$gGDF($ID,subjects,$nSubj,nClass)"
594 }
595 }
596
597 lappend gGDF(lID) $ID
598 return $ID
599 }
600
601
602 # This plots the current data on the graph. It is fast enough that it
603 # can be called any time the data is changed to completely redraw it
604 # from scratch.
605 proc FsgdfPlot_PlotData { iID } {
606 global gWidgets gPlot gGDF
607
608 FsgdfPlot_ShowWindow $iID
609
610 # Don't plot if the window isn't built or we don't have data.
611 if { ![info exists gWidgets($iID,bWindowBuilt)] ||
612 ![info exists gGDF($iID,bReadHeader)] ||
613 !$gWidgets($iID,bWindowBuilt) ||
614 !$gGDF($iID,bReadHeader) } {
615 return
616 }
617
618 set gw $gWidgets($iID,gwPlot)
619
620 # Set the x axis title to the label of the current variable.
621 $gw axis configure x \
622 -title $gGDF($iID,variables,$gPlot($iID,state,nVariable),label)
623
624 # Remove all the elements and markers from the graph.
625 set lElements [$gw element names *]
626 foreach element $lElements {
627 $gw element delete $element
628 }
629 set lMarkers [$gw marker names *]
630 foreach marker $lMarkers {
631 $gw marker delete $marker
632 }
633
634 # If we have no points, return.
635 if { ![info exists gPlot($iID,state,lPoints)] ||
636 [llength $gPlot($iID,state,lPoints)] == 0 } {
637 return
638 }
639
640 # Depending on our legend mode, we'll draw by class or subject.
641 if { $gPlot($iID,state,legend) == "class" } {
642
643 # For each class, for each subject, if the subject's class is
644 # the same as the current class, get its data points and add
645 # them to a list. Also calculate error bar coords. Then draw
646 # the entire list of data in the class's color/marker. If the
647 # class is hidden, set the color to white (so it shows up
648 # white in the legend) and hide the element. Draw the error
649 # bars as well.
650 for { set nClass 0 } { $nClass < $gGDF($iID,cClasses) } { incr nClass } {
651
652 set lData {}
653 set nSubjInClass 0
654 for { set nSubj 0 } { $nSubj < $gGDF($iID,cSubjects) } { incr nSubj } {
655
656 if { $gGDF($iID,subjects,$nSubj,nClass) == $nClass } {
657
658 if { $gPlot($iID,state,pointsChanged) } {
659 FsgdfPlot_CalculateSubjectMeasurement $iID $nSubj
660 }
661
662 set gPlot($iID,state,data,subjects,$nSubj,variable) $gGDF($iID,subjects,$nSubj,variables,$gPlot($iID,state,nVariable),value)
663
664 lappend lData $gPlot($iID,state,data,subjects,$nSubj,variable)
665 lappend lData $gPlot($iID,state,data,subjects,$nSubj,measurement)
666
667 # Make the error coords a line from x=variable and
668 # +-y=stddev.
669 set meas $gPlot($iID,state,data,subjects,$nSubj,measurement)
670 set stdDev $gPlot($iID,state,data,subjects,$nSubj,stdDev)
671 lappend lErrorBars [list $gPlot($iID,state,data,subjects,$nSubj,variable) [expr $meas - $stdDev] $gPlot($iID,state,data,subjects,$nSubj,variable) [expr $meas + $stdDev]]
672
673 }
674 }
675
676 # Now that we calculated the values for all our subjects,
677 # we get the average for this class.
678 if { $gPlot($iID,state,pointsChanged) } {
679 FsgdfPlot_CalculateClassAverageMeasurement $iID $nClass
680 }
681
682 if { $gPlot($iID,state,classes,$nClass,visible) } {
683 set bHide 0
684 set color $gGDF($iID,classes,$nClass,color)
685 } else {
686 set bHide 1
687 set color white
688 }
689 # Draw all our points.
690 $gw element create $gGDF($iID,classes,$nClass,label) \
691 -data $lData \
692 -symbol $gGDF($iID,classes,$nClass,marker) \
693 -color $color -linewidth 0 -outlinewidth 1 -hide $bHide \
694 -activepen activeElement
695
696 # Draw error bars. We're drawing a series of elements here
697 # that each need a unique name.
698 set nErrorIndex 0
699 foreach lBar $lErrorBars {
700 $gw element create error$nClass$nErrorIndex \
701 -data $lBar \
702 -color $color \
703 -symbol splus \
704 -label "" \
705 -pixels 5
706
707 incr nErrorIndex
708 }
709
710 # Draw the mean line.
711 if { 1 } {
712 set x1 -200
713 set y1 $gPlot($iID,state,classes,$nClass,mean)
714 set x2 200
715 set y2 $gPlot($iID,state,classes,$nClass,mean)
716 $gw marker create line \
717 -coords [list $x1 $y1 $x2 $y2] \
718 -outline $gGDF($iID,classes,$nClass,color) \
719 -dashes {3 3}
720
721 # Draw the stddev lines for the mean line.
722 set y1 [expr $gPlot($iID,state,classes,$nClass,mean) - $gPlot($iID,state,classes,$nClass,stdDev)]
723 set y2 [expr $gPlot($iID,state,classes,$nClass,mean) - $gPlot($iID,state,classes,$nClass,stdDev)]
724 $gw marker create line \
725 -coords [list $x1 $y1 $x2 $y2] \
726 -outline $gGDF($iID,classes,$nClass,color) \
727 -dashes {1 3}
728
729 set y1 [expr $gPlot($iID,state,classes,$nClass,mean) + $gPlot($iID,state,classes,$nClass,stdDev)]
730 set y2 [expr $gPlot($iID,state,classes,$nClass,mean) + $gPlot($iID,state,classes,$nClass,stdDev)]
731 $gw marker create line \
732 -coords [list $x1 $y1 $x2 $y2] \
733 -outline $gGDF($iID,classes,$nClass,color) \
734 -dashes {1 3}
735 }
736 }
737
738 } else {
739
740
741 # For each subject, if the points have changed, calculate the
742 # measurements. Get the variable value. If the subject is
743 # visible, set the hide flag to 0 and the color to the
744 # subject's class color, else set the hide flag to 1 and set
745 # the color to white. Create the element. Also calc and create
746 # error bar elements.
747 for { set nSubj 0 } { $nSubj < $gGDF($iID,cSubjects) } { incr nSubj } {
748
749 if { $gPlot($iID,state,pointsChanged) } {
750 FsgdfPlot_CalculateSubjectMeasurement $iID $nSubj
751 }
752
753 set gPlot($iID,state,data,subjects,$nSubj,variable) $gGDF($iID,subjects,$nSubj,variables,$gPlot($iID,state,nVariable),value)
754
755 if { $gPlot($iID,state,subjects,$nSubj,visible) } {
756 set bHide 0
757 set color $gGDF($iID,classes,$gGDF($iID,subjects,$nSubj,nClass),color)
758 } else {
759 set bHide 1
760 set color white
761 }
762
763 $gw element create $gGDF($iID,subjects,$nSubj,id) \
764 -data [list $gPlot($iID,state,data,subjects,$nSubj,variable) $gPlot($iID,state,data,subjects,$nSubj,measurement)] \
765 -symbol $gGDF($iID,classes,$gGDF($iID,subjects,$nSubj,nClass),marker) \
766 -color $color -linewidth 0 -outlinewidth 1 -hide $bHide \
767 -activepen activeElement
768
769 set meas $gPlot($iID,state,data,subjects,$nSubj,measurement)
770 set stdDev $gPlot($iID,state,data,subjects,$nSubj,stdDev)
771 $gw element create error$nSubj \
772 -data [list $gPlot($iID,state,data,subjects,$nSubj,variable) [expr $meas - $stdDev] \
773 $gPlot($iID,state,data,subjects,$nSubj,variable) [expr $meas + $stdDev]] \
774 -color $color \
775 -symbol splus \
776 -label "" \
777 -pixels 5
778 }
779 }
780
781 # If we're trying to draw the regression line, for each class, if
782 # the class is visible, get the offset and slope for that class
783 # and the current variable. This depends on the point we're
784 # drawing, so get the avg of all the points if necessary. Then
785 # make a marker calculating two points on the line. if
786 # gdfOffsetSlope() failes, set the bTryRegressionLine flag to
787 # false, so we won't try drawing it again.
788 if { $gPlot($iID,state,bTryRegressionLine) } {
789
790 for { set nClass 0 } { $nClass < $gGDF($iID,cClasses) } { incr nClass } {
791
792 if { $gPlot($iID,state,classes,$nClass,visible) } {
793
794 set nVar $gPlot($iID,state,nVariable)
795
796 # Calc the avg offset and slope for all points.
797 set offset 0
798 set slope 0
799 set cGood 0
800 foreach lPoint $gPlot($iID,state,lPoints) {
801 scan $lPoint "%d %d %d" x y z
802 set lResults [gdfOffsetSlope $gGDF($iID,object) $nClass $nVar $x $y $z]
803 set err [lindex $lResults 0]
804 if { 0 == $err } {
805 set offset [expr $offset + [lindex $lResults 1]]
806 set slope [expr $slope + [lindex $lResults 2]]
807 incr cGood
808 } else {
809 set gPlot($iID,state,bTryRegressionLine) 0
810 break
811 }
812
813 if { $cGood > 0 } {
814 set x1 -200
815 set y1 [expr ($slope * $x1) + $offset]
816 set x2 200
817 set y2 [expr ($slope * $x2) + $offset]
818
819 $gw marker create line \
820 -coords [list $x1 $y1 $x2 $y2] \
821 -outline $gGDF($iID,classes,$nClass,color) \
822 -dashes {5 5}
823 }
824 }
825 }
826
827 if { $gPlot($iID,state,bTryRegressionLine) == 0 } { break }
828 }
829 }
830
831 set gPlot($iID,state,pointsChanged) 0
832 }
833
834
835 # Accesses and calculates the (averaged if necessary) measurment
836 # values at the current point(s). Stores the values in gPlot.
837 proc FsgdfPlot_CalculateSubjectMeasurement { iID inSubject } {
838 global gPlot gGDF
839
840 # Get the average of the points we've been given.
841 set sumMean 0
842 set sumVar 0
843 set cGood 0
844 foreach lPoint $gPlot($iID,state,lPoints) {
845
846 scan $lPoint "%d %d %d" x y z
847 set lResults [gdfGetNthSubjectMeasurement $gGDF($iID,object) $inSubject $x $y $z]
848 set err [lindex $lResults 0]
849 if { 0 == $err } {
850 set sumMean [expr $sumMean + [lindex $lResults 1]]
851 set sumVar [expr $sumVar + pow([lindex $lResults 1],2.0)]
852 incr cGood
853 }
854 }
855 set mean 0
856 set stdDev 0
857 if { $cGood > 0 } {
858 set mean [expr $sumMean / $cGood.0]
859 if { $cGood > 1 } {
860 set stdDev [expr sqrt($sumVar / $cGood.0 - pow($mean,2))]
861 }
862 }
863
864 # Store the values in gPlot.
865 set gPlot($iID,state,data,subjects,$inSubject,measurement) $mean
866 set gPlot($iID,state,data,subjects,$inSubject,stdDev) $stdDev
867
868 }
869
870 # Accesses and calculates the average measurment values for the
871 # subjects in the passed class. Stores the values in gPlot. Depends on
872 # the values calculated by FsgdfPlot_CalculateClassAverageMeasurement
873 # first.
874 proc FsgdfPlot_CalculateClassAverageMeasurement { iID inClass } {
875 global gPlot gGDF
876
877 # Make sure we have subjects in this class.
878 if { $gGDF($iID,classes,$inClass,cSubjects) == 0 } {
879 set gPlot($iID,state,classes,$inClass,mean) 0
880 set gPlot($iID,state,classes,$inClass,stdDev) 0
881 return
882 }
883
884 # Get the average of the points we've been given.
885 set sumMean 0
886 set sumVar 0
887 for { set nSubjInClass 0 } \
888 { $nSubjInClass < $gGDF($iID,classes,$inClass,cSubjects) } \
889 { incr nSubjInClass } {
890
891 # This is the overall subject index.
892 set nSubj $gGDF($iID,classes,$inClass,subjects,$nSubjInClass,index)
893
894 # This is set in FsgdfPlot_CalculateSubjectMeasurement as the
895 # average measurement for all points for this subject
896 # currently being graphed.
897 set meas $gPlot($iID,state,data,subjects,$nSubj,measurement)
898
899 set sumMean [expr $sumMean + $meas]
900 set sumVar [expr $sumVar + pow($meas,2.0)]
901 }
902 set mean 0
903 set stdDev 0
904
905 set mean [expr $sumMean / $gGDF($iID,classes,$inClass,cSubjects).0]
906 if { $gGDF($iID,classes,$inClass,cSubjects) > 1 } {
907 set stdDev [expr sqrt($sumVar / $gGDF($iID,classes,$inClass,cSubjects).0 - pow($mean,2))]
908 }
909
910 # Store the values in gPlot.
911 set gPlot($iID,state,classes,$inClass,mean) $mean
912 set gPlot($iID,state,classes,$inClass,stdDev) $stdDev
913 }
914
915
916 # Hilight/UnhilightElement works on an element by name (which could be
917 # a subject or class, depending on viewing mode). It will
918 # select/unselect the element name in the legend and change the
919 # drawing pen of the element in the graph, which if activated draws it
920 # with a red circle around it.
921 proc FsgdfPlot_HilightElement { iID iElement } {
922 global gWidgets
923 $gWidgets($iID,gwPlot) legend activate $iElement
924 $gWidgets($iID,gwPlot) element activate $iElement
925 }
926
927 proc FsgdfPlot_UnhilightElement { iID iElement } {
928 global gWidgets
929 $gWidgets($iID,gwPlot) legend deactivate $iElement
930 $gWidgets($iID,gwPlot) element deactivate $iElement
931 }
932
933
934 # Shows or hide an element by name, in subject or class mode. Changes
935 # the value of the gPlot visibility flag.
936 proc FsgdfPlot_ToggleVisibility { iID iElement } {
937 global gPlot
938
939 # If we're in subject legend mode, the legend label is a subject
940 # name. Get the subject index and toggle its visibility. If we're in
941 # class legend mode, the legend label is a class name, so get the
942 # class index and toggle its visibility.
943 if { $gPlot($iID,state,legend) == "subject" } {
944 set nSubj [FsgdfPlot_GetSubjectIndexFromID $iID $iElement]
945 if { $gPlot($iID,state,subjects,$nSubj,visible) } {
946 set gPlot($iID,state,subjects,$nSubj,visible) 0
947 } else {
948 set gPlot($iID,state,subjects,$nSubj,visible) 1
949 }
950 } else {
951 set nClass [FsgdfPlot_GetClassIndexFromLabel $iID $iElement]
952 if { $gPlot($iID,state,classes,$nClass,visible) } {
953 set gPlot($iID,state,classes,$nClass,visible) 0
954 } else {
955 set gPlot($iID,state,classes,$nClass,visible) 1
956 }
957 }
958 }
959
960
961 # Focus/Unfocus is called to 'mouseover' an element. It
962 # Hilight/Unhilights an element and puts or removes the subject name
963 # in a text marker in the graph.
964 proc FsgdfPlot_UnfocusElement { iID } {
965 global gPlot gWidgets
966
967 # If we have a focused element, unhighlight it, set the
968 # highlighted element name to null, and delete the hover text
969 # marker.
970 if { [info exists gPlot($iID,state,hiElement)] && \
971 "$gPlot($iID,state,hiElement)" != "" } {
972 FsgdfPlot_UnhilightElement $iID $gPlot($iID,state,hiElement)
973 set gPlot($iID,state,hiElement) ""
974 $gWidgets($iID,gwPlot) marker delete hover
975 set gPlot($iID,state,focusInfo) ""
976 }
977 }
978
979 proc FsgdfPlot_FocusElement { iID iElement inSubjInClass iX iY } {
980 global gPlot gWidgets gGDF
981
982 # Don't focus on error bars.
983 if { [string match error* $iElement] } {
984 return
985 }
986
987 # Set the highlighted element name and highlight the element.
988 set gPlot($iID,state,hiElement) $iElement
989 FsgdfPlot_HilightElement $iID $gPlot($iID,state,hiElement)
990
991 # Need to get the subject name. If we're in subject mode, this is
992 # just the element name, otherwise we're getting the class name in
993 # the element name so get the class index, then use that and the
994 # parameter we got (index of the data point, also the
995 # subject-in-class index) to get th subject index, and then the
996 # subject name.
997 set nSubj 0
998 set sId ""
999 set nClass [FsgdfPlot_GetClassIndexFromLabel $iID $iElement]
1000 if { $gPlot($iID,state,legend) == "subject" } {
1001 set nSubj [FsgdfPlot_GetSubjectIndexFromID $iID $iElement]
1002 set sId $iElement
1003 } else {
1004 set nSubj $gGDF($iID,classes,$nClass,subjects,$inSubjInClass,index)
1005 set sId $gGDF($iID,subjects,$nSubj,id)
1006 }
1007 set nVariable $gPlot($iID,state,nVariable)
1008
1009 set sValue [format "%.0f" $gPlot($iID,state,data,subjects,$nSubj,variable)]
1010 set sMeasurement [format "%.3f" $gPlot($iID,state,data,subjects,$nSubj,measurement)]
1011 set sStdDev ""
1012 if { $gPlot($iID,state,data,subjects,$nSubj,stdDev) != 0 } {
1013 set sStdDev " +/- [format "%.3f" $gPlot($iID,state,data,subjects,$nSubj,stdDev)]"
1014 }
1015
1016 set sShortLabel "$sId ($sValue$sStdDev, $sMeasurement)"
1017
1018 set sLongLabel "$sId: $gGDF($iID,variables,$nVariable,label) = $sValue$sStdDev, $gGDF($iID,measurementName) = $sMeasurement"
1019
1020 $gWidgets($iID,gwPlot) marker create text -name hover -text $sShortLabel -anchor nw -coords [list $iX $iY]
1021
1022 set gPlot($iID,state,focusInfo) $sLongLabel
1023 }
1024
1025
1026 # Finds the element under the mouse.
1027 proc FsgdfPlot_FindMousedElement { iID iX iY } {
1028 global gWidgets
1029 set bFound [$gWidgets($iID,gwPlot) element closest $iX $iY aFound -halo 10]
1030 if { $bFound } {
1031 return [list $aFound(name) $aFound(index) $aFound(x) $aFound(y)]
1032 }
1033 return ""
1034 }
1035
1036
1037 # Converts from subject or class names to indicies.
1038 proc FsgdfPlot_GetSubjectIndexFromID { iID iSubjID } {
1039 global gGDF
1040 for { set nSubj 0 } { $nSubj < $gGDF($iID,cSubjects) } { incr nSubj } {
1041 if { "$iSubjID" == "$gGDF($iID,subjects,$nSubj,id)" } { return $nSubj }
1042 }
1043 return -1
1044 }
1045
1046 proc FsgdfPlot_GetClassIndexFromLabel { iID iLabel } {
1047 global gGDF
1048 for { set nClass 0 } { $nClass < $gGDF($iID,cClasses) } { incr nClass } {
1049 if { "$iLabel" == "$gGDF($iID,classes,$nClass,label)" } { return $nClass }
1050 }
1051 return -1
1052 }
1053
1054
1055 # Our callbacks.
1056 proc FsgdfPlot_CBCloseWindow { iID } {
1057 global gWidgets
1058 set gWidgets($iID,bWindowBuilt) 0
1059 }
1060
1061 proc FsgdfPlot_CBLegendEnter { iID igw } {
1062 FsgdfPlot_HilightElement $iID [$igw legend get current]
1063 }
1064
1065 proc FsgdfPlot_CBLegendLeave { iID igw } {
1066 FsgdfPlot_UnhilightElement $iID [$igw legend get current]
1067 }
1068
1069 proc FsgdfPlot_CBLegendClick { iID igw } {
1070 FsgdfPlot_ToggleVisibility $iID [$igw legend get current]
1071 FsgdfPlot_PlotData $iID
1072 }
1073
1074 proc FsgdfPlot_CBGraphMotion { iID igw iX iY } {
1075 FsgdfPlot_UnfocusElement $iID
1076 set lResult [FsgdfPlot_FindMousedElement $iID $iX $iY]
1077 set element [lindex $lResult 0]
1078 if { "$element" != "" } {
1079 set index [lindex $lResult 1]
1080 set x [lindex $lResult 2]
1081 set y [lindex $lResult 3]
1082 FsgdfPlot_FocusElement $iID $element $index $x $y
1083 }
1084 }
1085
1086 # ============================================================ PUBLIC
1087
1088
1089 # Call once before anything else to initialize the data structures.
1090 proc FsgdfPlot_Init {} {
1091 global gWidgets gbLibLoaded gGDF
1092 if { !$gbLibLoaded } { return }
1093 set gGDF(lID) {}
1094 }
1095
1096
1097 # Read a header file.
1098 proc FsgdfPlot_Read { ifnHeader } {
1099 global gbLibLoaded
1100 if { !$gbLibLoaded } { puts "NOT LOADED" ; ereturn -1 }
1101 set ID [FsgdfPlot_ParseHeader $ifnHeader]
1102 return $ID
1103 }
1104
1105
1106 # Print information about the header.
1107 proc FsgdfPlot_Print { iID } {
1108 global gGDF gbLibLoaded
1109 if { !$gbLibLoaded } { return }
1110 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return }
1111 gdfPrintStdout $gGDF($iID,object)
1112 }
1113
1114
1115 # Show or hide the window. If it hasn't been built, builds the window
1116 # first.
1117 proc FsgdfPlot_ShowWindow { iID } {
1118 global gGDF gWidgets gbLibLoaded
1119 if { !$gbLibLoaded } { return }
1120 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return }
1121 if { ![info exists gWidgets($iID,bWindowBuilt)] ||
1122 !$gWidgets($iID,bWindowBuilt) } {
1123 FsgdfPlot_BuildWindow $iID
1124 }
1125 wm deiconify $gWidgets($iID,wwTop)
1126 if { [info exists gWidgets($iID,state,window,geometry)] } {
1127 wm geometry $gWidgets($iID,wwTop) $gWidgets($iID,state,window,geometry)
1128 }
1129 }
1130
1131 proc FsgdfPlot_HideWindow { iID } {
1132 global gGDF gWidgets gbLibLoaded
1133 if { !$gbLibLoaded } { return }
1134 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return }
1135 if { [info exists gWidgets($iID,window,wwTop)] } {
1136 set gWidgets($iID,state,window,geometry) \
1137 [wm geometry $gWidgets($iID,wwTop)]
1138 wm withdraw $gWidgets($iID,wwTop)
1139 }
1140 }
1141
1142 # Returns whether a plot window is built and visible.
1143 proc FsgdfPlot_IsWindowShowing { iID } {
1144 global gGDF gWidgets gbLibLoaded
1145 if { !$gbLibLoaded } { return 0 }
1146 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return 0 }
1147 if { ![info exists gWidgets($iID,bWindowBuilt)] ||
1148 !$gWidgets($iID,bWindowBuilt) } {
1149 return 0
1150 }
1151 return 1
1152 }
1153
1154 # Set the current variable.
1155 proc FsgdfPlot_SetVariable { iID inVariable } {
1156 global gGDF gWidgets gPlot gbLibLoaded
1157 if { !$gbLibLoaded } { return }
1158 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return }
1159
1160 set gPlot($iID,state,nVariable) $inVariable
1161
1162 FsgdfPlot_PlotData $iID
1163 }
1164
1165
1166 # Set legend mode to subject or class.
1167 proc FsgdfPlot_SetMode { iID iMode } {
1168 global gGDF gWidgets gPlot gbLibLoaded
1169 if { !$gbLibLoaded } { return }
1170 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return }
1171 if { $iMode != "subject" && $iMode != "class" } { return }
1172
1173 set gPlot($iID,state,legend) $iMode
1174
1175 FsgdfPlot_PlotData $iID
1176 }
1177
1178
1179 # Set display settings for a class.
1180 proc FsgdfPlot_SetNthClassMarker { iID inClass iMarker } {
1181 global gGDF kValid gbLibLoaded
1182 if { !$gbLibLoaded } { return }
1183 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return }
1184 if { $inClass < 0 || $inClass >= $gGDF($iID,cClasses) } { return }
1185 if { [lsearch -exact $kValid(lMarkers) $iMarker] == -1 } { return }
1186
1187 set gGDF($iID,classes,$inClass,marker) $iMarker
1188
1189 FsgdfPlot_PlotData $iID
1190 }
1191
1192 proc FsgdfPlot_SetNthClassColor { iID inClass iColor } {
1193 global gGDF kValid gbLibLoaded
1194 if { !$gbLibLoaded } { return }
1195 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return }
1196 if { $inClass < 0 || $inClass >= $gGDF($iID,cClasses) } { return }
1197 if { [lsearch -exact $kValid(lColors) $iColor] == -1 } { return }
1198
1199 set gGDF($iID,classes,$inClass,color) $iColor
1200
1201 FsgdfPlot_PlotData $iID
1202 }
1203
1204
1205 # Choose a point to be displayed. Either choose one point or make a
1206 # point list to be averaged.
1207 proc FsgdfPlot_SetPoint { iID iX iY iZ } {
1208 global gbLibLoaded gGDF
1209 if { !$gbLibLoaded } { return }
1210 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return }
1211 FsgdfPlot_BeginPointList $iID
1212 FsgdfPlot_AddPoint $iID $iX $iY $iZ
1213 FsgdfPlot_EndPointList $iID
1214 }
1215
1216 proc FsgdfPlot_BeginPointList { iID } {
1217 global gGDF gPlot gbLibLoaded
1218 if { !$gbLibLoaded } { return }
1219 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return }
1220 set gPlot($iID,state,lPoints) {}
1221 }
1222
1223 proc FsgdfPlot_AddPoint { iID iX iY iZ } {
1224 global gGDF gWidgets gPlot gbLibLoaded
1225 if { !$gbLibLoaded } { return }
1226 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return }
1227 lappend gPlot($iID,state,lPoints) [list $iX $iY $iZ]
1228 set gPlot($iID,state,pointsChanged) 1
1229 }
1230
1231 proc FsgdfPlot_EndPointList { iID } {
1232 global gGDF gbLibLoaded
1233 if { !$gbLibLoaded } { return }
1234 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return }
1235 FsgdfPlot_PlotData $iID
1236 }
1237
1238
1239 # Set the info string displayed under the graph.
1240 proc FsgdfPlot_SetInfo { iID isInfo } {
1241 global gGDF gPlot gbLibLoaded
1242 if { !$gbLibLoaded } { return }
1243 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return }
1244 set gPlot($iID,state,info) $isInfo
1245 }
1246
1247
1248 # Save the currently plotted data to a table.
1249 proc FsgdfPlot_SaveToTable { iID ifnTable } {
1250 global gPlot gGDF gbLibLoaded
1251 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return }
1252
1253 set fp 0
1254 set err [catch {set fp [open $ifnTable w+]}]
1255 if { $err || $fp == 0 } {
1256 puts "Couldn't write file $ifnTable."
1257 return
1258 }
1259
1260 puts $fp "Graph: $gGDF($iID,title)"
1261 puts $fp "Data: $gGDF($iID,dataFileName)"
1262 puts $fp "Variable: $gGDF($iID,variables,$gPlot($iID,state,nVariable),label)"
1263 puts $fp "Measurement: $gGDF($iID,measurementName)"
1264 puts $fp "subject id, class id, variable value, measurement value, standard deviation"
1265 puts $fp "------------"
1266 for { set nSubj 0 } { $nSubj < $gGDF($iID,cSubjects) } { incr nSubj } {
1267
1268 set subjLabel $gGDF($iID,subjects,$nSubj,id)
1269 set classLabel $gGDF($iID,classes,$gGDF($iID,subjects,$nSubj,nClass),label)
1270 set var $gPlot($iID,state,data,subjects,$nSubj,variable)
1271 set meas $gPlot($iID,state,data,subjects,$nSubj,measurement)
1272 set stdDev $gPlot($iID,state,data,subjects,$nSubj,stdDev)
1273
1274 puts $fp "$subjLabel $classLabel $var $meas $stdDev"
1275 }
1276 puts $fp "------------"
1277 puts ""
1278
1279 close $fp
1280 }
1281
1282
1283 # Save the current plot graphic to a postscript file.
1284 proc FsgdfPlot_SaveToPostscript { iID ifnPS } {
1285 global gGDF gWidgets gbLibLoaded
1286 if { !$gbLibLoaded } { return }
1287 if { [lsearch $gGDF(lID) $iID] == -1 } { puts "ID not found"; return }
1288 set err [catch {$gWidgets($iID,gwPlot) postscript output $ifnPS} sResult]
1289 if { $err } {
1290 puts "Could not save postscript file: $sResult"
1291 }
1292 }
Attached Files
To refer to attachments on a page, use attachment:filename, as shown below in the list of files. Do NOT use the URL of the [get] link, since this is subject to change and can break easily.You are not allowed to attach a file to this page.