Annotation of capa/capa51/GUITools/capastats.tcl, revision 1.15

1.15    ! albertel    1: # capastatistics generator
        !             2: #  Copyright (C) 1992-2000 Michigan State University
        !             3: #
        !             4: #  The CAPA system is free software; you can redistribute it and/or
        !             5: #  modify it under the terms of the GNU Library General Public License as
        !             6: #  published by the Free Software Foundation; either version 2 of the
        !             7: #  License, or (at your option) any later version.
        !             8: #
        !             9: #  The CAPA system is distributed in the hope that it will be useful,
        !            10: #  but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            11: #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
        !            12: #  Library General Public License for more details.
        !            13: #
        !            14: #  You should have received a copy of the GNU Library General Public
        !            15: #  License along with the CAPA system; see the file COPYING.  If not,
        !            16: #  write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
        !            17: #  Boston, MA 02111-1307, USA.
        !            18: #
        !            19: #  As a special exception, you have permission to link this program
        !            20: #  with the TtH/TtM library and distribute executables, as long as you
        !            21: #  follow the requirements of the GNU GPL in regard to all of the
        !            22: #  software in the executable aside from TtH/TtM.
        !            23: 
1.1       albertel   24: ###########################################################
                     25: # runCapaTools
                     26: ###########################################################
                     27: ###########################################################
                     28: ###########################################################
                     29: proc runCapaTools { classDirConfigFile } {
                     30:     global gUniqueNumber gWindowMenu gFile gCT
                     31:     
                     32:     set num [incr gUniqueNumber]
                     33:     
                     34:     set classDir [file dirname $classDirConfigFile]
                     35:     set gFile($num) $classDir
                     36: 
                     37:     set utilsMenu [menu .utilsMenu$num -tearoff 0 -type tearoff -font 8x13bold \
                     38: 		       -disabledforeground grey85 ]
                     39:     set gCT($num) $utilsMenu
                     40: 
                     41:     set pathLength [string length $gFile($num)]
                     42:     if { $pathLength > 22 } {
                     43: 	set pathSubset ...[string range $gFile($num) [expr $pathLength - 22 ] end]
                     44:     } else {
                     45: 	set pathSubset $gFile($num)
                     46:     }
                     47:     $utilsMenu add command -label "CapaUtils Ver 1.1" -foreground grey85 -background \
                     48: 	black -state disabled 
                     49:     $utilsMenu add command -label $pathSubset -foreground white -background \
                     50: 	grey30 -state disabled 
                     51: 
                     52:     $utilsMenu add command -label "Change Class path" -command "CTchangePath $num"
                     53:     $utilsMenu add command -label "Run capastat" -command "CTcapaStat $num"
                     54:     $utilsMenu add command -label "Run capastat2" -command "CTcapaStat2 $num"
                     55:     $utilsMenu add command -label "Summarize Log files" -command "CTlogAnalysis $num"
                     56:     $utilsMenu add command -label "Student Course Profile" -command \
                     57: 	"CTstartStudentCourseProfile $num"
                     58:     $utilsMenu add command -label "CAPA IDs for one student" \
                     59: 	-command "CToneStudentCapaID $num"
                     60:     $utilsMenu add command -label "All CAPA IDs" -command "CTclassCapaID $num"
                     61:     $utilsMenu add command -label "Item Analysis" -command "CTitemAnalysisStart $num"
                     62:     $utilsMenu add command -label "Item Correlation" \
                     63: 	-command "CTitemCorrelationStart $num"
                     64: #    $utilsMenu add command -label "Email" -command ""
                     65: #    $utilsMenu add command -label "View Score File" -command ""
                     66:     $utilsMenu add command -label "View Submissions" -command "CTsubmissions $num"
1.6       albertel   67:     $utilsMenu add command -label "Create a Class Report" -command "CTcreateReport $num"
1.1       albertel   68:     $utilsMenu add command -label "Analyze Class Report" -command "CTanalyzeReport $num"
                     69:     $utilsMenu add command -label "Analyze Responses" -command "CTanalyzeScorer $num"
                     70:     $utilsMenu add command -label "Graph a Responses Analysis" -command "CTgraphAnalyzeScorer $num"
1.2       albertel   71:     $utilsMenu add command -label "Discussion Stats" -command "CTdiscussStats $num"
1.1       albertel   72:     $utilsMenu add command -label "Quit" -command "CTquit $num"
                     73:     $utilsMenu post 0 0
                     74:     Centre_Dialog $utilsMenu default
                     75:     set geometry [wm geometry $utilsMenu]
                     76:     wm geometry $utilsMenu +0+[lindex [split $geometry +] end]
                     77:     parseCapaConfig $num $gFile($num)
                     78:     parseCapaUtilsConfig $num $gFile($num)
                     79: }
                     80: 
                     81: #menu commands
                     82: 
                     83: ###########################################################
                     84: # CTchangePath
                     85: ###########################################################
                     86: ###########################################################
                     87: ###########################################################
                     88: #FIXME need to wait unit all running commands are done
                     89: proc CTchangePath { num } {
                     90:     global gFile gCapaConfig 
                     91:     set path [tk_getOpenFile -title "Please select a capa.config file" -filetypes \
                     92: 		 { { {Capa Config} {capa.config} } }]
                     93:     if { $path == "" } { return }
                     94:     set gFile($num) [file dirname $path]
                     95:     foreach temp [array names gCapaConfig "$num.*"] { unset gCapaConfig($temp) }
                     96:     parseCapaConfig $num $gFile($num)
                     97:     parseCapaUtilsConfig $num $gFile($num)
                     98:     set pathLength [string length $gFile($num)]
                     99:     if { $pathLength > 22 } {
                    100: 	set pathSubset ...[string range $gFile($num) [expr $pathLength - 22 ] end]
                    101:     } else {
                    102: 	set pathSubset $gFile($num)
                    103:     }
                    104:     .utilsMenu$num entryconfigure 1 -label $pathSubset
                    105: }
                    106: 
                    107: ###########################################################
                    108: # CTcapaStat2
                    109: ###########################################################
                    110: ###########################################################
                    111: ###########################################################
                    112: proc CTcapaStat2 { num } {
                    113:     global gFile gCT gUniqueNumber
1.9       albertel  114:    # if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { return }
                    115:     if {[set setId [pickSets [CTsetList $gFile($num)] single "Pick A Set" \
                    116: 			$gCT($num)]] == "Cancel" } { return }
1.1       albertel  117:     set cmdnum [incr gUniqueNumber]
                    118:     set gCT(cmd.$cmdnum) capastat
                    119:     if { [
                    120: 	  catch {
                    121: 	      CTdatestamp $cmdnum
1.14      albertel  122: 	      if { [set day [CTgetWhen $num $cmdnum $setId]] != ""} { 
                    123: 		  set start [lindex $day 0]
                    124: 		  set startf [clock format [lindex $day 0] -format "%b %d %R %Y"]
                    125: 		  set end [lindex $day 1]
                    126: 		  set endf [clock format [lindex $day 0] -format "%b %d %R %Y"]
                    127: 		  set file [file join $gFile($num) records "subset$setId.db"]
                    128: 		  displayStatus "Generating [file tail $file]" both $cmdnum    
                    129: 		  CTcreateSubset $num $cmdnum $start $end $setId
                    130: 		  updateStatusBar 0.0 $cmdnum
                    131: 		  updateStatusMessage "Generating Stats [file tail $file]" $cmdnum
                    132: 		  CTscanSetDB $cmdnum $file Q_cnt L_cnt
                    133: 		  updateStatusBar 0.0 $cmdnum
                    134: 		  updateStatusMessage "Generating Averages [file tail $file]" $cmdnum
                    135: 		  CTpercentageScores $cmdnum $setId $L_cnt 1
                    136: 		  CTaverage $cmdnum $Q_cnt $L_cnt faillist dodifflist numyes
                    137: 		  if { $L_cnt != 0 } {
                    138: 		      CTbargraph $gCT($num) $num [incr gUniqueNumber] $faillist \
                    139: 			  $gFile($num) \
                    140: 	     "Not-Yet-Correct, set $setId, for $startf -> $endf" \
                    141: 			  "Problem \#" "%Wrong"
                    142: 		      CTbargraph $gCT($num) $num [incr gUniqueNumber] $dodifflist \
                    143: 			  $gFile($num) \
                    144:              "Degree of Difficulty, set $setId, for $startf-$endf" \
                    145: 			  "Problem \#" "Deg. Of Diff."
                    146: 		      CTbargraph $gCT($num) $num [incr gUniqueNumber] $numyes \
                    147: 			  $gFile($num) \
                    148:              "Number of Yeses, set $setId, for $startf -> $endf" \
                    149: 			  "Problem \#" "\#Students"
                    150: 		  }
                    151: 		  CToutput $num $cmdnum
                    152: 		  removeStatus $cmdnum
1.1       albertel  153: 	      }
                    154: 	  } errors ] } {
                    155: 	global errorCode errorInfo
                    156: 	displayError "$errors\n$errorCode\n$errorInfo"
                    157: 	unset gCT(cmd.$cmdnum)
                    158:     } else {
                    159: 	unset gCT(cmd.$cmdnum)
                    160:     }
                    161: }
                    162: 
                    163: ###########################################################
                    164: # CTcapaStat
                    165: ###########################################################
                    166: ###########################################################
                    167: ###########################################################
                    168: proc CTcapaStat { num } {
                    169:     global gFile gCT gUniqueNumber
1.9       albertel  170: #    if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { return }
                    171:     if {[set setId [pickSets [CTsetList $gFile($num)] single "Pick A Set" \
                    172: 			$gCT($num)]] == "Cancel" } { return }
1.1       albertel  173:     set cmdnum [incr gUniqueNumber]
                    174:     set gCT(cmd.$cmdnum) capastat
                    175:     if { [
                    176: 	  catch {
                    177: 	      CTdatestamp $cmdnum
                    178: 	      set file [file join $gFile($num) records "set$setId.db"]
                    179: 	      displayStatus "Generating Stats [file tail $file]" both $cmdnum    
                    180: 	      CTscanSetDB $cmdnum $file Q_cnt L_cnt
                    181: 	      updateStatusBar 0.0 $cmdnum
                    182: 	      updateStatusMessage "Generating Averages [file tail $file]" $cmdnum
                    183: 	      CTpercentageScores $cmdnum $setId $L_cnt
                    184: 	      CTaverage $cmdnum $Q_cnt $L_cnt faillist dodifflist numyes
                    185: 	      CTbargraph $gCT($num) $num [incr gUniqueNumber] $faillist $gFile($num) "Not-Yet-Correct Distribution for set $setId" "Problem \#" "%Wrong"
                    186: 	      CTbargraph $gCT($num) $num [incr gUniqueNumber] $dodifflist $gFile($num) "Degree of Difficulty Distribution for set $setId" "Problem \#" "Degree Of Diff."
                    187: 	      CTbargraph $gCT($num) $num [incr gUniqueNumber] $numyes $gFile($num) "Number of Yeses received for set $setId" "Problem \#" "\#Students"
                    188: 	      removeStatus $cmdnum
                    189: 	      CToutput $num $cmdnum
                    190: 	  } errors ] } {
                    191: 	global errorCode errorInfo
                    192: 	displayError "$errors\n$errorCode\n$errorInfo"
                    193: 	unset gCT(cmd.$cmdnum)
                    194:     } else {
                    195: 	unset gCT(cmd.$cmdnum)
                    196:     }
                    197: }
                    198: 
                    199: ###########################################################
                    200: # CTlogAnalysis
                    201: ###########################################################
                    202: ###########################################################
                    203: ###########################################################
                    204: proc CTlogAnalysis { num } {
                    205:     global gFile gUniqueNumber gCT
1.9       albertel  206:     #if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { return }
                    207:     if {[set setId [pickSets [CTsetList $gFile($num)] single "Pick A Set" \
                    208: 			$gCT($num)]] == "Cancel" } { return }
1.1       albertel  209:     set cmdnum [incr gUniqueNumber]
                    210:     set gCT(cmd.$cmdnum) loganalysis
                    211:     CTdatestamp $cmdnum
                    212:     if { [ catch { CTlogAnalysis2 $num $cmdnum $setId } errors ] } {
                    213: 	displayError $errors
                    214: 	unset gCT(cmd.$cmdnum)
                    215:     } else {
                    216: 	unset gCT(cmd.$cmdnum) 
                    217:     }
                    218:     CToutput $num $cmdnum
                    219: }
                    220: 
                    221: ###########################################################
                    222: # CTstartStudentCourseProfile
                    223: ###########################################################
                    224: ###########################################################
                    225: ###########################################################
                    226: proc CTstartStudentCourseProfile { num } {
                    227:     global gFile gCT
                    228:     getOneStudent $gCT($num) $gFile($num) s_id s_name
                    229:     if { $s_id == "" } { return }
                    230:     CTstudentCourseProfile $num $s_id $s_name
                    231: }
                    232: 
                    233: ###########################################################
                    234: # CTstudentCourseProfile
                    235: ###########################################################
                    236: ###########################################################
                    237: ###########################################################
                    238: proc CTstudentCourseProfile { num s_id s_name {loginAnalysis 2} } {
                    239:     global gFile gUniqueNumber gCapaConfig gCT
                    240: 
                    241:     set cmdnum [incr gUniqueNumber]
                    242:     set gCT(cmd.$cmdnum) studentcourseprofile
                    243:     displayStatus "Collecting homework scores for $s_name" both $cmdnum
                    244:     CTdatestamp $cmdnum
                    245:     CTputs $cmdnum "$s_name\n"
                    246:     if { [ catch { CTcollectSetScores $cmdnum $gFile($num) $s_id 1 \
                    247: 		      $gCapaConfig($num.homework_scores_limit_set) } error ] } {
                    248: 	global errorCode errorInfo
                    249: 	displayError "$error \n $errorCode \n $errorInfo"
                    250:     }
                    251:     foreach type { quiz exam supp others } {
                    252: 	updateStatusMessage "Collecting $type scores for $s_name" $cmdnum
                    253: 	catch { 
                    254: 	    if { [file isdirectory $gCapaConfig($num.[set type]_path)] } {
                    255: 		CTcollectSetScores $cmdnum $gCapaConfig($num.[set type]_path) $s_id 1 \
                    256: 		    $gCapaConfig($num.[set type]_scores_limit_set)
                    257: 	    } 	    
                    258: 	}
                    259:     }
                    260:     removeStatus $cmdnum
                    261:     if { ($loginAnalysis == 2 && "Yes" == [makeSure \
                    262: 		       "Do you wish to do a Login Analysis? It may take a while." ])
                    263: 	 || ($loginAnalysis == 1) } {
                    264: 	displayStatus "Analyzing login data." both $cmdnum
                    265: 	if { [catch { CTloginAnalysis $cmdnum $gFile($num) $s_id \
                    266: 			  $gCapaConfig($num.homework_scores_limit_set) } error] } {
                    267: 	    displayError error
                    268: 	}
                    269: 	if { [catch { CTstudentSetAnalysis $cmdnum $gFile($num) $s_id \
                    270: 			  $gCapaConfig($num.homework_scores_limit_set) } error] } {
                    271: 	    displayError error
                    272: 	}
                    273: 	removeStatus $cmdnum
                    274:     }
                    275:     CTdisplayStudent $cmdnum $gCT($num) $gFile($num) $s_id
                    276:     unset gCT(cmd.$cmdnum)
                    277:     CToutput $num $cmdnum
                    278: }
                    279: 
                    280: ###########################################################
                    281: # CToneStudentCapaID
                    282: ###########################################################
                    283: ###########################################################
                    284: ###########################################################
                    285: proc CToneStudentCapaID { num } {
                    286:     global gFile gUniqueNumber gCapaConfig gCT
                    287: 
                    288:     getOneStudent $gCT($num) $gFile($num) s_id s_name
                    289:     if { $s_id == "" } { return }
                    290: 
                    291:     set cmdnum [incr gUniqueNumber]
                    292:     set gCT(cmd.$cmdnum) onestudentcapaid
                    293:     set setlist [getSetRange $gCT($num) $gFile($num)]
                    294:     set command "$gCapaConfig($num.allcapaid_command) -i -stu $s_id -s [lindex $setlist 0] -e [lindex $setlist 1] -c $gFile($num)"
                    295:     if { "Yes" == [makeSure "CMD: $command\n Do you wish to execute this command?"] } {
                    296: 	CTdatestamp $cmdnum
                    297: 	CTputs $cmdnum "CapaIDs for: $s_id, $s_name\n"
                    298: 	displayStatus "Getting CapaIDs" spinner $cmdnum
                    299: 	set fileId [open "|$command" "r"]
                    300: 	fconfigure $fileId -blocking 0
                    301: 	fileevent $fileId readable "CTrunCommand $num $cmdnum $fileId"
                    302:     }
                    303: }
                    304: 
                    305: ###########################################################
                    306: # CTclassCapaID
                    307: ###########################################################
                    308: ###########################################################
                    309: ###########################################################
                    310: proc CTclassCapaID { num } {
                    311:     global gFile gUniqueNumber gCapaConfig gCT
                    312: 
                    313:     set cmdnum [incr gUniqueNumber]
                    314:     set gCT(cmd.$cmdnum) classcapaid
                    315:     set setlist [getSetRange $gCT($num) $gFile($num)]
                    316:     if { $setlist == "" } { return }
                    317:     set command "$gCapaConfig($num.allcapaid_command) -i -s [lindex $setlist 0] -e [lindex $setlist 1] -c $gFile($num)"
                    318:     if { "Yes" == [makeSure "CMD: $command\n Do you wish to execute this command?"] } {
                    319: 	CTdatestamp $cmdnum
                    320: 	displayStatus "Getting all CapaIDs" spinner $cmdnum
                    321: 	set fileId [open "|$command" "r"]
                    322: 	fconfigure $fileId -blocking 0
                    323: 	fileevent $fileId readable "CTrunCommand $num $cmdnum $fileId"
                    324:     }
                    325: }
                    326: 
                    327: ###########################################################
                    328: # CTitemAnalysisStart
                    329: ###########################################################
                    330: ###########################################################
                    331: ###########################################################
                    332: proc CTitemAnalysisStart { num } {
                    333:     global gFile gUniqueNumber gCapaConfig gCT
                    334:     
                    335:     set cmdnum [incr gUniqueNumber]
                    336:     set gCT(cmd.$cmdnum) itemanalysis
                    337:     set paths ""
                    338:     lappend paths [list "classpath" $gFile($num)]
                    339:     foreach path [lsort [array names gCapaConfig "$num.*_path"]] {
                    340: 	lappend paths [list [lindex [split $path "."] 1] $gCapaConfig($path) ] 
                    341:     }
                    342:     if {[set select [multipleChoice $gCT($num) "Select a class path" $paths ] ] == ""} {
                    343:     	unset gCT(cmd.$cmdnum)
                    344: 	return
                    345:     }
1.9       albertel  346: #    if { [set sets [getSetRange $gCT($num) [lindex $select 1]]] == "" } \{
                    347:     if { [set sets [pickSets [CTsetList [lindex $select 1]] \
                    348: 			"extended" "Select Sets" $gCT($num)]] == "Cancel" } {
1.1       albertel  349: 	unset gCT(cmd.$cmdnum)
                    350: 	return 
                    351:     }
                    352:     CTdatestamp $cmdnum
1.9       albertel  353:     if { [ catch {CTitemAnalysisRange $cmdnum [lindex $select 1] $sets } errors ] } { 
1.1       albertel  354: 	displayError $errors 
                    355:     }
                    356:     unset gCT(cmd.$cmdnum)
                    357:     CToutput $num $cmdnum
                    358: }
                    359: 
                    360: ###########################################################
                    361: # CTitemCorrelationStart
                    362: ###########################################################
                    363: ###########################################################
                    364: ###########################################################
                    365: proc CTitemCorrelationStart { num } {
                    366:     global gFile gUniqueNumber gCapaConfig gCT
                    367: 
                    368:     ## FIXME:
                    369:     ##         Let user specify how many categories to calculate correlation
                    370:     ##             For each category, the user can specify problem numbers to 
                    371:     ##             be in that category
                    372:     ##         Then, the correlations between each category is calculated
                    373:     ##
                    374:     set cmdnum [incr gUniqueNumber]
                    375:     set gCT(cmd.$cmdnum) itemanalysis
                    376:     set paths ""
                    377:     lappend paths [list "classpath" $gFile($num)]
                    378:     foreach path [lsort [array names gCapaConfig "$num.*_path"]] {
                    379: 	lappend paths [list [lindex [split $path "."] 1] $gCapaConfig($path) ] 
                    380:     }
1.9       albertel  381:     if {[set select [multipleChoice $gCT($num) "Select a class path" $paths]] == ""} {
1.1       albertel  382:     	unset gCT(cmd.$cmdnum)
                    383: 	return
                    384:     }
1.9       albertel  385:     #if { [set setId [getOneSet $gCT($num) [lindex $select 1]]] == "" } \{ 
                    386:     if {[set setId [pickSets [CTsetList [lindex $select 1]] single "Pick A Set" \
                    387: 			$gCT($num)]] == "Cancel" } {
1.1       albertel  388: 	unset gCT(cmd.$cmdnum)
                    389: 	return 
                    390:     }
                    391:     CTdatestamp $cmdnum
                    392:     if { [ catch { CTitemCorrelation $cmdnum [lindex $select 1] \
                    393: 		       $setId } errors ] } { displayError $errors }
                    394:     unset gCT(cmd.$cmdnum)
                    395:     CToutput $num $cmdnum    
                    396: }
                    397: 
                    398: ###########################################################
                    399: # CTsubmissions
                    400: ###########################################################
                    401: ###########################################################
                    402: ###########################################################
                    403: proc CTsubmissions { num } {
                    404:     global gCT gFile gUniqueNumber gCapaConfig
                    405:     
                    406:     getOneStudent $gCT($num) $gFile($num) s_id s_name
                    407:     if { $s_id == "" } { return }
                    408: 
                    409:     set cmdnum [incr gUniqueNumber]
                    410:     set gCT(cmd.$cmdnum) submissions
1.9       albertel  411:     if { [set sets [pickSets [CTsetList $gFile($num)] \
                    412: 			"extended" "Select Sets" $gCT($num)]] == "Cancel" } { return }
                    413: #    if { "" == [set setlist [getSetRange $gCT($num) $gFile($num)]] } { return }
1.1       albertel  414:     CTdatestamp $cmdnum
                    415:     CTputs $cmdnum "Submissions for: $s_id, $s_name\n"
                    416:     displayStatus "Getting submissions" spinner $cmdnum
1.9       albertel  417:     CTsubmissionsLaunch $num $cmdnum telnet $s_id $s_name 0 $sets
1.1       albertel  418: }
                    419: 
                    420: ###########################################################
1.6       albertel  421: # CTcreateReport
                    422: ###########################################################
                    423: ###########################################################
                    424: ###########################################################
                    425: proc CTcreateReport { num } {
                    426:     global gUniqueNumber gCT gFile
                    427: 
                    428:     set cmdnum [incr gUniqueNumber]
                    429:     set gCT(cmd.$cmdnum) createreport
                    430:     CTcreateReportDialog $num $cmdnum
                    431: }
                    432: 
                    433: ###########################################################
1.1       albertel  434: # CTanalyzeReport
                    435: ###########################################################
                    436: ###########################################################
                    437: ###########################################################
                    438: proc CTanalyzeReport { num } {
                    439:     global gUniqueNumber gCT gFile
                    440: 
                    441:     set cmdnum [incr gUniqueNumber]
                    442:     set gCT(cmd.$cmdnum) analyzereport
                    443:     
                    444:     set reportFile [tk_getOpenFile -title "Please select the Report file" \
                    445: 			-filetypes  { {{Capa Reports} {*.rpt}} {{All Files} {*}} }]
                    446:     if { $reportFile == "" } { return }
                    447:     set percentage [tk_dialog $gCT($num).dialog "How would you like scores displayed?" \
                    448: 		    "How would you like scores displayed?" "" "" "Points Earned" \
                    449: 		    "Percentage" "Cancel"]
                    450:     if { $percentage == 2 } { return }
                    451:     set pwd [pwd];cd $gFile($num)
                    452:     set sectionList [pickSections [getExistingSections] "Select Sections To Analyze:" $gCT($num) ]
                    453:     CTdatestamp $cmdnum
                    454:     CTputs $cmdnum "Analyzing Report File $reportFile\n"
                    455:     CTputs $cmdnum "   For Sections $sectionList\n"
                    456:     CTputs $cmdnum "   Report Created at [clock format [file mtime $reportFile]]\n"
                    457:     cd $pwd
                    458:     set scorelist [CTreportDist $cmdnum $reportFile $percentage $sectionList]
                    459:     set label [lindex "{Grade} {Grade(%)}" $percentage]
                    460:     set ptsearned 0
                    461:     set totalnumstu 0
                    462:     foreach element $scorelist {
                    463: 	set numstu [lindex $element 0]
                    464: 	set score [lindex $element 1]
                    465: 	set ptsearned [expr $ptsearned + ($numstu*$score)]
                    466: 	incr totalnumstu $numstu
                    467:     }
                    468:     set average [expr $ptsearned / double($totalnumstu)]
                    469:     set avgmsg [format "Average: %.2f" $average]
                    470:     CTputs $cmdnum $avgmsg\n
                    471:     CTbargraph $gCT($num) $num $cmdnum $scorelist $gFile($num) "Score Distribution for [file tail $reportFile] $avgmsg" $label "\# Students" SCP
                    472:     unset gCT(cmd.$cmdnum)
                    473:     CToutput $num $cmdnum
                    474: }
                    475: 
                    476: ###########################################################
                    477: # CTanalyzeScorer
                    478: ###########################################################
                    479: ###########################################################
                    480: ###########################################################
                    481: proc CTanalyzeScorer { num } {
                    482:     global gFile gUniqueNumber gCapaConfig gCT    
                    483:     set cmdnum [incr gUniqueNumber]
1.14      albertel  484: #    puts "CTanalyzeScorer $cmdnum"
1.1       albertel  485:     set gCT(cmd.$cmdnum) analyzescorer
                    486:     if { "" == [set file [tk_getOpenFile -title "Pick a scorer.output file" -filetypes { { {scorer.output} {scorer.output.*} } { {Submissions File} {*submissions*.db} } { {All Files} {*} } }]] } { return }
                    487:     set path [file dirname [file dirname $file]]
                    488:     if { "" == [set gCT($cmdnum.questNum) [getString $gCT($num) "Which questions?"]]} {
                    489: 	return
                    490:     }
                    491:     set gCT($cmdnum.max) [lindex [exec wc -l $file] 0]
                    492:     set gCT($cmdnum.done) 1
                    493:     set gCT($cmdnum.graphup) 0
                    494:     set gCT($cmdnum.num) $num
                    495:     displayStatus "Getting student reponses" both $cmdnum
                    496:     set gCT($cmdnum.fileId) [open $file r]
                    497:     if { [regexp {scorer\.output\.([0-9]|([0-9][0-9]))} $file] } {
                    498: 	set gCT($cmdnum.setId) [string range [file extension $file] 1 end]
                    499: 	set gCT($cmdnum.parse) CTparseScorerOutputLine
                    500: 	set aline [gets $gCT($cmdnum.fileId)]
                    501:     } else {
                    502: 	set gCT($cmdnum.setId) [lindex [split [file tail $file] s.] 4]
                    503: 	set gCT($cmdnum.parse) CTparseSubmissionsLine
                    504:     }
                    505:     set aline [gets $gCT($cmdnum.fileId)]
                    506:     $gCT($cmdnum.parse) $aline $cmdnum 
                    507:     set pwd [pwd];cd $path
                    508:     getSet $gCT($cmdnum.question) $gCT($cmdnum.setId) "CTcontinueAnalyze $cmdnum $path"
                    509:     cd $pwd
                    510: }
                    511: 
1.14      albertel  512: proc CTcontinueAnalyze { cmdnum path arrayData } {
                    513: #    puts "CTcontinueAnalyze $cmdnum"
                    514:     global gCT gResponse gGetSet
                    515:     array set question $arrayData
                    516:     while {1} {
                    517: 	CTgetQuestions $cmdnum question
                    518: 	set numAdded 0
                    519: 	foreach which $gCT($cmdnum.questNum) {
                    520: 	    #	puts $gCT($cmdnum.response)
                    521: 	    incr numAdded [CTgetStudentResponses $cmdnum [lindex $gCT($cmdnum.response) \
                    522: 							      [expr $which-1]] $which \
                    523: 			       question]
                    524: 	    #	puts $numAdded
                    525: 	}
                    526: 	#    puts "end"
                    527: 	updateStatusBar [expr $gCT($cmdnum.done)/double($gCT($cmdnum.max))] $cmdnum
                    528: 	if { $numAdded > 0 } { CTupdateAnalyzeScorer $cmdnum }
                    529: 	set interesting 0
                    530: 	while {!$interesting} {
                    531: 	    incr gCT($cmdnum.done)
                    532: 	    set stunum $gCT($cmdnum.question)
                    533: 	    set aline [gets $gCT($cmdnum.fileId)]
                    534: 	    if { [eof $gCT($cmdnum.fileId)] } { CTfinishAnalyzeScorer $cmdnum; return }
                    535: 	    set interesting [$gCT($cmdnum.parse) $aline $cmdnum]
                    536: 	}
                    537: 	if { $stunum != $gCT($cmdnum.question) } {
                    538: 	    set pwd [pwd];cd $path
                    539: 	    getSet $gCT($cmdnum.question) $gCT($cmdnum.setId) \
                    540: 		"CTcontinueAnalyze $cmdnum $path"
                    541: 	    cd $pwd
                    542: 	    break
                    543: 	} 
1.1       albertel  544:     }
1.14      albertel  545: #    puts "After Continue Analyze"
1.1       albertel  546: }
                    547: 
                    548: proc CTupdateAnalyzeScorer { cmdnum } {
1.14      albertel  549: #    puts "CTupdateAnalyzeScorer $cmdnum"
1.1       albertel  550:     global gCT gResponse gUniqueNumber gFile
                    551:     set num $gCT($cmdnum.num)
                    552:     set i 0
                    553:     foreach correct [array names gResponse "$cmdnum.correct.*"] {
                    554: 	set probnum [lindex [split $correct .] 2]
                    555: 	set answer [join [lrange [split $correct .] 3 end] .]
                    556: 	if { $gResponse($correct) } {
1.14      albertel  557: 	    set color($probnum.$answer) grey90
                    558: 	    set color($probnum.$answer.unpicked) grey10
1.1       albertel  559: 	} else {
1.14      albertel  560: 	    set color($probnum.$answer) grey30
                    561: 	    set color($probnum.$answer.unpicked) grey70
1.1       albertel  562: 	}
                    563:     }
                    564:     set results ""
                    565:     foreach response [lsort -dictionary [array names gResponse $cmdnum.\[0-9\]*]] {
1.14      albertel  566:         incr i
                    567: 	set responselm [split $response .]
                    568: 	set probnum [lindex $responselm 1]
                    569: 	if { [lindex $responselm 2] == "unpicked" } {
                    570: 	    set answerfull [join [lrange $responselm 3 end] .]
                    571: 	    set colorstring "$probnum.$answerfull.unpicked"
                    572: 	    append answerfull " - Unpicked"
                    573: 	    set answertemp [split [join [lrange $responselm 3 end] .] -]
                    574: 	    set picked 0
                    575: 	} else {
                    576: 	    set answerfull [join [lrange $responselm 2 end] .]
                    577: 	    set colorstring "$probnum.$answerfull"
                    578: 	    append answerfull " - Picked"
                    579: 	    set answertemp [split [join [lrange $responselm 2 end] .] -]
                    580: 	    set picked 1
                    581: 	}
                    582: 	set answernum [llength $answertemp]
                    583: 	set answer [join [lrange $answertemp 0 [expr $answernum - 2]] -]
                    584: 	if { " Correct" == [lindex $answertemp end] } {
                    585: 	    if { $picked } { set pos 0 } { set pos 3 }
                    586: 	} { if { $picked } { set pos 2 } { set pos 1 } }
                    587: 	
                    588: 	if { [catch {set resultsAr($probnum.$answer.y)} ] } {
                    589: 	    set resultsAr($probnum.$answer.y) "0 0 0 0"
                    590: 	    set resultsAr($probnum.$answer.description) "{} {} {} {}"
                    591: 	    set resultsAr($probnum.$answer.color) "green green green green"
                    592: 	} 
                    593: 	set resultsAr($probnum.$answer.y) [lreplace $resultsAr($probnum.$answer.y) \
                    594: 					       $pos $pos $gResponse($response)]
                    595: 	set resultsAr($probnum.$answer.description) [lreplace \
                    596: 					$resultsAr($probnum.$answer.description) \
                    597: 					$pos $pos $answerfull]
                    598: 	set resultsAr($probnum.$answer.color) [lreplace \
                    599:                                         $resultsAr($probnum.$answer.color) $pos $pos \
                    600: 					$color($colorstring)]
                    601:     }
                    602:     set i 0
                    603:     set oldprobnum ""
                    604:     foreach name [lsort -dictionary [array names resultsAr "*.y"]] {
1.1       albertel  605: 	incr i
1.14      albertel  606: 	set name [split $name .]
                    607: 	set namelength [llength $name]
                    608: 	set answer [join [lrange $name 1 [expr $namelength - 2]] .]
                    609: 	set probnum [lindex $name 0]
1.1       albertel  610: 	if { $probnum > $oldprobnum } {
1.14      albertel  611: 	    if { $oldprobnum != "" } {
                    612: 		lappend results [list 0 0 "Problem Divider" white]
                    613: 	    }
1.1       albertel  614: 	    set oldprobnum $probnum
                    615: 	}
1.14      albertel  616: 	lappend results [list $resultsAr($probnum.$answer.y) $i $resultsAr($probnum.$answer.description) $resultsAr($probnum.$answer.color)]
1.1       albertel  617:     }
                    618:     if { $results == "" } { return }
                    619:     if { $gCT($cmdnum.graphup)} {
                    620: 	CTchangeBargraphData $cmdnum $results
                    621:     } else {
                    622: 	CTbargraph $gCT($num) $num $cmdnum $results $gFile($num) "Reponse Distribution" "Which Response" "\#Picked" "Showresponse"
                    623: 	set gCT($cmdnum.graphup) 1
                    624:     }
                    625:     
                    626:     update idletasks
                    627: }
                    628: 
                    629: proc CTsaveAnalyzeScorer { num cmdnum } {
                    630:     global gResponse gCT gFile
1.14      albertel  631: 
                    632:     if { $gCT(spinlock) } { after 50 "CTsaveAnalyzeScorer $num $cmdnum"; return } 
                    633: 
                    634:     set gCT(spinlock) 1
                    635:     if { "Yes" ==[makeSure "Would you like to save the results to a file?"] } {
                    636: 	set file [tk_getSaveFile -initialdir $gFile($num)]
                    637: 	set fileId [open $file w]
                    638: 	puts $fileId [array get gResponse "$cmdnum.*"]
                    639: 	close $fileId
                    640:     }
                    641:     set gCT(spinlock) 0
                    642:     unset gCT(cmd.$cmdnum)
                    643:     CToutput $num $cmdnum
                    644: 
1.1       albertel  645: }
                    646: 
                    647: proc CTfinishAnalyzeScorer { cmdnum } {
                    648:     global gCT gResponse gUniqueNumber gFile
                    649: 
                    650:     set num $gCT($cmdnum.num)
                    651:     set i 0
                    652:     removeStatus $cmdnum
                    653:     foreach correct [array names gResponse "$cmdnum.correct.*"] {
                    654: 	set probnum [lindex [split $correct .] 2]
                    655: 	set answer [join [lrange [split $correct .] 3 end] .]
                    656: 	if { $gResponse($correct) } {
                    657: 	    set color($probnum.$answer) green
1.14      albertel  658: 	    set color($probnum.$answer.unpicked) orange
1.1       albertel  659: 	} else {
                    660: 	    set color($probnum.$answer) red
1.14      albertel  661: 	    set color($probnum.$answer.unpicked) blue
1.1       albertel  662: 	}
                    663:     }
                    664:     foreach response [lsort -dictionary [array names gResponse $cmdnum.\[0-9\]*]] {
1.14      albertel  665:         incr i
                    666: 	set responselm [split $response .]
                    667: 	set probnum [lindex $responselm 1]
                    668: 	if { [lindex $responselm 2] == "unpicked" } {
                    669: 	    set answerfull [join [lrange $responselm 3 end] .]
                    670: 	    set colorstring "$probnum.$answerfull.unpicked"
                    671: 	    append answerfull " - Unpicked"
                    672: 	    set answertemp [split [join [lrange $responselm 3 end] .] -]
                    673: 	    set picked 0
                    674: 	} else {
                    675: 	    set answerfull [join [lrange $responselm 2 end] .]
                    676: 	    set colorstring "$probnum.$answerfull"
                    677: 	    append answerfull " - Picked"
                    678: 	    set answertemp [split [join [lrange $responselm 2 end] .] -]
                    679: 	    set picked 1
                    680: 	}
                    681: 	set answernum [llength $answertemp]
                    682: 	set answer [join [lrange $answertemp 0 [expr $answernum - 2]] -]
                    683: 	if { " Correct" == [lindex $answertemp end] } {
                    684: 	    if { $picked } { set pos 0 } { set pos 3 }
                    685: 	} { if { $picked } { set pos 2 } { set pos 1 } }
                    686: 	
                    687: 	if { [catch {set resultsAr($probnum.$answer.y)} ] } {
                    688: 	    set resultsAr($probnum.$answer.y) "0 0 0 0"
                    689: 	    set resultsAr($probnum.$answer.description) "{} {} {} {}"
                    690: 	    set resultsAr($probnum.$answer.color) "green green green green"
                    691: 	} 
                    692: 	set resultsAr($probnum.$answer.y) [lreplace $resultsAr($probnum.$answer.y) \
                    693: 					       $pos $pos $gResponse($response)]
                    694: 	set resultsAr($probnum.$answer.description) [lreplace \
                    695: 					$resultsAr($probnum.$answer.description) \
                    696: 					$pos $pos $answerfull]
                    697: 	set resultsAr($probnum.$answer.color) [lreplace \
                    698:                                         $resultsAr($probnum.$answer.color) $pos $pos \
                    699: 					$color($colorstring)]
                    700:     }
                    701:     set i 0
                    702:     foreach name [array names resultsAr "*.y"] {
1.1       albertel  703: 	incr i
1.14      albertel  704: 	set name [split $name .]
                    705: 	set namelength [llength $name]
                    706: 	set answer [join [lrange $name 1 [expr $namelength - 2]] .]
                    707: 	set probnum [lindex $name 0]
                    708: 	lappend results($probnum) [list $resultsAr($probnum.$answer.y) $i $resultsAr($probnum.$answer.description) $resultsAr($probnum.$answer.color)]
                    709:     }
1.1       albertel  710:     foreach probnum [lsort -dictionary [array names results]] {
                    711: 	CTputs $cmdnum "\nFor Problem $probnum #, Responses:\n"
                    712: 	foreach response $results($probnum) {
                    713: 	    CTputs $cmdnum "[lindex $response 0], [lindex $response 2]\n"
                    714: 	}
                    715:     }
1.14      albertel  716:     if { [catch {set gCT(spinlock)}] } { set gCT(spinlock) 0 }
                    717:     CTsaveAnalyzeScorer $num $cmdnum
1.1       albertel  718: }
                    719: 
                    720: proc CTparseScorerOutputLine { aline num } {
1.14      albertel  721: #    puts "CTparseScorerOutputLine $num"
1.1       albertel  722:     global gCT
                    723:     set gCT($num.stunum) [lindex $aline 0]
                    724:     set aline [string range $aline 40 end]
                    725:     set length  [llength [split [lrange $aline 3 end] ,] ]
                    726:     set gCT($num.response) [lrange [split [lrange $aline 3 end] ,] 0 \
                    727: 				   [expr {$length-2}]]
                    728:     set gCT($num.question) [lindex [lindex [split $aline ,] end] 0]
                    729:     return 1
                    730: }
                    731: 
                    732: proc CTparseSubmissionsLine { aline num } {
1.14      albertel  733: #    puts "CTparseSubmissionsLine $num"
1.1       albertel  734:     global gCT
                    735:     set aline [split $aline \t]
                    736:     set gCT($num.stunum) [lindex $aline 0]
                    737:     set gCT($num.question) $gCT($num.stunum)
                    738:     set gCT($num.response) ""
                    739:     set interesting 0
                    740:     set current 1
1.13      albertel  741:     foreach element [lrange $aline 2 end] {
1.14      albertel  742: 	set quest [lindex [split $element " "] 0]
                    743: 	set response [lindex [split $element " "] 1]
1.1       albertel  744: 	if { $quest == "" } break
                    745: 	while { $quest > $current } {
                    746: 	    lappend gCT($num.response) {}
                    747: 	    incr current
                    748: 	}
                    749: 	if { [lsearch $gCT($num.questNum) $quest] != -1} { set interesting 1 }
                    750: 	lappend gCT($num.response) [string toupper $response]
                    751: 	incr current
                    752:     }
                    753:     return $interesting
                    754: }
                    755: 
                    756: proc CTgetQuestions { num questionVar } {
1.14      albertel  757: #    puts "CTgetQuestions $num"
1.1       albertel  758:     global gCT
                    759:     upvar $questionVar question
                    760: #    parray question
                    761:     foreach quest $gCT($num.questNum) {
                    762: 	foreach line $question($quest.quest) {
                    763: 	    if { [regexp {^ *([A-Z])\)(.*)} $line temp letter rest] } {
                    764: 		set question($quest.$letter) $rest
                    765: 		if { [string first $letter $question($quest.ans)] != -1} {
                    766: 		    set question($quest.correct.$letter) 1
                    767: 		    set question($quest.$letter) "$rest - Correct"
                    768: 		} else {
                    769: 		    set question($quest.correct.$letter) 0
                    770: 		    set question($quest.$letter) "$rest - Incorrect"
                    771: 		}
                    772: 	    }
                    773: 	}
                    774:     }
                    775: }
                    776: 
1.14      albertel  777: proc CTgetStudentResponses2 { num responses which questionVar } {
1.1       albertel  778:     global gCT gResponse
                    779:     upvar $questionVar question
                    780: #    parray question
                    781:     set i 0
                    782:     foreach response [split $responses {}] {
                    783: 	if { $response == "" || $response == " "} { continue } 
                    784: 	incr i
                    785: 	if { [catch {incr gResponse($num.$which.$question($which.$response))}] } {
                    786: 	    if {[catch {set gResponse($num.$which.$question($which.$response)) 1}]} {
                    787:                 #set gResponse($num.$which.Illegal\ Bubble) 1
1.14      albertel  788: #		puts "not an option $response $which"
1.1       albertel  789: 		continue
                    790:             }	    
                    791: 	}
                    792: 	if { $question($which.correct.$response) } {
                    793: 	    set gResponse($num.correct.$which.$question($which.$response)) 1
                    794: 	} else {
                    795: 	    set gResponse($num.correct.$which.$question($which.$response)) 0
                    796: 	}
                    797:     }
                    798:     return $i
                    799: }
                    800: 
1.14      albertel  801: proc CTgetStudentResponses { num responses which questionVar } {
                    802: #    puts "CTgetStudentResponses $num"
                    803:     global gCT gResponse
                    804:     upvar $questionVar question
                    805: #    parray question
                    806:     set i 0
                    807:     if {$responses == ""} { return 0 } 
                    808:     if { [string toupper $responses] == "NONE" } { set responses "" }
                    809:     set response [split $responses {}]
                    810:     foreach letter {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} {
                    811: 	if { [catch {set question($which.correct.$letter)}]} { 
                    812: #	    puts "skipping out on $letter"
                    813: 	    break 
                    814: 	}
                    815: 	incr i
                    816: 	if { [lsearch $response $letter] == -1 } {
                    817: 	    # unpicked
                    818: 	    if { [catch {incr gResponse($num.$which.unpicked.$question($which.$letter))}] } {
                    819: 		if {[catch {set gResponse($num.$which.unpicked.$question($which.$letter)) 1}]} {
                    820: 		    #set gResponse($num.$which.Illegal\ Bubble) 1
                    821: #		    puts "not an option $letter $which"
                    822: 		    continue
                    823: 		}	    
                    824: 	    }
                    825: 	} else {
                    826: 	    # picked
                    827: 	    if { [catch {incr gResponse($num.$which.$question($which.$letter))}] } {
                    828: 		if {[catch {set gResponse($num.$which.$question($which.$letter)) 1}]} {
                    829: 		    #set gResponse($num.$which.Illegal\ Bubble) 1
                    830: #		    puts "not an option $letter $which"
                    831: 		    continue
                    832: 		}	    
                    833: 	    }
                    834: 	}
                    835: 	if { $question($which.correct.$letter) } {
                    836: 	    set gResponse($num.correct.$which.$question($which.$letter)) 1
                    837: 	} else {
                    838: 	    set gResponse($num.correct.$which.$question($which.$letter)) 0
                    839: 	}
                    840:     }
                    841:     return $i
                    842: }
                    843: 
1.1       albertel  844: ###########################################################
                    845: # CTgraphAnalyzeScorer
                    846: ###########################################################
                    847: ###########################################################
                    848: ###########################################################
                    849: proc CTgraphAnalyzeScorer { num } {
                    850:     global gFile gUniqueNumber gCapaConfig gCT gResponse
                    851:     set cmdnum [incr gUniqueNumber]
                    852:     set gCT(cmd.$cmdnum) graphanalyzescorer
                    853:     if { "" == [set file [tk_getOpenFile -title "Pick a Output file" -filetypes { { {All Files} {*} } } -initialdir $gFile($num)]] } { return }
                    854:     set fileId [open $file r]
                    855:     set temp [read $fileId [file size $file]]
                    856:     close $fileId
                    857:     foreach {name value} $temp {
                    858: 	set name [join "$cmdnum [lrange [split $name .] 1 end]" .]
                    859: 	set gResponse($name) $value
                    860:     }
                    861:     unset temp
                    862:     foreach name [array names gResponse $cmdnum.\[0-9\]*] {
                    863: 	lappend probnums [lindex [split $name .] 1]
                    864:     } 
                    865:     set probnums [lsort [lunique $probnums]]
                    866:     event generate . <1> -x 1 -y 1
                    867:     event generate . <ButtonRelease-1>
                    868:     if { "" == [set probnums [multipleChoice $gCT($num) "Select which problems" $probnums 0]] } { return }
                    869:     foreach name [array names gResponse $cmdnum.\[0-9\]*] {
                    870: 	set probnum [lindex [split $name .] 1]
                    871: 	if { -1 == [lsearch $probnums $probnum] } {
                    872: 	    set answer [join [lrange [split $name .] 2 end] .]
1.14      albertel  873: 	    catch {unset gResponse($name)}
                    874: 	    catch {unset gResponse($cmdnum.correct.$probnum.$answer)}
1.1       albertel  875: 	}
                    876:     }
                    877:     set gCT($cmdnum.num) $num
                    878:     set gCT($cmdnum.graphup) 0
                    879:     CTupdateAnalyzeScorer $cmdnum
                    880:     unset gCT(cmd.$cmdnum)
                    881: }
                    882: 
                    883: ###########################################################
1.2       albertel  884: # CTdiscussStats
                    885: ###########################################################
                    886: ###########################################################
                    887: ###########################################################
                    888: proc CTdiscussStats { num } {
                    889:     global gCT gUniqueNumber gFile
                    890:     set cmdnum [incr gUniqueNumber]
                    891:     set gCT(cmd.$cmdnum) discussstats
                    892:     set file [file join $gFile($num) discussion logs access.log]
                    893:     displayStatus "Generating discussion Stats" both $cmdnum    
1.3       albertel  894:     CTdiscussForum $cmdnum $file $gFile($num) discussData 0
                    895:     CTputsDiscussResults $cmdnum discussData
1.2       albertel  896:     CToutput $num $cmdnum
                    897:     removeStatus $cmdnum
                    898:     unset gCT(cmd.$cmdnum)
                    899: }
                    900: 
                    901: ###########################################################
1.1       albertel  902: # CTquit
                    903: ###########################################################
                    904: ###########################################################
                    905: ###########################################################
                    906: proc CTquit { num } {
                    907:     global gCT
                    908:     destroy $gCT($num)
                    909: }
                    910: 
                    911: #menu command helpers
                    912: ###########################################################
                    913: # CTscanSetDB
                    914: ###########################################################
                    915: ###########################################################
                    916: ###########################################################
                    917: proc CTscanSetDB { num file Q_cntVar L_cntVar } {
                    918:     global gMaxSet gTotal_try gYes_cnt gyes_cnt gStudent_cnt gStudent_try \
                    919: 	gTotal_weight gTotal_scores gEntry gScore gNewStudent_cnt
                    920:     upvar $Q_cntVar Q_cnt 
                    921:     upvar $L_cntVar L_cnt
                    922: 
                    923:     set line_cnt 0
                    924:     set valid_cnt 0
                    925:     
                    926:     for { set ii 0 } { $ii <= $gMaxSet } { incr ii } {
                    927: 	set gTotal_try($num.$ii) 0
                    928: 	set gYes_cnt($num.$ii) 0
                    929: 	set gyes_cnt($num.$ii) 0
                    930: 	for { set jj 0 } { $jj <= $gMaxSet } { incr jj } {
                    931: 	    set gStudent_cnt($num.$ii.$jj) 0
                    932: 	    set gStudent_try($num.$ii.$jj) 0
                    933: 	}
                    934: 	set gNewStudent_cnt($num.$ii) 0
                    935:     }
                    936:     set gTotal_weight($num) 0
                    937:     set gTotal_scores($num) 0
                    938: 
                    939:     set maxLine [lindex [exec wc $file] 0]
                    940:     set tries ""
                    941:     set fileId [open $file "r"]
                    942:     set aline [gets $fileId]
                    943:     while { ! [eof $fileId] } {
                    944: 	incr line_cnt
                    945: 	if { ($line_cnt%20) == 0 } {
                    946: 	    updateStatusBar [expr $line_cnt/double($maxLine)] $num
                    947: 	}
                    948: 	if { $line_cnt == 2 } {
                    949: 	    set aline [string trim $aline]
                    950: 	    set weight [split $aline {}]
                    951: 	}
                    952: 	if { $line_cnt > 3 } {
                    953: 	    catch {
                    954: 		set aline [string trim $aline]
                    955: 		set prefix [lindex [split $aline ,] 0]
                    956: 		set s_num [lindex [split $aline " "] 0]
                    957: 		set ans_str [lindex [split $prefix " "] 1]
                    958: 		set ans_char [split $ans_str {} ]
                    959: 		set tries [lrange [split $aline ,] 1 end]
                    960: 		for { set valid 0; set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
                    961: 		    if {([lindex $ans_char $ii] != "-")&&([lindex $ans_char $ii] != "E") 
                    962: 			 && ([lindex $ans_char $ii] != "e") } { set valid 1 }
                    963: 		}
                    964: 		if { $valid } {
                    965: 		    for {set score 0; set ii 0} { $ii < [llength $tries] } { incr ii } {
                    966: 			set triesii 0
                    967: 			incr gTotal_weight($num) [lindex $weight $ii]
                    968: 			if { [lindex $ans_char $ii] == "Y" } {
                    969: 			    set triesii [string trim [lindex $tries $ii]]
                    970: 			    incr gYes_cnt($num.$ii)
                    971: 			    incr score [lindex $weight $ii]
                    972: 			    incr gNewStudent_cnt($num.$ii)
                    973: 			} elseif { [lindex $ans_char $ii] == "y" } {
                    974: 			    set triesii [string trim [lindex $tries $ii]]
                    975: 			    incr triesii
                    976: 			    incr gyes_cnt($num.$ii)
                    977: 			    incr score [lindex $weight $ii]
                    978: 			    incr gNewStudent_cnt($num.$ii)
                    979: 			} elseif { ( [lindex $ans_char $ii] > 0 ) && \
                    980: 			     ( [lindex $ans_char $ii] <= 9) } {
                    981: 			    set triesii [string trim [lindex $tries $ii]]
                    982: 			    incr score [lindex $ans_char $ii]
                    983: 			    incr gYes_cnt($num.$ii)
                    984: 			    incr gNewStudent_cnt($num.$ii)
                    985: 			} elseif { ( [lindex $ans_char $ii] == 0 ) } {
                    986: 			    set triesii [string trim [lindex $tries $ii]]
                    987: 			    incr gNewStudent_cnt($num.$ii)
                    988: 			} elseif {([lindex $ans_char $ii]=="n") || \
                    989: 				      ([lindex $ans_char $ii]=="N")} {
                    990: 			    set triesii [string trim [lindex $tries $ii]]
                    991: 			    if { [lindex $ans_char $ii] == "n"  } { incr triesii }
                    992: 			    incr gNewStudent_cnt($num.$ii)
                    993: 			}
                    994: 			set gStudent_try($num.$valid_cnt.$ii) $triesii
                    995: 			incr gTotal_try($num.$ii) $triesii
                    996: 			incr gStudent_cnt($num.$ii.$triesii)
                    997: 		    }
                    998: 		    incr gTotal_scores($num) $score
                    999: 		    set gEntry($num.$valid_cnt) "$aline"
                   1000: 		    set gScore($num.$valid_cnt) $score
                   1001: 		    incr valid_cnt
                   1002: 		}
                   1003: 	    } 
                   1004: 	}
                   1005: 	set aline [gets $fileId]
                   1006:     }
                   1007:     close $fileId
                   1008:     set Q_cnt [llength $tries]
                   1009:     set L_cnt $valid_cnt
                   1010:     return
                   1011: }
                   1012: 
                   1013: ###########################################################
                   1014: # CTpercentageScores
                   1015: ###########################################################
                   1016: ###########################################################
                   1017: ###########################################################
1.14      albertel 1018: proc CTpercentageScores { num setId valid_cnt {subset 0}} {
1.1       albertel 1019:     global gTotal_weight gTotal_scores 
1.14      albertel 1020: 
                   1021:     if { $subset } { set setstr "subset" } else { set setstr "set" }
1.1       albertel 1022:     if { $gTotal_weight($num) > 0 } {
                   1023: 	set ratio [expr double($gTotal_scores($num)) / double($gTotal_weight($num))]
                   1024: 	set ratio [expr $ratio * 100.0 ]
1.14      albertel 1025: 	CTputs $num "\nScore (total scores / total valid weights) for $setstr$setId.db: [format %7.2f%% $ratio]\n" 
1.1       albertel 1026:     }
1.14      albertel 1027:     CTputs $num "The number of valid records for $setstr$setId.db is: $valid_cnt\n"
1.1       albertel 1028: }
                   1029: 
                   1030: ###########################################################
                   1031: # CTaverage
                   1032: ###########################################################
                   1033: ###########################################################
                   1034: ###########################################################
                   1035: proc CTaverage { num q_cnt l_cnt faillistVar dodifflistVar numyesVar} {
                   1036:     upvar $faillistVar faillist $dodifflistVar dodifflist $numyesVar numyes
                   1037:     global gMaxTries gStudent_cnt gStudent_try gTotal_try gYes_cnt gyes_cnt \
                   1038: 	gNewStudent_cnt
                   1039: 
                   1040:     set maxIter [expr $q_cnt * 4]
                   1041:     
                   1042:     for { set ii 0 } { $ii < $q_cnt } { incr ii } {
                   1043: 	updateStatusBar [expr $ii/double($maxIter)] $num 
                   1044: 	set s_cnt($ii) 0
                   1045: 	set avg($ii) 0.0
                   1046: 	set max_try($ii) 0
                   1047: 	for { set jj 1 } { $jj < $gMaxTries } { incr jj } {
                   1048: 	    if { $gStudent_cnt($num.$ii.$jj) > 0 } {
                   1049: 		set avg($ii) [expr $avg($ii) + ($jj * $gStudent_cnt($num.$ii.$jj))]
                   1050: 		incr s_cnt($ii) $gStudent_cnt($num.$ii.$jj)
                   1051: 	    }
                   1052: 	}
                   1053: 	set s_cnt($ii) $gNewStudent_cnt($num.$ii)
                   1054: 	if { $s_cnt($ii) > 0 } { set avg($ii) [expr $avg($ii) / $s_cnt($ii)] }
                   1055:     }
                   1056:     
                   1057:     for { set ii 0 } { $ii < $q_cnt } { incr ii } {
                   1058: 	updateStatusBar [expr ($ii+$q_cnt)/double($maxIter)] $num
                   1059: 	set sd($ii) 0.0
                   1060: 	set sum 0.0
                   1061: 	for { set jj 0 } { $jj < $l_cnt } { incr jj } {
                   1062: 	    if { $gStudent_try($num.$jj.$ii) > $max_try($ii) } {
                   1063: 		set max_try($ii) $gStudent_try($num.$jj.$ii) 
                   1064: 	    }
                   1065: 	    if { $gStudent_try($num.$jj.$ii) > 0 } {
                   1066: 		set sq [expr ( $gStudent_try($num.$jj.$ii) - $avg($ii) ) * \
                   1067: 			    ( $gStudent_try($num.$jj.$ii) - $avg($ii)) ]
                   1068: 		set sum [expr $sum + $sq]
                   1069: 	    }
                   1070: 	    if { $s_cnt($ii) > 1  } {
                   1071: 		set sd($ii) [expr  $sum / ( $s_cnt($ii) - 1.0 )]
                   1072: 	    }
                   1073: 	    if { $sd($ii) > 0 } { set sd($ii) [ expr sqrt($sd($ii)) ] }
                   1074: 	}
                   1075:     }
                   1076: 
                   1077:     for { set ii 0 } { $ii < $q_cnt } { incr ii } {
                   1078: 	updateStatusBar [expr ($ii+(2*$q_cnt))/double($maxIter)] $num
                   1079: 	set sd3($ii) 0.0
                   1080: 	set sum 0.0
                   1081: 	for { set jj 0 } { $jj < $l_cnt } { incr jj } {
                   1082: 	    if { $gStudent_try($num.$jj.$ii) > 0 } {
                   1083: 		set tmp1 [expr $gStudent_try($num.$jj.$ii) - $avg($ii)]
                   1084: 		set tmp2 [expr $tmp1 * $tmp1 * $tmp1]
                   1085: 		set sum [expr $sum + $tmp2]
                   1086: 	    }
                   1087: 	    if { ( $s_cnt($ii) > 0 ) && ( $sd($ii) != 0.0 ) } {
                   1088: 		set sd3($ii) [expr $sum / $s_cnt($ii) ]
                   1089: 		set sd3($ii) [expr $sd3($ii) / ($sd($ii) * $sd($ii) * $sd($ii)) ]
                   1090: 	    }
                   1091: 	}
                   1092:     }
                   1093:     CTputs $num "This is the statistics for each problem: \n"
                   1094:     CTputs $num "Prob\#  MxTries  avg.    s.d.   s.k.  \#Stdnts"
                   1095:     CTputs $num " \#Yes  \#yes Tries   DoDiff %Wrong\n"
                   1096:     set numyes [set dodifflist [set faillist ""]]
                   1097: #    parray s_cnt
                   1098:     for { set ii 0 } { $ii < $q_cnt } { incr ii } {
                   1099: 	updateStatusBar [expr ($ii+(3*$q_cnt))/double($maxIter)] $num
                   1100: 	if { $gTotal_try($num.$ii) > 0 } {
                   1101: 	    set dod [expr $gTotal_try($num.$ii)/(0.1 + $gYes_cnt($num.$ii) \
                   1102: 						     + $gyes_cnt($num.$ii))]
                   1103: 	} else {
                   1104: 	    set dod 0.0
                   1105: 	}
                   1106: 	if {[catch {set success [expr 100.0*($s_cnt($ii)-($gYes_cnt($num.$ii)+ \
                   1107: 				$gyes_cnt($num.$ii)))/$s_cnt($ii)]}]} {
                   1108: 	    set success 0.0
                   1109: 	    set s_cnt($ii) 0
                   1110: 	}
                   1111: 	CTputs $num [format "P %2d" [expr int($ii + 1)] ]
                   1112: 	CTputs $num [format "%6d  %8.2f %7.2f %6.2f  %5d  %5d %5d %5d  %5.1f  %6.2f\n"\
                   1113: 			  $max_try($ii) $avg($ii) $sd($ii) $sd3($ii) $s_cnt($ii) \
                   1114: 			 $gYes_cnt($num.$ii) $gyes_cnt($num.$ii)  \
                   1115: 			 $gTotal_try($num.$ii) $dod $success]
                   1116: 	if { $success < 0 } { set success 0 }
                   1117: 	lappend faillist [list $success [expr int($ii + 1)]]
                   1118: 	lappend dodifflist [list $dod [expr int($ii + 1)]]
                   1119: 	lappend numyes [list [expr $gYes_cnt($num.$ii)+$gyes_cnt($num.$ii)] \
                   1120: 				[expr int($ii + 1)]]
                   1121:     }
                   1122: }
                   1123: 
                   1124: ###########################################################
                   1125: # CTlogAnalysis2
                   1126: ###########################################################
                   1127: ###########################################################
                   1128: ###########################################################
                   1129: proc CTlogAnalysis2 { num cmdnum setId } {
                   1130:     global gFile
                   1131:     set logFile [file join $gFile($num) records "log$setId.db"]
                   1132:     if { [file exists $logFile] } {
                   1133: 	CTputs $cmdnum "Log analysis for telnet session log$setId.db\n" 
1.3       albertel 1134: 	CTscanLogDB $cmdnum $logFile l(Y) l(N) l(S) l(U) l(u) l(A) l(F)
1.1       albertel 1135:     } else {
1.3       albertel 1136: 	set l(Y) [set l(N) [set l(S) [set l(U) [set l(u) [set l(A) [set l(F) 0]]]]]]
1.1       albertel 1137:     }
                   1138:     set webLogFile [file join $gFile($num) records "weblog$setId.db" ]
                   1139:     if { [file exists $webLogFile] } {
                   1140: 	CTputs $cmdnum "===============================================\n"
                   1141: 	CTputs $cmdnum "Log analysis for web session weblog$setId.db\n"
1.3       albertel 1142: 	CTscanLogDB $cmdnum $webLogFile w(Y) w(N) w(S) w(U) w(u) w(A) w(F)
1.1       albertel 1143:     } else {
1.3       albertel 1144: 	set w(Y) [set w(N) [set w(S) [set w(U) [set w(u) [set w(A) [set w(F) 0]]]]]]
1.1       albertel 1145:     }
1.3       albertel 1146:     set telnet_total [expr $l(Y)+$l(N)+$l(S)+$l(U)+$l(u)+$l(A)+$l(F)]
                   1147:     set web_total [expr $w(Y)+$w(N)+$w(S)+$w(U)+$w(u)+$w(A)+$w(F)]
1.1       albertel 1148:     CTputs $cmdnum "============== SUMMARY ====================\n"
1.3       albertel 1149:     CTputs $cmdnum "            #Y     #N     #S     #U     #u    #A     #F     Total\n"
                   1150:     CTputs $cmdnum [format "telnet: %6d %6d %6d %6d %6d %6d %6d   %6d\n" \
                   1151: 			       $l(Y) $l(N) $l(S) $l(U) $l(u) $l(A) $l(F) $telnet_total ]
                   1152:     CTputs $cmdnum [format "   web: %6d %6d %6d %6d %6d %6d %6d   %6d\n" \
                   1153: 			       $w(Y) $w(N) $w(S) $w(U) $w(u) $w(A) $w(F) $web_total]
                   1154:     foreach v { Y N S U u A F} {
1.1       albertel 1155: 	set sum($v) [expr $l($v) + $w($v)]
                   1156: 	if { $sum($v) > 0 } { 
                   1157: 	    set ratio($v) [expr 100.0*$w($v)/double($sum($v))] 
                   1158: 	} else {
                   1159: 	    set ratio($v) 0.0
                   1160: 	}
                   1161:     }
                   1162:     set overall_entries [expr $telnet_total + $web_total]
                   1163:     if { $overall_entries > 0 } { 
                   1164: 	set ratio(web) [expr 100.0*(double($web_total)/double($overall_entries))]
                   1165:     } else {
                   1166: 	set ratio(web) 0.0
                   1167:     }
1.3       albertel 1168:     CTputs $cmdnum [format "  %%web: % 6.1f % 6.1f % 6.1f % 6.1f % 6.1f % 6.1f % 6.1f   % 6.1f\n" \
                   1169: 			$ratio(Y) $ratio(N) $ratio(S) $ratio(U) $ratio(u) $ratio(A) $ratio(F) $ratio(web) ]
1.1       albertel 1170: }
                   1171: 
                   1172: 
                   1173: ###########################################################
                   1174: # CTscanLogDB
                   1175: ###########################################################
                   1176: ###########################################################
                   1177: ###########################################################
1.3       albertel 1178: proc CTscanLogDB { num file Y_lVar N_lVar S_lVar U_lVar u_lVar A_lVar F_lVar } {
1.1       albertel 1179:     upvar $Y_lVar Y_l
                   1180:     upvar $N_lVar N_l
                   1181:     upvar $S_lVar S_l
                   1182:     upvar $U_lVar U_l
                   1183:     upvar $u_lVar u_l
1.3       albertel 1184:     upvar $A_lVar A_l
                   1185:     upvar $F_lVar F_l
1.1       albertel 1186:     
                   1187:     set line_cnt 0
                   1188:     
                   1189:     displayStatus "Analyzing [file tail $file]" both $num
                   1190:     set maxLine [lindex [exec wc $file] 0]
                   1191:     set fileId [open $file "r"]
                   1192:     
                   1193:     set aline [gets $fileId]
                   1194:     while { ! [eof $fileId] } {
                   1195: 	incr line_cnt
                   1196: 	if { ($line_cnt%20) == 0 } {
                   1197: 	    updateStatusBar [expr $line_cnt/double($maxLine)] $num
                   1198: 	}
                   1199: 	set aline [string trim $aline]
                   1200: 	set ans_str [string range $aline 35 end]
                   1201: 	set ans_char [split $ans_str {}]
                   1202: 	if { ! [info exists count] } {
                   1203: 	    for { set i 0 } { $i < [llength $ans_char] } { incr i } {
                   1204: 		set count(Y.$i) 0; set count(N.$i) 0; set count(S.$i) 0
1.3       albertel 1205: 		set count(U.$i) 0; set count(u.$i) 0; set count(A.$i) 0
                   1206: 		set count(F.$i) 0
1.1       albertel 1207: 	    }
                   1208: 	    set count(Y.total) 0; set count(N.total) 0; set count(S.total) 0
1.3       albertel 1209: 	    set count(U.total) 0; set count(u.total) 0; set count(A.total) 0
                   1210: 	    set count(F.total) 0
1.1       albertel 1211: 	}
                   1212: 	set i -1
                   1213: 	foreach char $ans_char {
                   1214: 	    incr i
                   1215: 	    if { $char == "-" } { continue }
                   1216: 	    if { [catch {incr count($char.$i)}] } {
                   1217: 		set count(Y.$i) 0; set count(N.$i) 0; set count(S.$i) 0
1.3       albertel 1218: 		set count(U.$i) 0; set count(u.$i) 0; set count(A.$i) 0
                   1219: 		set count(F.$i) 0
1.1       albertel 1220: 		incr count($char.$i)
                   1221: 	    }
                   1222: 	    incr count($char.total)
                   1223: 	}
                   1224: 	set aline [gets $fileId]
                   1225:     }
                   1226:     close $fileId
                   1227:     removeStatus $num
1.3       albertel 1228:     CTputs $num "Prob #:     #Y     #N     #S     #U     #u     #A     #F\n"
1.1       albertel 1229:     for { set i 0 } { $i < [llength $ans_char] } { incr i } {
1.3       albertel 1230: 	CTputs $num [format "    %2d: %6d %6d %6d %6d %6d %6d %6d\n"  [expr $i + 1] \
                   1231:                      $count(Y.$i) $count(N.$i) $count(S.$i) $count(U.$i) $count(u.$i) \
                   1232: 			 $count(A.$i) $count(F.$i) ]
1.1       albertel 1233:     }
                   1234:     CTputs $num "===========================================\n"
1.3       albertel 1235:     CTputs $num [format " Total: %6d %6d %6d %6d %6d %6d %6d\n" $count(Y.total) \
                   1236: 		     $count(N.total) $count(S.total) $count(U.total) $count(u.total) \
                   1237: 		     $count(A.total) $count(F.total) ]
1.1       albertel 1238:     set Y_l $count(Y.total)
                   1239:     set N_l $count(N.total)
                   1240:     set S_l $count(S.total)
                   1241:     set U_l $count(U.total)
                   1242:     set u_l $count(u.total)
1.3       albertel 1243:     set A_l $count(A.total)
                   1244:     set F_l $count(F.total)
1.1       albertel 1245:     return
                   1246: }
                   1247: 
                   1248: ###########################################################
                   1249: # CTcollectSetScores
                   1250: ###########################################################
                   1251: ###########################################################
                   1252: ###########################################################
                   1253: proc CTcollectSetScores { num path id on_screen limit } {
                   1254:     set id [ string toupper $id ]
                   1255:     set total_scores 0
                   1256:     set total_weights 0
                   1257:     set set_idx 0
                   1258:     set done 0
                   1259:     while { ! $done } {
                   1260: 	incr set_idx
                   1261: 	if { $set_idx > $limit } { set done 1; continue }
                   1262: 	updateStatusBar [expr $set_idx/double($limit)] $num
                   1263: 	set filename [file join $path records "set$set_idx.db"]
                   1264: 	if { ![file readable $filename ] } { continue }
                   1265: 	set fileId [open $filename "r"]
                   1266: 	set line_cnt 0
                   1267: 	set found 0
                   1268: 	set aline [ gets $fileId ]
                   1269: 	while { ! [eof $fileId] && ! $found } {
                   1270: 	    incr line_cnt
                   1271: 	    if { $line_cnt > 3 } {
                   1272: 		set aline [string trim $aline]
                   1273: 		set prefix [lindex [split $aline ","] 0]
                   1274: 		set s_num [string toupper [lindex [split $aline " "] 0] ]
                   1275: 		set ans_str [lindex [split $prefix " "] 1]
                   1276: 		if { $id == $s_num } {
                   1277: 		    set ans_char [split $ans_str {} ]
                   1278: 		    set valid 0
                   1279: 		    foreach char $ans_char { if { $char != "-" } { set valid 1; break } }
                   1280: 		    if { ! $valid } {
                   1281: 			set score "-"
                   1282: 		    } else {
                   1283: 			set score 0
                   1284: 			for {set i 0} { $i < [llength $ans_char] } { incr i } {
                   1285: 			    set char [lindex $ans_char $i]
                   1286: 			    if { $char == "N" || $char == "n"} { set found 1 }
                   1287: 			    if { $char == "Y" || $char == "y"} { 
1.11      albertel 1288: 				catch {incr score [lindex $weights $i]}
                   1289: 				set found 1
1.1       albertel 1290: 			    }
                   1291: 			    if { $char >= 0 && $char <= 9 } { 
                   1292: 				incr score $char;set found 1
                   1293: 			    }
                   1294: 			    if { $char == "E" } {
1.11      albertel 1295: 				catch {incr valid_weights "-[lindex $weights $i]"}
1.1       albertel 1296: 			    }
                   1297: 			}
                   1298: 			incr total_scores $score
                   1299: 		    }
                   1300: 		}
                   1301: 	    } elseif { $line_cnt == 2 } {
                   1302: 		set aline [string trim $aline]
                   1303: 		set weights [split $aline {} ]
                   1304: 		set valid_weights 0
                   1305: 		foreach weight $weights { incr valid_weights $weight }
                   1306: 	    } else {
                   1307: 		#do nothing for line 1 and 3
                   1308: 	    }
                   1309: 	    set aline [ gets $fileId ]
                   1310: 	}
                   1311: 	close $fileId
                   1312: 	incr total_weights $valid_weights
                   1313: 	set set_weights([expr $set_idx - 1]) $valid_weights
                   1314: 	if { $found } {
                   1315: 	    set set_scores([expr $set_idx - 1]) $score
                   1316: 	} else {
                   1317: 	    set set_scores([expr $set_idx - 1]) "-"
                   1318: 	}
                   1319:     }
                   1320:     set abscent_cnt 0
                   1321:     set present_cnt 0
                   1322:     set summary_str ""
                   1323:     if { $on_screen } { CTputs $num "          " }
                   1324:     foreach i [lsort -integer [array names set_scores]] {
                   1325: 	if { $set_scores($i) == "-" || $set_scores($i) == "" } {
                   1326: 	    if { $on_screen } { CTputs $num "  - " } 
                   1327: 	    append summary_str "x/$set_weights($i) "
                   1328: 	    incr abscent_cnt
                   1329: 	} else {
                   1330: 	    if { $on_screen } { CTputs $num [format " %3d" $set_scores($i)] } 
                   1331: 	    append summary_str "$set_scores($i)/$set_weights($i) "
                   1332: 	    incr present_cnt
                   1333: 	}
                   1334:     }
                   1335:     if { $on_screen } {
                   1336: 	CTputs $num "\n [file tail $path]:"
                   1337: 	foreach i [lsort -integer [array names set_scores]] { CTputs $num " ---" }
                   1338: 	CTputs $num "\n          "
                   1339: 	if { [info exists set_weights] } {
                   1340: 	    set num_set_weights [llength [array names set_weights]]
                   1341: 	} else {
                   1342: 	    set num_set_weights 0
                   1343: 	}
                   1344: 	for {set i 0} {$i < $num_set_weights} {incr i} {
                   1345: 	    if { [info exists set_weights($i)] } {
                   1346: 		CTputs $num [format " %3d" $set_weights($i)]
                   1347: 	    } else {
                   1348: 		set num_set_weights $i
                   1349: 	    }
                   1350: 	}
                   1351: 	CTputs $num "\n"
                   1352: 	if { $total_weights != 0 } { 
                   1353: 	    set ratio [expr 100.0 * $total_scores / double($total_weights) ]
                   1354: 	    CTputs $num [format "  %5d\n" $total_scores]
                   1355: 	    if { [info exists set_scores] } {
                   1356: 		CTputs $num [format " ------- = %3.2f%%, scores absent in %d/%d\n" \
                   1357: 				 $ratio $abscent_cnt [llength [array names set_scores]]]
                   1358: 	    } else {
                   1359: 		CTputs $num [format " ------- = %3.2f%%, scores absent in %d/%d\n" \
                   1360: 				 $ratio $abscent_cnt 0 ]
                   1361: 	    }
                   1362: 	} else {
                   1363: 	    set ratio "-"
                   1364: 	    CTputs $num [format "  %5d\n" $total_scores]
                   1365: 	    if { [info exists set_scores] } {
                   1366: 		CTputs $num [format " ------- =     %s%%, scores absent in %d/%d\n" \
                   1367: 				 $ratio $abscent_cnt [llength [array names set_scores]]]
                   1368: 	    } else {
                   1369: 		CTputs $num [format " ------- =     %s%%, scores absent in %d/%d\n" \
                   1370: 				 $ratio $abscent_cnt 0 ]
                   1371: 	    }
                   1372: 	}
                   1373: 
                   1374: 	CTputs $num [format "  %5d\n" $total_weights]
                   1375:     }
                   1376:     return [list $total_scores $total_weights $abscent_cnt \
                   1377: 	    [llength [array names set_scores] ] $summary_str]
                   1378: }
                   1379: 
                   1380: ###########################################################
                   1381: # CTloginAnalysis
                   1382: ###########################################################
                   1383: ###########################################################
                   1384: ###########################################################
                   1385: proc CTloginAnalysis { num path id limit } {
                   1386: 
                   1387:     CTputs $num "Login analysis:  telnet session             web session\n\n"
                   1388:     CTputs $num "   set #:   #Y   #N   #S   #U   #u     #Y   #N   #S   #U   #u\n"
                   1389:     set set_idx 0
                   1390:     set done 0
                   1391:     while { ! $done } {
                   1392: 	incr set_idx
                   1393: 	if { $set_idx > $limit } { set done 1; continue }
                   1394: 	CTputs $num [format "      %2d: " $set_idx]
                   1395: 	set filename [file join $path records "log$set_idx.db"]
                   1396: 	updateStatusMessage "Analyzing [file tail $filename]" $num
                   1397: 	updateStatusBar 0.0 $num
                   1398: 	if { [file readable $filename] } {
                   1399: 	    set result [CTstudentLoginData $num $filename $id]
                   1400: 	    CTputs $num [eval format \"%4d %4d %4d %4d %4d\" $result]
                   1401: 	    set no_log 0
                   1402: 	} else {
                   1403: 	    CTputs $num "========================"
                   1404: 	    set no_log 1
                   1405: 	}
                   1406: 	CTputs $num "    "
                   1407: 	set filename [file join $path records "weblog$set_idx.db"]
                   1408: 	updateStatusMessage "Analyzing [file tail $filename]" $num
                   1409: 	updateStatusBar 0.0 $num
                   1410: 	if { [file readable $filename] } {
                   1411: 	    set result [CTstudentLoginData $num $filename $id]
                   1412: 	    CTputs $num [eval format \"%4d %4d %4d %4d %4d\" $result]
                   1413: 	    set no_weblog 0
                   1414: 	} else {
                   1415: 	    CTputs $num "========================"
                   1416: 	    set no_weblog 1
                   1417: 	}
                   1418: 	CTputs $num "\n"
                   1419: 	if { $no_log && $no_weblog } { set done 1 }
                   1420:     }
                   1421: }
                   1422: 
                   1423: ###########################################################
                   1424: # CTstudentSetAnalysis
                   1425: ###########################################################
                   1426: ###########################################################
                   1427: ###########################################################
                   1428: proc CTstudentSetAnalysis { num path id limit } {
                   1429:     set set_idx 0
                   1430:     set id [string toupper $id]
                   1431:     CTputs $num " set \#:\n"
                   1432:     set done 0
                   1433:     while { ! $done } {
                   1434: 	incr set_idx
                   1435: 	if { $set_idx > $limit } { set done 1; continue }
                   1436: 	set filename [file join $path records "set$set_idx.db"]
                   1437: 	updateStatusMessage "Analyzing [file tail $filename]" $num
                   1438: 	if { ![file readable $filename] } { continue }
                   1439: 	CTputs $num [format "    %2d: " $set_idx]
                   1440: 	set fileId [open $filename "r"]
                   1441: 	set line_cnt 0
                   1442: 	set found 0
                   1443: 	set aline [gets $fileId]
                   1444: 	while { ! [eof $fileId] && !$found } {
                   1445: 	    incr line_cnt
                   1446: 	    if { $line_cnt > 3 } { 
                   1447: 		set aline [string trim $aline]
                   1448: 		set s_id [string toupper [string range $aline 0 8]]
                   1449: 		if {$id == $s_id} {
                   1450: 		    set found 1
                   1451: 		    set breakpt [string first "," $aline]
                   1452: 		    set data [list [string range $aline 10 [expr $breakpt - 1] ] \
                   1453: 				  [string range $aline [expr $breakpt + 1] end ] ]
                   1454: 		    CTputs $num "[lindex $data 0]\n          [lindex $data 1]\n"
                   1455: 		}
                   1456: 	    }
                   1457: 	    set aline [gets $fileId]
                   1458: 	}
                   1459: 	close $fileId
                   1460: 	if { ! $found } { CTputs $num "\n\n" }
                   1461:     }
                   1462: }
                   1463: 
                   1464: ###########################################################
                   1465: # CTstudentLoginData
                   1466: ###########################################################
                   1467: ###########################################################
                   1468: ###########################################################
                   1469: proc CTstudentLoginData { num filename id } {
                   1470: 
                   1471:     set Y_total 0
                   1472:     set N_total 0
                   1473:     set U_total 0 
                   1474:     set u_total 0 
                   1475:     set S_total 0
1.14      albertel 1476:     set s_total 0
1.1       albertel 1477:     set maxLine [expr double([lindex [exec wc $filename] 0])]
                   1478:     set line_cnt 0
                   1479:     set fileId [open $filename "r"]
                   1480:     set aline [gets $fileId]
                   1481:     while { ![eof $fileId] } {
                   1482: 	incr line_cnt
                   1483: 	if { $line_cnt%300 == 0 } {
                   1484: 	    updateStatusBar [expr $line_cnt/$maxLine] $num
                   1485: 	}
                   1486: 	set aline [string trim $aline]
                   1487: 	set s_id [string toupper [string range $aline 0 8]]
                   1488: 	set id [string toupper $id]
                   1489: 	if {$id == $s_id} {
                   1490: 	    set ans_char [split [string range $aline 35 end] {} ]
                   1491: 	    for {set i 0} {$i< [llength $ans_char]} {incr i} {
                   1492: 		if {[lindex $ans_char $i] == "Y"} { incr Y_total 
                   1493: 		} elseif {[lindex $ans_char $i] == "N"} { incr N_total 
                   1494: 		} elseif {[lindex $ans_char $i] == "U"} { incr U_total 
                   1495: 		} elseif {[lindex $ans_char $i] == "u"} { incr u_total 
1.14      albertel 1496: 		} elseif {[lindex $ans_char $i] == "s"} { incr s_total 
1.1       albertel 1497: 		} elseif {[lindex $ans_char $i] == "S"} { incr S_total }
                   1498: 	    }
                   1499: 	}
                   1500: 	set aline [gets $fileId]
                   1501:     }
                   1502:     close $fileId
                   1503:     return [list $Y_total $N_total $S_total $U_total $u_total]
                   1504: }
                   1505: 
                   1506: ###########################################################
                   1507: # CTrunCommand
                   1508: ###########################################################
                   1509: ###########################################################
                   1510: ###########################################################
                   1511: proc CTrunCommand { num cmdnum fileId {followup "" }} {
                   1512:     global gCT
                   1513: 
                   1514:     set data [read $fileId]
                   1515:     updateStatusSpinner $cmdnum
                   1516:     if { $data != "" } {
                   1517: 	CTputs $cmdnum $data
                   1518:     }
                   1519:     if { [eof $fileId] } {
                   1520: 	fileevent $fileId readable ""
                   1521: 	catch {close $fileId}
                   1522: 	if { $followup == "" } {
                   1523: 	    CToutput $num $cmdnum
                   1524: 	    removeStatus $cmdnum
                   1525: 	    unset gCT(cmd.$cmdnum)
                   1526: 	} else {
                   1527: 	    eval $followup
                   1528: 	}
                   1529:     }
                   1530: }
                   1531: 
                   1532: ###########################################################
                   1533: # CTitemAnalysisRange
                   1534: ###########################################################
                   1535: ###########################################################
                   1536: ###########################################################
1.9       albertel 1537: proc CTitemAnalysisRange { num classpath sets } {
                   1538:     foreach i $sets {
1.1       albertel 1539: 	if { [ catch { CTitemAnalysis $num $classpath $i } errors ] } { 
                   1540: 	    displayError $errors 
                   1541: 	}
                   1542:     }
                   1543: }
                   1544: 
                   1545: ###########################################################
                   1546: # CTitemAnalysis
                   1547: ###########################################################
                   1548: ###########################################################
                   1549: ###########################################################
                   1550: proc CTitemAnalysis { num classpath setId } {
                   1551:     global gMaxSet
                   1552:     set done 0
                   1553:     
                   1554:     set total_scores 0
                   1555:     set total_weights 0
                   1556:     set upper_percent 0.0
                   1557:     set lower_percent 0.0
                   1558:     
                   1559:     set Y_total 0
                   1560:     set N_total 0
                   1561:     for { set ii 0} { $ii<$gMaxSet } {incr ii} {
                   1562: 	set Y_cnt($ii) 0
                   1563: 	set N_cnt($ii) 0
                   1564: 	set Ycnt_upper($ii) 0.0
                   1565: 	set Ycnt_lower($ii) 0.0
                   1566:     }
                   1567: 
                   1568:     set filename [file join $classpath records "set$setId.db"]
                   1569:     if { ! [file readable $filename] } { 
                   1570: 	CTputs $num "FILE: $filename does not exist!\n"
                   1571: 	return
                   1572:     }
                   1573:     
                   1574:     displayStatus "Analyzing [file tail $filename]" both $num
                   1575:     set maxLine [lindex [exec wc $filename] 0]
                   1576:     
                   1577:     set fileId [open "$filename" "r"]
                   1578:     set valid_cnt 0
                   1579:     set line_cnt 0
                   1580:     set ans_char ""
                   1581:     set aline [gets $fileId]
                   1582:     while {![eof $fileId]} {
                   1583: 	incr line_cnt
                   1584: 	if { ($line_cnt%20) == 0 } {
                   1585: 	    updateStatusBar [expr $line_cnt/double($maxLine)] $num
                   1586: 	}
                   1587: 	if { $line_cnt == 2 } { 
                   1588: 	    set aline [string trim $aline]
                   1589: 	    set weights [split $aline {}]
                   1590: #	    set valid_weights 0
                   1591: #	    for { set ii 0 } { $ii < [llength $weights] } { incr ii } {
                   1592: #		incr valid_weights [lindex $weights $ii]
                   1593: #	    }
                   1594: 	} elseif { $line_cnt > 3} {
                   1595: 	    set aline [string trim $aline]
                   1596: 	    set prefix [lindex [split $aline ","] 0]
                   1597: 	    set s_num [string toupper [lindex [split $aline " " ] 0 ] ]
                   1598: 	    set ans_str [lindex [split $prefix " "] 1]
                   1599: 	    set ans_char [split $ans_str {} ]
                   1600: 	    set valid 0
                   1601: 	    for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
                   1602: 		if { [lindex $ans_char $ii] != "-"} { set valid 1 }
                   1603: 	    }
                   1604: 	    if { $valid } {
                   1605: 		incr valid_cnt
                   1606: 		set score 0
                   1607: 		for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
1.9       albertel 1608: 		    #Can't use incr because the numbers might be doubles
1.1       albertel 1609: 		    if { [lindex $ans_char $ii] == "Y" || \
                   1610: 			     [lindex $ans_char $ii] == "y" } {
1.9       albertel 1611: 			catch {incr score [lindex $weights $ii]}
                   1612: 			set Y_cnt($ii) [expr {$Y_cnt($ii) + 1}]
                   1613: 			set Y_total [expr {$Y_total + 1}]
1.1       albertel 1614: 		    }
                   1615: 		    if { [lindex $ans_char $ii] == "N" || \
                   1616: 			     [lindex $ans_char $ii] == "n" } {
1.9       albertel 1617: 			set N_cnt($ii) [expr {$N_cnt($ii) + 1}]
                   1618: 			set N_total  [expr {$N_total + 1}]
1.1       albertel 1619: 		    }
                   1620: 		    if { [lindex $ans_char $ii] >= 0 && \
                   1621: 			     [lindex $ans_char $ii] <= 9 } {
                   1622: 			incr score [lindex $ans_char $ii]
1.9       albertel 1623: 			if {[catch {set yes_part [expr [lindex $ans_char $ii] / \
                   1624: 						      double([lindex $weights $ii])]}]} {
                   1625: 			    set yes_part 1
                   1626: 			}
1.1       albertel 1627: 			set no_part [expr 1.0 - $yes_part]
                   1628: 			set Y_cnt($ii) [expr $Y_cnt($ii) + $yes_part]
                   1629: 			set Y_total    [expr $Y_total + $yes_part]
                   1630: 			set N_cnt($ii) [expr $N_cnt($ii) + $no_part]
                   1631: 			set N_total    [expr $N_total + $no_part]
                   1632: 		    }
                   1633: #		    if { [lindex $ans_char $ii] == "E"} { 
                   1634: #			incr valid_weights -[lindex $weights $ii]
                   1635: #		    }
                   1636: 		}
                   1637: 		set s_db([format "%08d%s" $score $s_num]) $ans_str
                   1638: 	    }
                   1639: 	}
                   1640: 	set aline [gets $fileId]
                   1641:     } 
                   1642:     close $fileId
                   1643:     removeStatus $num
                   1644:     for { set ii 0 } { $ii < $gMaxSet } { incr ii } {
                   1645: 	set Ycnt_upper($ii) 0
                   1646: 	set Ycnt_lower($ii) 0
                   1647:     }
                   1648:     displayStatus "Pondering data . . ." spinner $num
                   1649:     set upperpart_cnt [expr int(0.27 * double($valid_cnt))]
                   1650:     set lowerpart_limit [expr $valid_cnt - $upperpart_cnt]
                   1651:     set line_cnt 0
                   1652:     foreach sort_key [lsort -decreasing [array names s_db]] {
                   1653: 	incr line_cnt
                   1654: 	if { ($line_cnt%20) == 0 } { updateStatusSpinner $num }
                   1655: 	set ans_str $s_db($sort_key)
                   1656: 	set ans_char [split $ans_str {} ]
                   1657: 	for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
                   1658: 	    if { [lindex $ans_char $ii] == "Y" || \
                   1659: 		     [lindex $ans_char $ii] == "y" || \
                   1660: 		     [lindex $ans_char $ii] == [lindex $weights $ii] } {
                   1661: 		if { $line_cnt <= $upperpart_cnt } {
                   1662: 		    incr Ycnt_upper($ii)
                   1663: 		} elseif { $line_cnt > $lowerpart_limit } {
                   1664: 		    incr Ycnt_lower($ii)
                   1665: 		}
                   1666: 	    }
                   1667: 	}
                   1668:     }
                   1669:     CTputs $num " There are $valid_cnt entries in file $filename\n"
                   1670:     CTputs $num [format "  The upper 27%% has %d records, the lower 27%% has %d records\n"\
                   1671: 		     $upperpart_cnt [expr $valid_cnt - $lowerpart_limit] ]
                   1672:     CTputs $num " question \#     DoDiff.      Disc. Factor (%upper - %lower) \[\#records,\#records\]\n";
                   1673:     
                   1674:     for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
                   1675: 	updateStatusSpinner $num 
                   1676: 	set tmp_total [expr $N_cnt($ii) + $Y_cnt($ii)]
                   1677: 	if { $tmp_total > 0 } {
                   1678: 	    set diff [expr 100.0*($N_cnt($ii) / double($N_cnt($ii) + $Y_cnt($ii)))]
                   1679: 	} else {
                   1680: 	    set diff "-"
                   1681: 	}
                   1682: 	set upper_percent [expr 100.0 * ($Ycnt_upper($ii) /double($upperpart_cnt))]
                   1683: 	set lower_percent [expr 100.0 * ($Ycnt_lower($ii) /double($upperpart_cnt))]
                   1684: 	set disc [expr $upper_percent  - $lower_percent]
                   1685: 	CTputs $num [format "         %2d:    "  [expr $ii + 1]]
                   1686: 	CTputs $num [format "%6.1f         %5.1f      (%6.1f - %6.1f) \[%8d,%8d\]\n" \
                   1687: 		     $diff $disc $upper_percent $lower_percent $Ycnt_upper($ii) \
                   1688: 			 $Ycnt_lower($ii) ]
                   1689:     }
                   1690:     removeStatus $num
                   1691: }
                   1692: 
                   1693: ###########################################################
                   1694: # CTitemCorrelation
                   1695: ###########################################################
                   1696: # INPUTS: class name with full path, set number
                   1697: #
                   1698: # r = \frac{\sum{x_i y_i} - \frac{(\sum x_i)(\sum y_i)}{n}}
                   1699: #                                {\sqrt{(\sum x_i^2 - \frac{}{}}}
                   1700: #
                   1701: # corr = (sum of prod_xy - (sum_x*sum_y / n) ) / sqrt( (sum of sqr_x - (sum_x*sum_x/n))*
                   1702: # 
                   1703: ###########################################################
                   1704: ###########################################################
                   1705: proc CTitemCorrelation { num classpath setId } {
                   1706:     global gMaxSet
                   1707:      
                   1708:     set filename [file join $classpath records "set$setId.db"]
                   1709:     if { ! [file readable $filename] } { 
                   1710: 	CTputs $num "FILE: $filename does not exist!\n"
                   1711: 	return
                   1712:     }
                   1713: 
                   1714:     displayStatus "Analyzing [file tail $filename]" both $num
                   1715:     set maxLine [lindex [exec wc $filename] 0]
                   1716:     
                   1717:     set initialized 0
                   1718:     set question_cnt 0
                   1719:     set fileId [open "$filename" "r"]
                   1720:     set line_cnt 0
                   1721:     set aline [gets $fileId]
                   1722:     while {![eof $fileId]} {
                   1723: 	incr line_cnt
                   1724: 	if { ($line_cnt%20) == 0 } {
                   1725: 	    updateStatusBar [expr {$line_cnt/double($maxLine)}] $num
                   1726: 	}
                   1727: 	if { $line_cnt == 2 } { 
1.4       albertel 1728: 	    set aline [string trimright $aline]
1.1       albertel 1729: 	    set weights [split $aline {}]
                   1730: 	} 
                   1731: 	if { $line_cnt > 3} {
1.4       albertel 1732: 	    set aline [string trimright $aline]
1.1       albertel 1733: 	    set data  [string range $aline 10 end]
                   1734: 	    set ans_str [lindex [split $data ","] 0]
                   1735: 	    set ans_char_list [split $ans_str {} ]
                   1736: 	    set try_str [string range $aline [expr {[string first "," $data] +1}] end ]
                   1737: 	    set question_cnt [llength $ans_char_list]
                   1738: 	    for { set ii 0 } { $ii < $question_cnt } { incr ii } { 
                   1739: 		set ans_char($ii) [lindex $ans_char_list $ii]
                   1740: 	    }
                   1741: 	    if { $question_cnt > $initialized } {
                   1742: 		for {set ii 0} {$ii < [expr {$question_cnt - 1}]} {incr ii} {
                   1743: 		    set start [expr {($initialized>($ii+1)) ? $initialized : ($ii+1)}]
                   1744: 		    for { set jj $start } { $jj < $question_cnt } { incr jj } {
                   1745: 			set index_key "$ii.$jj"
                   1746: 			set prod_xy($index_key) 0.0
                   1747: 			set sum_x($index_key) 0
                   1748: 			set sum_y($index_key) 0
                   1749: 			set sum_x2($index_key) 0
                   1750: 			set sum_y2($index_key) 0
                   1751: 			set valid_cnt($index_key) 0
                   1752: 		    }
                   1753: 		}
                   1754: 		set initialized $question_cnt
                   1755: 	    }
                   1756: 	    for { set ii 0 } { $ii < [expr {$question_cnt - 1}] } { incr ii } {
                   1757: 		for { set jj [expr {$ii+1}] } { $jj < $question_cnt } { incr jj } {
                   1758: 		    set index_key "$ii.$jj"
                   1759: 		    if { $ans_char($ii) != "-" && $ans_char($ii) != "E" && \
                   1760: 			 $ans_char($jj) != "-" && $ans_char($jj) != "E" } {
                   1761: 			## $ans_char($ii) is one of 0 .. 9, Y, y, N, n
                   1762: 			## $ans_char($jj) is one of 0 .. 9, Y, y, N, n
                   1763: 			if { $ans_char($ii) == "Y" || $ans_char($ii) == "y" } {
1.11      albertel 1764: 			    if {[set x_data [lindex $weights $ii]]==""} {set x_data 0}
1.1       albertel 1765: 			} elseif { $ans_char($ii) == "N" || $ans_char($ii) == "n" } {
                   1766: 			    set x_data 0
                   1767: 			} else { ## must be in 0 .. 9
                   1768: 			    set x_data $ans_char($ii)
                   1769: 			}
                   1770: 			if { $ans_char($jj) == "Y" || $ans_char($jj) == "y" } {
1.11      albertel 1771: 			    if {[set y_data [lindex $weights $jj]]==""} {set y_data 0}
1.1       albertel 1772: 			} elseif { $ans_char($jj) == "N" || $ans_char($jj) == "n" } {
                   1773: 			    set y_data 0
                   1774: 			} else { ## must be in 0 .. 9
                   1775: 			    set y_data $ans_char($jj)
                   1776: 			}
                   1777: 			set prod_xy($index_key)  [expr {$x_data * $y_data + 
                   1778: 							$prod_xy($index_key)} ]
                   1779: 			incr sum_x($index_key)  $x_data
                   1780: 			incr sum_y($index_key)  $y_data
                   1781: 			incr sum_x2($index_key) [expr {$x_data * $x_data}]
                   1782: 			incr sum_y2($index_key) [expr {$y_data * $y_data}]
                   1783: 			incr valid_cnt($index_key) 1
                   1784: 		    }
                   1785: 		} 
                   1786: 	    } 
                   1787: 	} 
                   1788: 	set aline [gets $fileId]
                   1789:     } 
                   1790:     close $fileId
                   1791:     removeStatus $num
                   1792:     # print out the correlation matrix
1.4       albertel 1793:     #parray sum_x
                   1794:     #parray sum_y
                   1795:     #parray prod_xy
                   1796:     #puts $question_cnt
1.1       albertel 1797:     CTputs $num "   "
                   1798:     for { set ii 1 } { $ii < $question_cnt } { incr ii } {
                   1799: 	CTputs $num [format "    %2d" [expr {$ii+1}] ]
                   1800:     }
                   1801:     CTputs $num "\n"
                   1802:     # --------------------------------------
                   1803:     for { set ii 0 } { $ii < [expr {$question_cnt -1}] } { incr ii } {
                   1804: 	CTputs $num [format " %2d:" [expr {$ii+1}] ]
                   1805: 	for { set jj 0 } { $jj < $ii } { incr jj } { CTputs $num "      " }
                   1806: 	for { set jj [expr {$ii+1}] } { $jj < $question_cnt } { incr jj } {
                   1807: 	    set index_key "$ii.$jj"
                   1808: 	    if { $valid_cnt($index_key) != "0" } {
                   1809: 		set upper_part [ expr { $prod_xy($index_key) - 
                   1810: 				    ( ($sum_x($index_key) * $sum_y($index_key)) 
                   1811: 					  / double($valid_cnt($index_key)))}]
                   1812: 		set lower_part [expr {$sum_x2($index_key) - 
                   1813: 				      ($sum_x($index_key) * $sum_x($index_key) 
                   1814: 				       / double($valid_cnt($index_key)))} ]
                   1815: 		set lower_part [expr {$lower_part * ($sum_y2($index_key) - 
                   1816: 						     ($sum_y($index_key) * 
                   1817: 						      $sum_y($index_key) 
                   1818: 						      /double($valid_cnt($index_key))))}]
                   1819: 		set lower_part [expr {sqrt($lower_part)}]
                   1820: 		if { $lower_part != 0.0 } {
                   1821: 		    set ratio [expr {$upper_part / double($lower_part)}]
                   1822: 		    CTputs $num [format " % .2f" $ratio]
                   1823: 		} else {
                   1824: 		    CTputs $num "  INF "
                   1825: 		}
                   1826: 	    } else {
                   1827: 		CTputs $num "  ----"
                   1828: 	    }
                   1829: 	}
                   1830: 	CTputs $num "\n"
                   1831:     }
                   1832: }
                   1833: 
                   1834: ###########################################################
                   1835: # CTsubmissionsLaunch
                   1836: ###########################################################
                   1837: ###########################################################
                   1838: ###########################################################
1.9       albertel 1839: proc CTsubmissionsLaunch { num cmdnum type s_id s_nm index setlist } {
1.1       albertel 1840:     global gCT gFile gUniqueNumber gCapaConfig
                   1841: 
1.9       albertel 1842:     set curset [lindex $setlist $index]
                   1843:     CTputs $cmdnum "$type submissions for $s_nm for set $curset\n"
1.1       albertel 1844:     if { $type == "telnet" } {
1.9       albertel 1845: 	set command "grep -i $s_id [file join $gFile($num) records submissions$curset.db]"
1.1       albertel 1846: 	set followtype web
                   1847:     } else {
                   1848: 	set command "grep -i $s_id [file join $gFile($num) \
1.9       albertel 1849:                        records websubmissions$curset.db]"
1.1       albertel 1850: 	set followtype telnet
1.9       albertel 1851: 	incr index
1.1       albertel 1852:     }
                   1853:     set done 0
                   1854:     set followcmd ""
1.9       albertel 1855:     while { !$done && ($index <= [llength $setlist]) } {
                   1856: 	if { [lindex $setlist $index] != "" } {
1.1       albertel 1857: 	    set followcmd "CTsubmissionsLaunch $num $cmdnum $followtype $s_id {$s_nm} \
1.9       albertel 1858:                             $index \"$setlist\""
1.1       albertel 1859: 	}
1.9       albertel 1860: 	if { ![catch {set fileId [open "|$command" "r"]} error ] } { set done 1 } 
1.1       albertel 1861:     }
                   1862:     fconfigure $fileId -blocking 0
                   1863:     fileevent $fileId readable "CTrunCommand $num $cmdnum $fileId {$followcmd}"
                   1864: }
                   1865: 
                   1866: ###########################################################
                   1867: # CTreportDist
                   1868: ###########################################################
                   1869: ###########################################################
                   1870: ###########################################################
                   1871: proc CTreportDist { num file percentage sectionlist } {
                   1872:     set fileId [open $file "r"]
                   1873:     set aline [gets $fileId]
                   1874:     set which [expr [llength [split $aline "\t"]] - 2]
                   1875:     set maximum [lindex [lrange [split $aline "\t"] $which end] 1]
                   1876:     if { $percentage } {
                   1877: 	for {set i 0} {$i<=100} {incr i} {
                   1878: 	    set totals($i.score) 0
                   1879: 	    set totals($i.stunum) ""
                   1880: 	}
                   1881:     } else {
                   1882: 	for { set i 0 } { $i <= $maximum } { incr i } { 
                   1883: 	    set totals($i.score) 0 
                   1884: 	    set totals($i.stunum) ""
                   1885: 	}
                   1886:     }
                   1887:     while { ![eof $fileId]} {
                   1888: 	set temp [lrange [split $aline "\t"] $which end]
                   1889: 	set score [lindex $temp 0]
                   1890: 	regsub -- "-" $score "0" score
                   1891: 	set max [lindex $temp 1]
                   1892: 	set temp [lindex [split $aline "\t"] 1]
                   1893: 	set section [lindex $temp 1]
                   1894: 	set stunum [lindex $temp 0]
                   1895: 	if { ([lsearch $sectionlist $section] != -1) && ($max!=0) } {
                   1896: 	    if { $percentage } {
                   1897: 		set percent [expr int($score/double($max)*100)]
                   1898: 		incr totals($percent.score)
                   1899: 		lappend totals($percent.stunum) $stunum
                   1900: 	    } else {
                   1901: 		if { $max > $maximum } {
                   1902: 		    for {set i [expr $maximum+1]} {$i<=$max} {incr i} {set totals($i) 0}
                   1903: 		    set maximum $max
                   1904: 		}
                   1905: 		set score [string trim $score]
                   1906: 		incr totals($score.score)
                   1907: 		lappend totals($score.stunum) $stunum
                   1908: 	    }
                   1909: 	}
                   1910: 	set aline [gets $fileId]
                   1911:     }
1.12      albertel 1912:     CTputs $num "Scores #achieved\n"
1.1       albertel 1913:     set scorelist ""
                   1914:     set templist [array names totals *.score]
                   1915:     foreach temp $templist {lappend possiblescores [lindex [split $temp .] 0]}
                   1916:     foreach score [lsort -integer $possiblescores] {
                   1917: 	CTputs $num [format "%5d:%6d\n" $score $totals($score.score)]
                   1918: 	lappend scorelist [list $totals($score.score) $score $totals($score.stunum)]
                   1919:     } 
                   1920:     return $scorelist
                   1921: }
                   1922: 
                   1923: ###########################################################
                   1924: # CTgradeDistribution
                   1925: ###########################################################
                   1926: ###########################################################
                   1927: ###########################################################
                   1928: proc CTgradeDistribution { num classpath setId } {
                   1929:     set filename [file join $classpath records "set$setId.db"]
                   1930:     if { ! [file readable $filename] } { 
                   1931: 	CTputs $num "FILE: $filename does not exist!\n"
                   1932: 	return
                   1933:     }
                   1934:     
                   1935:     displayStatus "Analyzing [file tail $filename]" both $num
                   1936:     set maxLine [lindex [exec wc $filename] 0]
                   1937:     set fileId [open "$filename" "r"]
                   1938:     set valid_cnt 0
                   1939:     set line_cnt 0
                   1940:     set aline [gets $fileId]
                   1941:     while {![eof $fileId]} {
                   1942: 	incr line_cnt
                   1943: 	if { ($line_cnt%20) == 0 } {
                   1944: 	    updateStatusBar [expr $line_cnt/double($maxLine)] $num
                   1945: 	}
                   1946: 	if { $line_cnt == 2 } { 
                   1947: 	    set aline [string trim $aline]
                   1948: 	    set weights [split $aline {}]	
                   1949: 	    set valid_weights 0	
                   1950: 	    foreach weight $weights { incr valid_weights $weight }
                   1951: 	    for { set i 0 } { $i <= $valid_weights } { incr i } { 
                   1952: 		set total_score($i) 0
                   1953: 	    }
                   1954: 	} elseif { $line_cnt > 3} {
                   1955: 	    set aline [string trim $aline]
                   1956: 	    set prefix [lindex [split $aline ","] 0]
                   1957: 	    set s_num [string toupper [lindex [split $aline " " ] 0 ] ]
                   1958: 	    set ans_str [lindex [split $prefix " "] 1]
                   1959: 	    set ans_char [split $ans_str {} ]
                   1960: 	    set valid 0
                   1961: 	    for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
                   1962: 		if { [lindex $ans_char $ii] != "-"} { set valid 1 }
                   1963: 	    }
                   1964: 	    if { $valid } { 
                   1965: 		incr valid_cnt
                   1966: 		set score 0
                   1967: 		for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
                   1968: 		    if { [lindex $ans_char $ii] == "Y" || \
                   1969: 			 [lindex $ans_char $ii] == "y" } {
                   1970: 			incr score [lindex $weights $ii]
                   1971: 		    }
                   1972: 		    if { [lindex $ans_char $ii] >= 0 && \
                   1973: 			     [lindex $ans_char $ii] <= 9 } {
                   1974: 			incr score [lindex $ans_char $ii]
                   1975: 		    }
                   1976: 		}
                   1977: 		if { [catch {incr total_score($score)} ] } {
                   1978: 		    puts "$aline:$prefix:$s_num:$ans_str:$ans_char"
                   1979: 		}
                   1980: 		
                   1981: 	    }
                   1982: 	}
                   1983: 	set aline [gets $fileId]
                   1984:     }
                   1985:     close $fileId
                   1986:     removeStatus $num
                   1987:     displayStatus "Pondering data . . ." spinner $num
                   1988:     CTputs $num " There are $valid_cnt entries in file $filename\n"
1.12      albertel 1989:     CTputs $num "Score #achieved\n"
1.1       albertel 1990:     set scorelist ""
                   1991:     foreach score [lsort -integer [array names total_score]] {
                   1992: 	CTputs $num [format "%5d:%6d\n" $score $total_score($score)]
                   1993: 	lappend scorelist [list $total_score($score) $score]
                   1994:     }
                   1995:     removeStatus $num
                   1996:     return $scorelist
                   1997: }
                   1998: 
                   1999: ###########################################################
                   2000: # CTgetStudentScores
                   2001: ###########################################################
                   2002: ###########################################################
                   2003: ###########################################################
                   2004: proc CTgetStudentScores { studentScoresVar classpath setId num } {
                   2005:     upvar $studentScoresVar studentScores
                   2006: 
                   2007:     set filename [file join $classpath records "set$setId.db"]
                   2008:     if { ! [file readable $filename] } { 
                   2009: 	CTputs $num "FILE: $filename does not exist!\n"
                   2010: 	error
                   2011:     }
                   2012:     
                   2013:     displayStatus "Analyzing [file tail $filename]" both $num
                   2014:     set maxLine [lindex [exec wc $filename] 0]
                   2015:     set fileId [open "$filename" "r"]
                   2016:     set valid_cnt 0
                   2017:     set line_cnt 0
                   2018:     set aline [gets $fileId]
                   2019:     set aline [gets $fileId]
                   2020:     set weights [split [string trim $aline] {}]
                   2021:     set valid_weights 0	
                   2022:     foreach weight $weights { incr valid_weights $weight }
                   2023:     set aline [gets $fileId]
                   2024:     set aline [gets $fileId]
                   2025:     while {![eof $fileId]} {
                   2026: 	incr line_cnt
                   2027: 	if { ($line_cnt%20) == 0 } {
                   2028: 	    updateStatusBar [expr $line_cnt/double($maxLine)] $num
                   2029: 	}
                   2030: 	set aline [string trim $aline]
                   2031: 	set prefix [lindex [split $aline ","] 0]
                   2032: 	set s_num [string toupper [lindex [split $aline " " ] 0 ] ]
                   2033: 	set ans_str [lindex [split $prefix " "] 1]
                   2034: 	set ans_char [split $ans_str {} ]
                   2035: 	set valid 0
                   2036: 	for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
                   2037: 	    if { [lindex $ans_char $ii] != "-"} { set valid 1 }
                   2038: 	}
                   2039: 	if { $valid } { 
                   2040: 	    incr valid_cnt
                   2041: 	    if {[array names studentScores $s_num] == ""} {set studentScores($s_num) 0}
                   2042: 	    for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
                   2043: 		if { [lindex $ans_char $ii] == "Y" || [lindex $ans_char $ii] == "y" } {
                   2044: 		    incr studentScores($s_num) [lindex $weights $ii]
                   2045: 		}
                   2046: 		if { [lindex $ans_char $ii] >= 0 && [lindex $ans_char $ii] <= 9 } {
                   2047: 		    incr studentScores($s_num) [lindex $ans_char $ii]
                   2048: 		}
                   2049: 	    }
                   2050: 	}
                   2051: 	set aline [gets $fileId]
                   2052:     }
                   2053:     close $fileId
                   2054:     removeStatus $num
                   2055:     return $valid_weights
                   2056: }
                   2057: 
                   2058: ###########################################################
                   2059: # CTgradeDistributionRange
                   2060: ###########################################################
                   2061: ###########################################################
                   2062: ###########################################################
                   2063: proc CTgradeDistributionRange { num classpath setIdstart setIdend } {
                   2064:     set totalpoints 0
                   2065:     for {set setId $setIdstart} {$setId <= $setIdend} {incr setId} {
                   2066: 	set points [CTgetStudentScores studentScores $classpath $setId $num]
                   2067: 	incr totalpoints $points 
                   2068: #	parray studentScores
                   2069:     }
                   2070: 
                   2071:     displayStatus "Pondering data . . ." spinner $num
                   2072:     for { set i 0 } { $i <= $totalpoints } { incr i } { 
                   2073: 	set total_score($i) 0
                   2074:     }
                   2075:     foreach sNum [array names studentScores] { incr total_score($studentScores($sNum)) }
1.12      albertel 2076:     CTputs $num "Scores #achieved\n"
1.1       albertel 2077:     set scorelist ""
                   2078:     foreach score [lsort -integer [array names total_score]] {
                   2079: 	CTputs $num [format "%5d:%6d\n" $score $total_score($score)]
                   2080: 	lappend scorelist [list $total_score($score) $score]
                   2081:     }
                   2082:     removeStatus $num
                   2083:     return $scorelist
                   2084: }
                   2085: 
                   2086: #common Input dialogs
                   2087: 
                   2088: #common output methods
                   2089: proc CTdatestamp { cmdnum } {
                   2090:     CTputs $cmdnum [clock format [clock seconds]]\n
                   2091: }
                   2092: 
                   2093: ###########################################################
                   2094: # CTputs
                   2095: ###########################################################
                   2096: ###########################################################
                   2097: ###########################################################
                   2098: proc CTputs { num message {tag normal} } {
                   2099:     global gCT
                   2100: 
                   2101:     lappend gCT(output.$num) [list $message $tag]
                   2102: }
                   2103: 
                   2104: ###########################################################
                   2105: # CToutputWrap
                   2106: ###########################################################
                   2107: ###########################################################
                   2108: ###########################################################
                   2109: proc CToutputWrap { num } {
                   2110:     global gCT 
                   2111:     if { $gCT($num.wrap) } {
                   2112: 	$gCT($num.output) configure -wrap char
                   2113:     } else {
                   2114: 	$gCT($num.output) configure -wrap none
                   2115:     }
                   2116: }
                   2117: 
                   2118: ###########################################################
                   2119: # CToutput
                   2120: ###########################################################
                   2121: ###########################################################
                   2122: ###########################################################
                   2123: proc CToutput { num cmdnum } {
                   2124:     global gCT 
                   2125:     
                   2126:     if { ![winfo exists $gCT($num).output] } {
                   2127: 	set outputWin [toplevel $gCT($num).output]
                   2128: 	
                   2129: 	set buttonFrame [frame $outputWin.button]
                   2130: 	set textFrame [frame $outputWin.text]
                   2131: 	set bottomFrame [frame $outputWin.bottom]
                   2132: 	pack $buttonFrame $textFrame $bottomFrame
                   2133: 	pack configure $buttonFrame -anchor e -expand 0 -fill x
                   2134: 	pack configure $textFrame -expand 1 -fill both
                   2135: 	pack configure $bottomFrame -expand 0 -fill x
                   2136: 
                   2137: 	set gCT($num.output) [text $textFrame.text \
                   2138: 				  -yscrollcommand "$textFrame.scroll set" \
                   2139: 				  -xscrollcommand "$bottomFrame.scroll set"]
                   2140: 	scrollbar $textFrame.scroll -command "$textFrame.text yview"
                   2141: 	pack $gCT($num.output) $textFrame.scroll -side left
                   2142: 	pack configure $textFrame.text -expand 1 -fill both
                   2143: 	pack configure $textFrame.scroll -expand 0 -fill y
                   2144: 
                   2145: 	scrollbar $bottomFrame.scroll -command "$textFrame.text xview" -orient h
                   2146: 	pack $bottomFrame.scroll -expand 0 -fill x
                   2147: 
                   2148: 	set gCT($num.wrap) 1
                   2149: 	checkbutton $buttonFrame.wrap -text "Wrap" -command "CToutputWrap $num" \
                   2150: 	    -variable gCT($num.wrap) 
                   2151: 	button $buttonFrame.save -text "Save Text" -command "CTsaveText $num"
                   2152: 	button $buttonFrame.print -text "Print Text" -command "CTprintText $num"
                   2153: 	button $buttonFrame.dismiss -text "Dismiss" -command "destroy $outputWin"
                   2154: 	pack $buttonFrame.wrap $buttonFrame.save $buttonFrame.print \
                   2155: 	    $buttonFrame.dismiss -side left
                   2156:     }
1.7       albertel 2157:     set index [$gCT($num.output) index end-1c]
1.1       albertel 2158:     foreach line $gCT(output.$cmdnum) {
                   2159: 	eval $gCT($num.output) insert end $line
                   2160:     }
                   2161:     unset gCT(output.$cmdnum)
                   2162:     raise $gCT($num).output
                   2163:     $gCT($num.output) see $index
                   2164:     update idletasks
                   2165: }
                   2166: 
                   2167: ###########################################################
                   2168: # CTsaveText
                   2169: ###########################################################
                   2170: # saves the contents of a text window
                   2171: ###########################################################
                   2172: # Arguments: num (the unique number of the path, and window)
                   2173: # Returns  : nothing
                   2174: # Globals  :
                   2175: ###########################################################
                   2176: proc CTsaveText { num } {
                   2177:     global gFile gCT
                   2178: 
                   2179:     set window $gCT($num.output) 
                   2180:     if {![winfo exists $window]} { return }
                   2181:     set dir $gFile($num)
                   2182:     set file ""
                   2183:     
                   2184:     if { $dir == "" || $dir == "."} { set dir [pwd] }
                   2185:     set file [tk_getSaveFile -title "Enter the name to Save As" \
                   2186: 		  -initialdir "$dir" ]
                   2187:     if { $file == "" } {
                   2188: 	displayError "File not saved"
                   2189: 	return
                   2190:     }
                   2191:     set fileId [open $file w]
                   2192:     puts -nonewline $fileId [$window get 0.0 end-1c]
                   2193:     close $fileId
                   2194: }
                   2195: 
                   2196: ###########################################################
                   2197: # CTprintText
                   2198: ###########################################################
                   2199: # prints the contents of the text window, creates a temp file named
                   2200: # quiztemp.txt
                   2201: ###########################################################
                   2202: # Arguments: num (the unique number of the path, and window)
                   2203: # Returns  : nothing
                   2204: # Globals  : gFile gCT
                   2205: ###########################################################
                   2206: proc CTprintText { num } {
                   2207:     global gFile gCT
                   2208: 
                   2209:     set window $gCT($num.output) 
                   2210:     if { ![winfo exists $window]} { return }
                   2211:     catch {parseCapaConfig $num $gFile($num)}
                   2212:     set lprCommand [getLprCommand [file join $gFile($num) managertemp.txt] $num]
                   2213:     if {$lprCommand == "Cancel"} { return }
                   2214:   
                   2215:     set fileId [open [file join $gFile($num) managertemp.txt] w]
                   2216:     puts -nonewline $fileId [$window get 0.0 end-1c]
                   2217:     close $fileId
                   2218: 
                   2219:     set errorMsg ""
                   2220:     if { [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]} {
                   2221:         displayError "An error occurred while printing: $errorMsg"
                   2222:     } else {
                   2223: 	displayMessage "Print job sent to the printer.\n $output"
                   2224:     }
                   2225:     exec rm -f [file join $gFile($num) mangertemp.txt]
                   2226: }
                   2227: 
                   2228: ###########################################################
                   2229: # CTprintCanvas
                   2230: ###########################################################
                   2231: ###########################################################
                   2232: ###########################################################
                   2233: proc CTprintCanvas { num window path } {
                   2234: 
                   2235:     if { ![winfo exists $window]} { return }
                   2236:     catch {parseCapaConfig $num $gFile($num)}
                   2237:     set lprCommand [getLprCommand [file join $path managertemp.txt] $num]
                   2238:     if {$lprCommand == "Cancel"} { return }
                   2239:   
                   2240:     set rotate 0
                   2241:     if { [tk_messageBox -title "Print in landscape mode" -message "Would you like to print in landscape mode?" -icon question -type yesno] == "yes" } { set rotate 1 }
                   2242:     $window postscript -file [file join $path managertemp.txt] -rotate $rotate
                   2243: 
                   2244:     set errorMsg ""
                   2245:     if { [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]} {
                   2246:         displayError "An error occurred while printing: $errorMsg"
                   2247:     } else {
                   2248: 	displayMessage "Print job sent to the printer.\n $output"
                   2249:     }
                   2250:     exec rm -f [file join $path mangertemp.txt]
                   2251: }
                   2252: 
                   2253: ###########################################################
                   2254: # CTsaveCanvas
                   2255: ###########################################################
                   2256: ###########################################################
                   2257: ###########################################################
                   2258: proc CTsaveCanvas { window path } {
                   2259:     if { ![winfo exists $window] } { return }
                   2260:     set dir $path
                   2261:     set file ""
                   2262:     
                   2263:     if { $dir == "" } { set dir [pwd] }
                   2264:     set file [tk_getSaveFile -title "Enter the name to Save As" \
                   2265: 		  -initialdir "$dir" ]
                   2266:     if { $file == "" } {
                   2267: 	displayError "File not saved"
                   2268: 	return
                   2269:     }
                   2270:     $window postscript -file $file
                   2271: }
                   2272: 
                   2273: ###########################################################
                   2274: # CTbargraph
                   2275: ###########################################################
                   2276: ###########################################################
                   2277: ###########################################################
                   2278: proc CTbargraph {window num barnum data {path ""} {title "" } {xlabel ""} {ylabel ""}
                   2279: 		 {suffix ""} } {
                   2280:     global gBarGraph
                   2281:     set height 300
                   2282:     set width 500
                   2283:     
                   2284:     global gWindowMenu
                   2285: 
                   2286:     set bargraph [toplevel $window.bargraph$barnum]
                   2287:     if { $title != "" } { wm title $bargraph $title }
                   2288:     $gWindowMenu add command -label "$title $barnum" -command "capaRaise $bargraph"
                   2289: 
                   2290:     set buttonFrame [frame $bargraph.buttons]
                   2291:     set canvasFrame [frame $bargraph.canvas]
                   2292:     pack $buttonFrame $canvasFrame -side top
                   2293:     pack configure $canvasFrame -expand 1 -fill both
                   2294: 
                   2295:     set canvas [canvas $canvasFrame.canvas -height $height -width $width -background white]
                   2296:     pack $canvas -expand 1 -fill both
                   2297:     bind $canvas <Configure> "CTdrawBargraph $barnum"
                   2298: 
                   2299:     button $buttonFrame.change -text "Change Graph" -command "CTchangeBargraph $window $barnum"
                   2300:     button $buttonFrame.save -text "Save Graph" -command "CTsaveCanvas $canvas $path"
                   2301:     button $buttonFrame.print -text "Print Graph" -command "CTprintCanvas $num $canvas $path"
                   2302:     button $buttonFrame.dismiss -text "Dismiss" -command "CTdestroyBargraph $barnum"
                   2303:     pack $buttonFrame.change $buttonFrame.save $buttonFrame.print \
                   2304: 	$buttonFrame.dismiss -side left
                   2305:     bind $bargraph <Destroy> "CTdestroyBargraph $barnum"
                   2306: 
                   2307:     set gBarGraph($barnum.num) $num
                   2308:     set gBarGraph($barnum.suffix) $suffix
                   2309:     set gBarGraph($barnum) $data
                   2310:     set gBarGraph($barnum.canvas) $canvas
                   2311:     set gBarGraph($barnum.title) $title
                   2312:     set gBarGraph($barnum.xlabel) $xlabel
                   2313:     set gBarGraph($barnum.ylabel) $ylabel
                   2314:     set gBarGraph($barnum.color) green
                   2315:     set gBarGraph($barnum.bucketscores) 0
1.14      albertel 2316:     set gBarGraph($barnum.ymax) [CTautoscaleBargraph $barnum]
                   2317:     set gBarGraph($barnum.ymaxold) $gBarGraph($barnum.ymax)
1.1       albertel 2318:     CTdrawBargraph $barnum
                   2319: }
                   2320: 
                   2321: ###########################################################
1.14      albertel 2322: # CTmaxBargraph
                   2323: ###########################################################
                   2324: ###########################################################
                   2325: ###########################################################
                   2326: proc CTmaxBargraph { barnum } {
                   2327:     global gBarGraph
                   2328: 
                   2329:     set data $gBarGraph($barnum)
                   2330:     set total [llength $data]
                   2331:     set howoften $gBarGraph($barnum.xoften)
                   2332:     set when [expr ($total-1)%$howoften]
                   2333:     set max 0
                   2334:     set i 0
                   2335:     set value 0
                   2336:     if { $gBarGraph($barnum.bucketscores) } {
                   2337: 	foreach datum $data {
                   2338: 	    set value [expr {$value + [lindex $datum 0]}]
                   2339: 	    if { $i % $howoften == $when } {
                   2340: 		if { $value > $max } { set max $value }
                   2341: 		set value 0
                   2342: 	    }
                   2343: 	    incr i
                   2344: 	}
                   2345:     } else {
                   2346: 	set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0]
                   2347:     }
                   2348:     if { $max > int($max) } { set max [expr int($max+1)] }
                   2349:     set gBarGraph($barnum.ymaxold) [set gBarGraph($barnum.ymax) $max]
                   2350:     return $max
                   2351: }
                   2352: 
                   2353: proc CTsort { arg1 arg2 } {
                   2354:     set arg1 [eval expr [join [lindex $arg1 0] +]]
                   2355:     set arg2 [eval expr [join [lindex $arg2 0] +]]
                   2356:     if { $arg1 < $arg2 } { return -1 }
                   2357:     if { $arg1 > $arg2 } { return 1 }
                   2358:     return 0
                   2359: }
                   2360: 
                   2361: ###########################################################
1.1       albertel 2362: # CTautoscaleBargraph
                   2363: ###########################################################
                   2364: ###########################################################
                   2365: ###########################################################
                   2366: proc CTautoscaleBargraph { barnum } {
                   2367:     global gBarGraph
                   2368:     set data $gBarGraph($barnum)
1.14      albertel 2369:     if { [catch {set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0]}] } {
                   2370: 	set max [lindex [lindex [lsort -decreasing -command CTsort $data] 0] 0]
                   2371: 	set max [eval expr [join $max +]]
                   2372:     }
1.1       albertel 2373:     if { $max > int($max) } { set max [expr int($max+1)] }
                   2374:     set gBarGraph($barnum.yoften) [expr int([format "%1.e" [expr $max/10.0]])]
                   2375:     if { $gBarGraph($barnum.yoften) == 0 } { set gBarGraph($barnum.yoften) 1 }
                   2376:     set total [llength $data]
                   2377:     set gBarGraph($barnum.xoften) [expr ($total/25) + 1]
1.14      albertel 2378:     return $max
1.1       albertel 2379: }
                   2380: 
                   2381: ###########################################################
                   2382: # CTchangeBargraphData
                   2383: ###########################################################
                   2384: ###########################################################
                   2385: ###########################################################
                   2386: proc CTchangeBargraphData { barnum data } {
                   2387:     global gBarGraph
                   2388:     set gBarGraph($barnum) $data
1.14      albertel 2389:     set gBarGraph($barnum.ymax) [CTautoscaleBargraph $barnum]
                   2390:     set gBarGraph($barnum.ymaxold) $gBarGraph($barnum.ymax)
1.1       albertel 2391:     CTdrawBargraph $barnum
                   2392: }
                   2393: 
                   2394: ###########################################################
                   2395: # CTdestroyBargraph
                   2396: ###########################################################
                   2397: ###########################################################
                   2398: ###########################################################
                   2399: proc CTdestroyBargraph { num } {
                   2400:     global gBarGraph
                   2401:     
                   2402:     if { [catch {set window [winfo toplevel $gBarGraph($num.canvas)]}]} { return }
                   2403:     set window2 [file rootname $window].changeBarGraph$num
                   2404:     foreach name [array names gBarGraph "$num.*" ] {
                   2405: 	unset gBarGraph($name)
                   2406:     }
                   2407:     unset gBarGraph($num)
                   2408:     destroy $window 
                   2409:     catch {destroy $window2}
                   2410: }
                   2411: 
                   2412: ###########################################################
                   2413: # CTdrawBargraph
                   2414: ###########################################################
                   2415: ###########################################################
                   2416: ###########################################################
                   2417: proc CTdrawBargraph { num } {
                   2418:     global gBarGraph
                   2419: 
                   2420:     set data $gBarGraph($num)
                   2421:     set canvas $gBarGraph($num.canvas)
                   2422:     set suffix $gBarGraph($num.suffix)
                   2423: 
                   2424:     set height [winfo height $canvas]
                   2425:     set width [winfo width $canvas]
                   2426:     set titleoffset 0
                   2427:     set titleheight 15
                   2428:     set labelheight 15
                   2429:     set tickheight 15
                   2430:     set textheight [expr $labelheight+$tickheight]
                   2431:     set textwidth 40
                   2432:     set graphheight [expr $height - $textheight - $titleheight]
                   2433:     set graphwidth [expr $width - $textwidth]
                   2434:     $canvas delete all
                   2435: 
                   2436:     #draw data
                   2437:     set total [llength $data]
                   2438:     set eachwidth [expr $graphwidth/$total]
                   2439: #    set howoften [expr ($total/$gBarGraph($num.numlabels)) + 1]
                   2440:     set howoften $gBarGraph($num.xoften)
                   2441:     set when [expr ($total-1)%$howoften]
                   2442:     set max 0
                   2443:     set i 0
                   2444:     set value 0
                   2445:     if { $gBarGraph($num.bucketscores) } {
                   2446: 	foreach datum $data {
1.14      albertel 2447: 	    set value [eval expr $value + [join [lindex $datum 0] +]]
1.1       albertel 2448: 	    if { $i % $howoften == $when } {
                   2449: 		if { $value > $max } { set max $value }
                   2450: 		set value 0
                   2451: 	    }
                   2452: 	    incr i
                   2453: 	}
                   2454:     } else {
1.14      albertel 2455: 	if { [catch {set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0]}] } {
                   2456: 	    set max [lindex [lindex [lsort -decreasing -command CTsort $data] 0] 0]
                   2457: 	    set max [eval expr [join $max +]]
                   2458: 	}
1.1       albertel 2459:     }
                   2460:     if { $max > int($max) } { set max [expr int($max+1)] }
1.14      albertel 2461:     if { $gBarGraph($num.ymaxold) != $gBarGraph($num.ymax) } { 
                   2462: 	set max $gBarGraph($num.ymax)
                   2463:     }
1.1       albertel 2464:     if { [catch {set pixelvalue [expr ($graphheight-1)/double($max)]} ] } {
                   2465: 	set pixelvalue 10
                   2466:     }
1.14      albertel 2467: 
1.1       albertel 2468:     set i 0
                   2469:     set value 0
                   2470:     foreach datum $data {
1.14      albertel 2471: #	puts ":$datum:"
                   2472: 	if { [llength [lindex $datum 0]] == 1 } {
                   2473: 	    set value [expr {$value + [lindex $datum 0]}]
                   2474: 	    CTdrawBargraphBar
                   2475: 	    incr i
                   2476: 	} else {
                   2477: 	    set value [eval expr $value + [join [lindex $datum 0] +]]
                   2478: 	    CTdrawBargraphBarN
                   2479: 	    incr i
1.1       albertel 2480: 	}
                   2481:     }
1.14      albertel 2482: #    puts "value:$value:"
1.1       albertel 2483: 
                   2484:     #draw title
                   2485:     $canvas create text [expr $textwidth+$titleoffset+($graphwidth/2)] 1 -anchor n\
                   2486: 	-text $gBarGraph($num.title)
                   2487:     #draw axis
                   2488:     $canvas create line $textwidth [expr {$graphheight + $titleheight}] \
                   2489: 	$textwidth [expr {$titleheight + 1}]
                   2490:     #label xaxis
                   2491:     $canvas create text [expr ($textwidth+($graphwidth/2))] \
                   2492: 	[expr $titleheight+$graphheight+$tickheight+($labelheight/2)] \
                   2493: 	-text $gBarGraph($num.xlabel)
                   2494:     #label yaxis
                   2495:     $canvas create text 1 1 -anchor nw -text $gBarGraph($num.ylabel)
                   2496:     #draw tickmarks
                   2497: #    set delta [format "%1.e" [expr ($max)/double($gBarGraph($num.numticks))]]
                   2498:     set delta $gBarGraph($num.yoften)
                   2499:     set start 0.0
                   2500:     while { $start < $max } {
                   2501: 	set center [expr {($graphheight-1)*(($start)/$max)+$titleheight+1}]
                   2502: 	$canvas create line $textwidth $center [expr $textwidth - 20] $center
                   2503: 	$canvas create text [expr $textwidth-3] $center -anchor ne -text [expr int($max-$start)]
                   2504: 	set start [expr $start + $delta]
                   2505:     }
                   2506:     if { [llength [lindex $data 0]] > 2} {
                   2507: 	$canvas bind current <1> "CTbargraphClick$suffix $num"
                   2508: 	bind $canvas <Enter> "CTbargraphDisplayCreate $num"
                   2509: 	bind $canvas <Leave> "CTbargraphDisplayRemove $num"
                   2510: 	bind $canvas <Motion> "CTbargraphDisplayMove $num"
                   2511: 	$canvas bind all <Enter> "CTbargraphDisplay$suffix $num"
                   2512:     }
                   2513: }
                   2514: 
1.14      albertel 2515: proc CTdrawBargraphBar { } {
                   2516:     global gBarGraph
                   2517:     uplevel 1 {
                   2518: 	set canvas $gBarGraph($num.canvas)
                   2519: 	
                   2520: 	set which [lindex $datum 1]
                   2521: 	set y1 [expr {$graphheight + $titleheight}]
                   2522: 	set x2 [expr {$eachwidth * ($i+1) + $textwidth}] 
                   2523: 	set y2 [expr {($graphheight-1) + $titleheight - $value * $pixelvalue}]
                   2524: 	set tag bar.$which.[expr $which-$howoften]
                   2525: 	if { [set color [lindex $datum 3]] == "" } {set color $gBarGraph($num.color)}
                   2526: 	if { $gBarGraph($num.bucketscores) && ($i % $howoften == $when) } {
                   2527: 	    if { $i == $when } {
                   2528: 		#		puts "$value-$which-$howoften"
                   2529: 		$canvas create rectangle $textwidth \
                   2530: 		    $y1 $x2 $y2 -fill $color -tag $tag
                   2531: 	    } else {
                   2532: 		#		puts "$value:$which:$howoften"
                   2533: 		$canvas create rectangle [expr {$eachwidth*($i-$howoften+1)+$textwidth}]\
                   2534: 		    $y1 $x2 $y2 -fill $color -tag $tag
                   2535: 	    }
                   2536: 	} elseif { !$gBarGraph($num.bucketscores) } {
                   2537: 	    $canvas create rectangle [expr {$eachwidth * $i + $textwidth}] \
                   2538: 		$y1 $x2 $y2 -fill $color -tag bar.$which.[expr $which-1]
                   2539: 	    set value 0
                   2540: 	}
                   2541: 	if { $i % $howoften == $when } {
                   2542: 	    $canvas create text [expr {$eachwidth * $i + $textwidth + $eachwidth/2}] \
                   2543: 		[expr $graphheight+(($tickheight)/2)+$titleheight] -text $which
                   2544: 	    set value 0
                   2545: 	}
                   2546:     }
                   2547: }
                   2548: 
                   2549: proc CTdrawBargraphBarN { } {
                   2550:     global gBarGraph
                   2551:     uplevel 1 {
                   2552: 	set canvas $gBarGraph($num.canvas)
                   2553: 	
                   2554: 	set which [lindex $datum 1]
                   2555: 	set y1 [expr {$graphheight + $titleheight}]
                   2556: 	set x2 [expr {$eachwidth * ($i+1) + $textwidth}] 
                   2557: 	set tag bar.$which.[expr $which-$howoften]
                   2558: 	set subpoint 0
                   2559: 	for {set j 0} {$j < [llength [lindex $datum 0]]} {incr j} {
                   2560: 	    set subpointincr [lindex [lindex $datum 0] $j]
                   2561: 	    if { $subpointincr == 0 } { continue }
                   2562: 	    incr subpoint $subpointincr
                   2563: 	    set y2 [expr {($graphheight-1) + $titleheight - $subpoint * $pixelvalue}]
                   2564: 	    set tag bar.$which.[expr $which-$howoften].$j
                   2565: 	    if { [set color [lindex [lindex $datum 3] $j]] == ""}  {
                   2566: 		set color $gBarGraph($num.color)
                   2567: 	    }
                   2568: 	    if { $gBarGraph($num.bucketscores) && ($i % $howoften == $when) } {
                   2569: 		if { $i == $when } {
                   2570: 		    #		puts "$value-$which-$howoften"
                   2571: 		    $canvas create rectangle $textwidth \
                   2572: 			$y1 $x2 $y2 -fill $color -tag $tag
                   2573: 		} else {
                   2574: 		    #		puts "$value:$which:$howoften"
                   2575: 		    $canvas create rectangle [expr {$eachwidth*($i-$howoften+1)+$textwidth}]\
                   2576: 			$y1 $x2 $y2 -fill $color -tag $tag
                   2577: 		}
                   2578: 	    } elseif { !$gBarGraph($num.bucketscores) } {
                   2579: 		set x1 [expr {$eachwidth * $i + $textwidth}]
                   2580: #		puts "y:$y1:$y2:x:$x1:$x2:subpoint:$subpoint"
                   2581: 		$canvas create rectangle [expr {$eachwidth * $i + $textwidth}] \
                   2582: 		    $y1 $x2 $y2 -fill $color -tag bar.$which.[expr $which-1].$j
                   2583: 		set value 0
                   2584: 	    } else {
                   2585: 		break
                   2586: 	    }
                   2587: 	    set y1 $y2
                   2588: 	}
                   2589: 	if { $i % $howoften == $when } {
                   2590: 	    $canvas create text [expr {$eachwidth * $i + $textwidth + $eachwidth/2}] \
                   2591: 		[expr $graphheight+(($tickheight)/2)+$titleheight] -text $which
                   2592: 	    set value 0
                   2593: 	}
                   2594:     }
                   2595: }
                   2596: 
1.1       albertel 2597: ###########################################################
                   2598: # CTbargraphDisplayCreate
                   2599: ###########################################################
                   2600: ###########################################################
                   2601: ###########################################################
                   2602: proc CTbargraphDisplayCreate { barnum } {
                   2603:     global gBarGraph gCT gFile
                   2604:     set canvas $gBarGraph($barnum.canvas)
                   2605:     if {[winfo exists $canvas.bubble$barnum]} { return }
                   2606:     set bubble [toplevel $canvas.bubble$barnum]
                   2607:     wm overrideredirect $bubble 1
                   2608:     wm positionfrom $bubble program
                   2609:     wm withdraw $bubble
                   2610:     pack [label $bubble.l -highlightthickness 0 -relief raised -bd 1 -background yellow]
                   2611: }
                   2612: ###########################################################
                   2613: # CTbargraphDisplayRemove
                   2614: ###########################################################
                   2615: ###########################################################
                   2616: ###########################################################
                   2617: proc CTbargraphDisplayRemove { barnum } {
                   2618:     global gBarGraph gCT gFile
                   2619:     set canvas $gBarGraph($barnum.canvas)
                   2620:     catch {destroy $canvas.bubble$barnum}
                   2621: }
                   2622: ###########################################################
                   2623: # CTbargraphDisplayBlank
                   2624: ###########################################################
                   2625: ###########################################################
                   2626: ###########################################################
                   2627: proc CTbargraphDisplayBlank { barnum } {
                   2628:     global gBarGraph gCT gFile
                   2629:     set canvas $gBarGraph($barnum.canvas)
                   2630:     catch {$canvas.bubble$barnum.l configure -text ""}
                   2631: }
                   2632: ###########################################################
                   2633: # CTbargraphDisplayMove
                   2634: ###########################################################
                   2635: ###########################################################
                   2636: ###########################################################
                   2637: proc CTbargraphDisplayMove { barnum } {
                   2638:     global gBarGraph gCT gFile
                   2639:     set canvas $gBarGraph($barnum.canvas)
                   2640:     catch {wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]]}
                   2641:     if {[$canvas gettags current] == ""} {CTbargraphDisplayRemove $barnum}
                   2642: }
                   2643: ###########################################################
                   2644: # CTbargraphDisplayShowresponse
                   2645: ###########################################################
                   2646: ###########################################################
                   2647: ###########################################################
                   2648: proc CTbargraphDisplayShowresponse { barnum } {
                   2649:     global gBarGraph gCT gFile
                   2650:     set num $gBarGraph($barnum.num)
                   2651:     set canvas $gBarGraph($barnum.canvas)
                   2652:     
1.14      albertel 2653:     set tags [split [lindex [$canvas gettags current] 0] .]
                   2654:     set high [lindex $tags 1]
                   2655:     set subpoint [lindex $tags 3]
1.1       albertel 2656:     foreach datum $gBarGraph($barnum) {
                   2657: 	set bar [lindex $datum 1]
                   2658: 	if { $bar != $high } { continue }
                   2659: 	if {![winfo exists $canvas.bubble$barnum.l]} {CTbargraphDisplayCreate $barnum}
1.14      albertel 2660: 	if { [llength [lindex $datum 0]] == 1 } {
                   2661: 	    $canvas.bubble$barnum.l configure -text "[lindex $datum 0] - \"[splitline [lindex $datum 2] 35]\""
                   2662: 	} else {
                   2663: 	    set point [lindex [lindex $datum 0] $subpoint]
                   2664: 	    set text [lindex [lindex $datum 2] $subpoint]
                   2665: 	    $canvas.bubble$barnum.l configure -text "$point - \"[splitline $text 35]\""
                   2666: 	}
1.1       albertel 2667: 	wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]]
                   2668: 	wm deiconify $canvas.bubble$barnum
                   2669: 	return
                   2670:     }
                   2671:     CTbargraphDisplayRemove $barnum
                   2672: }
                   2673: ###########################################################
                   2674: # CTbargraphDisplaySCP
                   2675: ###########################################################
                   2676: ###########################################################
                   2677: ###########################################################
                   2678: proc CTbargraphDisplaySCP { barnum } {
                   2679:     global gBarGraph gCT gFile
                   2680:     set num $gBarGraph($barnum.num)
                   2681:     set canvas $gBarGraph($barnum.canvas)
                   2682:     
                   2683:     set high [lindex [split [lindex [$canvas gettags current] 0] .] 1]
                   2684:     foreach datum $gBarGraph($barnum) {
                   2685: 	set bar [lindex $datum 1]
                   2686: 	if { $bar != $high } { continue }
                   2687: 	if {![winfo exists $canvas.bubble$barnum.l]} {CTbargraphDisplayCreate $barnum}
                   2688: 	$canvas.bubble$barnum.l configure -text "[lindex $datum 0]"
                   2689: 	wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]]
                   2690: 	wm deiconify $canvas.bubble$barnum
                   2691: 	return
                   2692:     }
                   2693:     CTbargraphDisplayRemove $barnum
                   2694: }
                   2695: 
                   2696: ###########################################################
                   2697: # CTbargraphClickSCP
                   2698: ###########################################################
                   2699: ###########################################################
                   2700: ###########################################################
                   2701: proc CTbargraphClickSCP { barnum } {
                   2702:     global gBarGraph gCT gFile
                   2703: 
                   2704:     set num $gBarGraph($barnum.num)
                   2705:     set canvas $gBarGraph($barnum.canvas)
                   2706:     set bucket $gBarGraph($barnum.bucketscores)
                   2707:     
                   2708:     set high [lindex [split [lindex [$canvas gettags current] 0] .] 1]
                   2709:     set low [lindex [split [lindex [$canvas gettags current] 0] .] 2]
                   2710:     set stunums ""
                   2711:     if { $high == "" || $low == "" } { return }
                   2712:     foreach datum $gBarGraph($barnum) {
                   2713: 	set bar [lindex $datum 1]
                   2714: 	if { $bar > $high || $bar <= $low } { continue }
                   2715: 	set stunums [concat $stunums [lindex $datum 2]]
                   2716:     }
                   2717:     if { $stunums == "" } { return }
                   2718:     if {"" == [set stuSCP [multipleChoice $gCT($num) "Select a student" $stunums 0]]} {
                   2719: 	return 
                   2720:     }
                   2721:     set loginAnalysis [expr {"Yes" == [makeSure "Do you wish to do a Login Analysis? It may take a while." ]}]
                   2722:     foreach s_id $stuSCP {
                   2723: 	CTstudentCourseProfile $num $s_id \
                   2724: 	    [findByStudentNumber $s_id $gFile($num)] $loginAnalysis
                   2725:     }
                   2726: }
                   2727: 
                   2728: ###########################################################
                   2729: # CTbargraphClickShowresponse
                   2730: ###########################################################
                   2731: ###########################################################
                   2732: ###########################################################
                   2733: proc CTbargraphClickShowresponse { barnum } {
                   2734:     global gBarGraph gCT gFile gUniqueNumber
                   2735: 
                   2736:     set num $gBarGraph($barnum.num)
                   2737:     set canvas $gBarGraph($barnum.canvas)
                   2738:     set bucket $gBarGraph($barnum.bucketscores)
                   2739:     
                   2740:     if { [catch {set datanum $gBarGraph($barnum.shownum1)}] } {
                   2741: 	set datanum [set gBarGraph($barnum.shownum1) [incr gUniqueNumber]]
                   2742: 	set winnum [set gBarGraph($barnum.shownum2) [incr gUniqueNumber]]
                   2743:     } else {
                   2744: 	set winnum $gBarGraph($barnum.shownum2) 
                   2745:     }
                   2746:     set gCT($winnum) ""
                   2747:     set high [lindex [split [lindex [$canvas gettags current] 0] .] 1]
                   2748:     foreach datum $gBarGraph($barnum) {
                   2749: 	set bar [lindex $datum 1]
                   2750: 	if { $bar != $high } { continue }
                   2751: 	CTputs $datanum "[lindex $datum 0] responses \"[lindex $datum 2]\"\n"
                   2752:     }    
                   2753:     CToutput $winnum $datanum
                   2754: } 
                   2755: 
                   2756: ###########################################################
                   2757: # CTchangeBargraph
                   2758: ###########################################################
                   2759: ###########################################################
                   2760: ###########################################################
                   2761: proc CTchangeBargraph { window num } {
                   2762:     global gBarGraph
                   2763:     
                   2764:     set change [toplevel $window.changeBarGraph$num]
                   2765:     
                   2766:     set infoFrame [frame $change.info]
                   2767:     set buttonFrame [frame $change.button]
                   2768:     set title [frame $change.title]
                   2769:     set xlabel [frame $change.xlabel]
                   2770:     set ylabel [frame $change.ylabel]
                   2771:     set xoften [frame $change.xoften]
                   2772:     set yoften [frame $change.yoften]
1.14      albertel 2773:     set ymax   [frame $change.ymax]
1.1       albertel 2774:     set color [frame $change.color]
                   2775:     set bucket [frame $change.bucket]
                   2776:     set font [frame $change.font]
1.14      albertel 2777:     pack $infoFrame $buttonFrame $title $xlabel $ylabel $xoften $yoften $ymax \
                   2778: 	$color $bucket
1.1       albertel 2779:     pack configure $title $xlabel $ylabel $xoften $yoften -anchor e -expand 1 -fill both
                   2780:     button $buttonFrame.update -text Update -command "CTdrawBargraph $num"
                   2781:     bind $change <Return> "CTdrawBargraph $num"
                   2782:     button $buttonFrame.dismiss -text Dismiss -command "destroy $change"
                   2783:     pack $buttonFrame.update $buttonFrame.dismiss -side left
                   2784: 
                   2785:     foreach {frame label var
                   2786:     } "$title     {              Title} title 
                   2787:        $xlabel    {       X-Axis Label} xlabel 
                   2788:        $ylabel    {       Y-Axis Label} ylabel 
                   2789:        $xoften    {Increment on X-Axis} xoften 
1.14      albertel 2790:        $yoften    {Increment on Y-Axis} yoften
                   2791:        $ymax      {        Max Y-Value} ymax" {
1.1       albertel 2792: 	label $frame.label -text $label
                   2793: 	set entryFrame [frame $frame.entry]
                   2794: 	pack $frame.label $entryFrame -side left
                   2795: 	pack configure $entryFrame -expand 1 -fill both
                   2796: 	entry $entryFrame.entry -textvariable gBarGraph($num.$var) \
                   2797: 	    -xscrollcommand "$entryFrame.scroll set"
                   2798: 	scrollbar $entryFrame.scroll -orient h -command \
                   2799: 	    "$entryFrame.entry xview"
                   2800: 	pack $entryFrame.entry $entryFrame.scroll -fill x
                   2801:     }
                   2802: 
                   2803:     label $color.label -text "Color of Bars"
                   2804:     label $color.color -relief ridge -background $gBarGraph($num.color) \
                   2805: 	-text "        "
                   2806:     button $color.change -text "Change" -command "CTchangeBargraphColor $color $num"
                   2807:     pack $color.label $color.color $color.change -side left
                   2808:     
                   2809:     checkbutton $bucket.bucket -text "Bucket Scores" -variable \
1.14      albertel 2810: 	gBarGraph($num.bucketscores) -command "CTmaxBargraph $num;CTdrawBargraph $num"
1.1       albertel 2811:     pack $bucket.bucket
                   2812: }
                   2813: 
                   2814: ###########################################################
                   2815: # CTchangeBargraphColor
                   2816: ###########################################################
                   2817: ###########################################################
                   2818: ###########################################################
                   2819: proc CTchangeBargraphColor { color num } {
                   2820:     global gBarGraph
                   2821:     set temp [tk_chooseColor -initialcolor $gBarGraph($num.color)]
                   2822:     if { $temp != "" } {
                   2823: 	$color.color configure -background [set gBarGraph($num.color) $temp]
                   2824:     }
                   2825:     CTdrawBargraph $num
                   2826: }
                   2827: 
                   2828: ###########################################################
                   2829: # CTdisplayStudent
                   2830: ###########################################################
                   2831: ###########################################################
                   2832: ###########################################################
                   2833: proc CTdisplayStudent { num window path id } {
                   2834:     
                   2835:     if { ![file exists [file join $path photo gif $id.gif]] } {
                   2836: 	if { [file exists [file join $path photo jpg $id.jpg]] } {
                   2837: 	    exec /usr/local/bin/djpeg -outfile [file join $path photo gif $id.gif] \
                   2838: 		[file join $path photo jpg $id.jpg]
                   2839: 	} else {
                   2840: 	    return
                   2841: 	}
                   2842:     }
                   2843:     set image [image create photo]
                   2844:     $image read [file join $path photo gif $id.gif]
                   2845: 
                   2846:     set imageWin [toplevel $window.image$num]
                   2847:     
                   2848:     set buttonFrame [frame $imageWin.button]
                   2849:     set infoFrame [frame $imageWin.info]
                   2850:     set imageFrame [frame $imageWin.image]
                   2851:     pack $buttonFrame $infoFrame $imageFrame
                   2852: 
                   2853:     button $buttonFrame.dismiss -command "destroy $imageWin" -text Dismiss
                   2854:     pack $buttonFrame.dismiss
                   2855: 
                   2856:     label $infoFrame.label -text $id
                   2857:     pack $infoFrame.label
1.11      albertel 2858:     
                   2859:     set height [image height $image]
                   2860:     set width [image width $image]
                   2861:     set canvas [canvas $imageFrame.canvas -height $height -width $width]
1.1       albertel 2862:     pack $canvas
                   2863:     $canvas create image 1 1 -image $image -anchor nw
                   2864: }
                   2865: 
1.14      albertel 2866: proc updateDate { type cmdnum args } {
                   2867:     global gDateStart gDateEnd
                   2868:     switch $type {
                   2869: 	start { set gDateStart($cmdnum.text) [clock format $gDateStart($cmdnum) -format "%a %b %d %R %Y"] }
                   2870: 	end { set gDateEnd($cmdnum.text) [clock format $gDateEnd($cmdnum) -format "%a %b %d %R %Y"] }
                   2871:     }
                   2872: }
                   2873: 
1.1       albertel 2874: ###########################################################
                   2875: # CTgetWhen
                   2876: ###########################################################
                   2877: ###########################################################
                   2878: ###########################################################
1.14      albertel 2879: proc CTgetWhen { num cmdnum setId } {
                   2880:     global gFile gCT gPromptGDR
                   2881: 
                   2882:     set firstsection [exec head [file join $gFile($num) records log$setId.db]]
                   2883:     append firstsection [exec head [file join $gFile($num) records weblog$setId.db]]
                   2884:     set lastsection [exec tail [file join $gFile($num) records log$setId.db]]
                   2885:     append lastsection [exec tail [file join $gFile($num) records weblog$setId.db]]
                   2886: 
                   2887:     set earliest -1
                   2888:     foreach line [split $firstsection \n] {
                   2889: 	if { [catch {set date [clock scan [string range $line 10 33]]}]} {set date -1}
                   2890: 	#puts "$date $earliest"
                   2891: 	if { $earliest == -1 } { set earliest $date }
                   2892: 	if { $date < $earliest } { set earliest $date }
                   2893:     }
                   2894:     if { $earliest == -1 } { 
                   2895: 	file stat [file join $gFile($num) records log$setId.db] stat
                   2896: 	set earliest $stat(ctime)
                   2897:     }
                   2898: 
                   2899:     set latest 0 
                   2900:     foreach line [split $lastsection \n] {
                   2901: 	if { [catch {set date [clock scan [string range $line 10 33]]}]} {set date 0}
                   2902: 	#puts "$date $latest"
                   2903: 	if { $latest == 0 } { set latest $date }
                   2904: 	if { $date > $latest } { set latest $date }
                   2905:     }
                   2906:     if { $latest == 0 } { 
                   2907: 	file stat [file join $gFile($num) records log$setId.db] stat
                   2908: 	set latest $stat(mtime)
                   2909:     }
                   2910:     #puts "$latest $earliest"
                   2911: 
                   2912:     set window $gCT($num)
                   2913:     set setWin [toplevel $window.setselect]
                   2914:     
                   2915:     set msgFrame [frame $setWin.msgFrame]
                   2916:     set valFrame [frame $setWin.calFrame]
                   2917:     set buttonFrame [frame $setWin.buttonFrame]
                   2918:     pack $msgFrame $valFrame $buttonFrame
                   2919: 
                   2920:     message $msgFrame.msg -text "Please select a date range:" -aspect 1000
                   2921:     pack $msgFrame.msg
                   2922:     
                   2923:     global gDateStart gDateEnd
                   2924:     trace variable gDateStart($cmdnum) w "updateDate start $cmdnum"
                   2925:     trace variable gDateEnd($cmdnum) w "updateDate end $cmdnum"
                   2926:     label $valFrame.l1 -textvariable gDateStart($cmdnum.text)
                   2927:     scale $valFrame.start -from $earliest -to $latest -variable gDateStart($cmdnum) -orient h -showvalue 0 -resolution 600 -bigincrement 6000 -length 300
                   2928:     label $valFrame.l2 -textvariable gDateEnd($cmdnum.text)
                   2929:     scale $valFrame.end -from $earliest -to $latest -variable gDateEnd($cmdnum) -orient h -showvalue 0 -resolution 600 -bigincrement 6000 -length 300
                   2930:     pack $valFrame.l1 $valFrame.start $valFrame.l2 $valFrame.end
                   2931: 
                   2932:     button $buttonFrame.select -text "Select" -command { set gPromptGDR(ok) 1 }
                   2933:     button $buttonFrame.cancel -text "Cancel" -command { set gPromptGDR(ok) 0 }
                   2934:     pack $buttonFrame.select $buttonFrame.cancel -side left
                   2935: 
                   2936:     bind $setWin <Return> "set gPromptGDR(ok) 1"
                   2937:     Centre_Dialog $setWin default
                   2938:     update idletasks
                   2939:     focus $setWin
                   2940:     capaRaise $setWin
                   2941:     capaGrab $setWin
                   2942:     vwait gPromptGDR(ok)
                   2943:     capaGrab release $setWin
                   2944:     destroy $setWin
                   2945:     if { $gPromptGDR(ok) == 1 } {
                   2946: 	set dateStart $gDateStart($cmdnum)
                   2947: 	set dateEnd $gDateEnd($cmdnum)
                   2948: 	if { $dateStart > $dateEnd } { 
                   2949: 	    set temp $dateStart
                   2950: 	    set dateStart $dateEnd
                   2951: 	    set dateEnd $temp 
                   2952: 	}
                   2953: 	unset gDateStart
                   2954: 	unset gDateEnd
                   2955: 	return [list $dateStart $dateEnd]
                   2956:     } else {
                   2957: 	unset gDateStart
                   2958: 	unset gDateEnd
                   2959: 	return ""
                   2960:     }
1.1       albertel 2961: }
                   2962: 
                   2963: ###########################################################
                   2964: # CTscanDB
                   2965: ###########################################################
                   2966: ###########################################################
                   2967: ###########################################################
                   2968: proc CTscanDB { num file outId startdate enddate } {
                   2969:     global answerArray exist
1.14      albertel 2970:     if {[catch {set fileId [open $file r]}]} { retun 0 }
1.1       albertel 2971:     set Yes_cnt 0 
                   2972:     set No_cnt 0
                   2973:     set line_cnt 0
                   2974:     set prob_cnt 0
                   2975:     set maxLine [lindex [exec wc $file] 0]
1.14      albertel 2976:     #puts "maxLine: $maxLine"
1.1       albertel 2977:     set aline [gets $fileId]
                   2978:     while { ! [eof $fileId] } {
                   2979: 	incr line_cnt
                   2980: 	if { ($line_cnt%20) == 0 } {
1.14      albertel 2981: 	    #puts $curdate
1.1       albertel 2982: 	    updateStatusBar [expr $line_cnt/double($maxLine)] $num
                   2983: 	}
                   2984: 	set length [llength $aline]
                   2985: 	set date [lrange $aline 1 [expr $length - 2]]
1.14      albertel 2986: 	#puts $date
1.1       albertel 2987: 	set curdate [clock scan $date]
                   2988: 	if { $curdate < $startdate } { set aline [gets $fileId]; continue }
                   2989: 	if { $curdate > $enddate } { break }
                   2990: 	set s_num [string toupper [lindex $aline 0]]
                   2991: 	set ans_char [split [lindex $aline end] ""]
                   2992: 	set usr_ans "$s_num.ans"
                   2993: 	set usr_try "$s_num.try"
                   2994: 	if {$prob_cnt == 0} { set prob_cnt [llength $ans_char] }
1.14      albertel 2995: 	if { [catch {set exist($s_num)}] } {
1.1       albertel 2996: 	    for {set ii 0} { $ii <= $prob_cnt } { incr ii} {
                   2997: 		set answerArray($usr_ans.$ii) "-"
                   2998: 		set answerArray($usr_try.$ii) 0
                   2999: 	    }
                   3000: 	}
                   3001: 	for {set ii 0} { $ii <= $prob_cnt } { incr ii} {
1.14      albertel 3002: 	    switch -- [lindex $ans_char $ii] {
                   3003: 		Y - y {
1.1       albertel 3004: 		    set answerArray($usr_ans.$ii) "Y"
1.14      albertel 3005: 		    incr answerArray($usr_try.$ii)    
1.1       albertel 3006: 		}
1.14      albertel 3007: 		N {
                   3008: 		    if {$answerArray($usr_ans.$ii) != "Y"} {
                   3009: 			set answerArray($usr_ans.$ii) "N"
                   3010: 		    }
                   3011: 		    incr answerArray($usr_try.$ii)
                   3012: 		}
                   3013: 		default {}
1.1       albertel 3014: 	    }
                   3015: 	}
1.14      albertel 3016: 	if { [array names exist $s_num] == "" } { set exist($s_num) 1 }
1.1       albertel 3017: 	set aline [gets $fileId]
                   3018:     }
                   3019:     close $fileId
                   3020:     return $prob_cnt
                   3021: }
                   3022: 
                   3023: ###########################################################
                   3024: # CTcreateSubset
                   3025: ###########################################################
                   3026: ###########################################################
                   3027: ###########################################################
1.14      albertel 3028: proc CTcreateSubset { num cmdnum startdate enddate setId } {
1.1       albertel 3029:     global gFile gCT answerArray exist
                   3030: 
                   3031:     set outId [open [file join $gFile($num) records "subset$setId.db"] w]
                   3032:     set inId [open [file join $gFile($num) records "set$setId.db"] r]
                   3033:     
1.14      albertel 3034:     #puts $startdate:$enddate
                   3035:     #puts [file join $gFile($num) records log$setId.db]
                   3036:     updateStatusMessage "Genearting subset1.db from telnet data." $cmdnum
1.1       albertel 3037:     set prob_cntt [CTscanDB $cmdnum [file join $gFile($num) records log$setId.db] $outId $startdate $enddate]
1.14      albertel 3038:     #puts $prob_cntt
                   3039:     #puts $startdate:$enddate
                   3040:     updateStatusMessage "Genearting subset1.db from web data." $cmdnum
1.1       albertel 3041:     set prob_cntw [CTscanDB $cmdnum [file join $gFile($num) records weblog$setId.db] $outId $startdate $enddate]
1.14      albertel 3042:     #puts $prob_cntw
                   3043:     #puts $startdate:$enddate
                   3044: #    puts "$day 12:00 AM : $day 11:59 PM"
1.1       albertel 3045:     if { $prob_cntt > $prob_cntw } {
                   3046: 	set prob_cnt $prob_cntt 
                   3047:     } else { 
                   3048: 	set prob_cnt $prob_cntw 
                   3049:     }
                   3050: 
                   3051:     puts $outId [gets $inId]
                   3052:     puts $outId [gets $inId]
                   3053:     puts $outId [gets $inId]
                   3054:     foreach s_num [lsort [array names exist]] {
                   3055: 	set usr_ans $s_num.ans
                   3056: 	set usr_try $s_num.try
                   3057: 	puts -nonewline $outId "$s_num "
                   3058: 	for { set ii 0 } { $ii< $prob_cnt } { incr ii } {
                   3059: 	    puts -nonewline $outId $answerArray($usr_ans.$ii)
                   3060: 	}
                   3061: 	for { set ii 0 } { $ii< $prob_cnt } { incr ii } {
                   3062: 	    puts -nonewline $outId [format ",%2d" $answerArray($usr_try.$ii)]
                   3063: 	}
                   3064: 	puts $outId ""
                   3065:     }
                   3066:     close $outId
                   3067:     close $inId
                   3068:     catch {unset answerArray}
                   3069:     catch {unset exist}
                   3070: }
1.2       albertel 3071: 
                   3072: ###########################################################
                   3073: # CTdiscussForum
                   3074: ###########################################################
                   3075: ###########################################################
                   3076: ###########################################################
1.3       albertel 3077: proc CTdiscussForum { num file dir resultVar {specificSet 0}} {
                   3078:     global gCT
                   3079:     upvar $resultVar result
1.2       albertel 3080: 
1.3       albertel 3081:     if { $specificSet == 0 } {
                   3082: 	set start 1
                   3083:     } else {
                   3084: 	set start $specificSet
                   3085:     }
1.2       albertel 3086:     set fileId [open $file r]
                   3087:     set maxLine [lindex [exec wc $file] 0]
                   3088:     set aline [gets $fileId]
                   3089:     set last 0
                   3090:     set line_cnt 0
                   3091:     while {![eof $fileId]} {
                   3092: 	incr line_cnt
                   3093: 	if { ($line_cnt%20) == 0 } { updateStatusBar [expr $line_cnt/double($maxLine)] $num }
1.11      albertel 3094: 	foreach {stunum capaid name email action set prob date time blank} [split $aline "|"] {}
1.3       albertel 3095: 	if {$specificSet && ($specificSet == $set)} {set aline [gets $fileId];continue}
1.2       albertel 3096: 	if { $action == "ViewProblem" } {
                   3097: 	    if { [catch {incr count($set,$prob)}]} {
                   3098: 		set count($set,$prob) 1
                   3099: 		if { $set > $last } { set last $set }
                   3100: 		if { [catch {set max($set)}]} { set max($set) 0 }
                   3101: 		if { $prob > $max($set)} { set max($set) $prob }
                   3102: 		if { [catch {set posts($set,$prob) [llength [glob $dir/discussion/$set/[format "%06d" $prob]-*-*-*.msg]]}]} { set posts($set,$prob) 0 }
                   3103: 	    }
                   3104: 	    set ever($name) 1
                   3105: 	    set names($set,$name) 1
                   3106: 	    set nameprob($set,$prob,$name) 1
                   3107: 	}
                   3108: 	set aline [gets $fileId]
                   3109:     }
                   3110: 
1.3       albertel 3111:     updateStatusMessage "Summarizing Data" $num
1.2       albertel 3112:     updateStatusBar 0 $num
                   3113:     for {set i 1} { $i <= $last } { incr i } {
                   3114: 	updateStatusBar [expr $i/$last] $num 
                   3115: 	set total($i) 0
1.3       albertel 3116: 	for {set j 1} { $j <= $max($i) } { incr j } {
1.2       albertel 3117: 	    set message ""
1.3       albertel 3118: 	    if {[catch { set result($num.$i.$j.posts) $posts($i,$j) }]} {
                   3119: 		set result($num.$i.$j.posts) 0
                   3120: 	    }
                   3121: 	    if {[catch {set result($num.$i.$j.views) $count($i,$j)}]} {
                   3122: 		set result($num.$i.$j.views) 0
                   3123: 	    } 
                   3124: 	    catch {incr total($i) $count($i,$j)}
                   3125: 	    if { [catch { set result($num.$i.$j.ratio) \
                   3126: 			      [expr $result($num.$i.$j.views)/double($result($num.$i.$j.posts))]} error]} {
                   3127: 		set result($num.$i.$j.ratio) 0.0
1.2       albertel 3128: 	    }
1.3       albertel 3129: 	    set result($num.$i.$j.viewers) [llength [array names nameprob $i,$j,*]]
1.2       albertel 3130: 	}
1.3       albertel 3131: 	set result($num.$i.views) $total($i)
                   3132: 	set result($num.$i.max) $max($i)
1.2       albertel 3133:     }
                   3134:     
1.3       albertel 3135:     for {set i 1} { $i<=$last } { incr i } {
                   3136: 	set result($num.$i.viewers) [llength [array names names $i,*]]
1.2       albertel 3137:     }
                   3138:     close $fileId
1.3       albertel 3139:     set result($num.viewers) [llength [array names ever]]
                   3140:     set result($num.last) $last
1.12      albertel 3141:     #IDEAS:
                   3142:     #     : how many views are repeats
1.2       albertel 3143:     #     : Student Course Profile, add #ViewProblems #Posts
                   3144:     #     : add some portion of these stats to analyze log files?
1.3       albertel 3145: }
                   3146: 
                   3147: ###########################################################
                   3148: # CTputsDiscussResults
                   3149: ###########################################################
                   3150: ###########################################################
                   3151: proc CTputsDiscussResults { num resultsVar } {
                   3152:     upvar $resultsVar result
                   3153:     for {set i 1} { $i <= $result($num.last) } { incr i } {
                   3154: 	CTputs $num "For Set $i #Visitors:$result($num.$i.viewers) did #views:$result($num.$i.views)\n"
                   3155:         CTputs $num "Prob# #Posts #Views Ratio #UniqueStu\n"
                   3156: 	CTputs $num "------------------------------------\n"  
                   3157: 	for {set j 1} { $j <= $result($num.$i.max)} { incr j } {
                   3158: 	    CTputs $num [format "%5d %6d %6d %5s %6d\n" $j \
                   3159: 			     $result($num.$i.$j.posts) $result($num.$i.$j.views) \
                   3160: 			     [if {$result($num.$i.$j.ratio) == 0.0} {set temp " "} \
                   3161: 				  {format %.1f $result($num.$i.$j.ratio)}] \
                   3162: 			     $result($num.$i.$j.viewers)]
                   3163: 	}
                   3164:     }
                   3165:     CTputs $num "Overall Unique #viewers: $result($num.viewers)\n"
1.6       albertel 3166: }
                   3167: 
                   3168: ###########################################################
                   3169: # CTcreateReportDialog
                   3170: ###########################################################
                   3171: ###########################################################
                   3172: ###########################################################
                   3173: proc CTcreateReportDialog { num cmdnum } {
                   3174:     global gCT gFile
                   3175: 
                   3176:     
                   3177:     set gCT(summary.section.$cmdnum) 1
                   3178:     set gCT(summary.set.$cmdnum) 1
                   3179: 
                   3180:     set summary [toplevel $gCT($num).summary]
                   3181:     set whoFrame [frame $summary.whoFrame -borderwidth 4 -relief groove]
                   3182:     set whichFrame [frame $summary.whichFrame -borderwidth 4 -relief groove]
                   3183:     set sortFrame [frame $summary.sortFrame]
                   3184:     set file2Frame [frame $summary.file2Frame]
                   3185:     set buttonFrame [frame $summary.buttonFrame]
                   3186:     pack $whoFrame $whichFrame $sortFrame $file2Frame $buttonFrame -side top
                   3187:     pack configure $whoFrame $whichFrame -padx 10 -pady 10
                   3188: 
                   3189:     set sectionFrame [frame $whoFrame.section]
                   3190:     set allFrame [frame $whoFrame.all]
                   3191:     pack $sectionFrame $allFrame -side top
                   3192: 
                   3193:     set gCT(summary.who.$cmdnum) section
                   3194: 
                   3195:     radiobutton $sectionFrame.section -text \
                   3196: 	    "For students in default section:" -variable gCT(summary.who.$cmdnum) \
                   3197: 	    -value section 
                   3198:     entry $sectionFrame.entry -textvariable gCT(summary.section.$cmdnum) -width 3 
                   3199:     pack $sectionFrame.section $sectionFrame.entry -side left
                   3200: 
                   3201:     radiobutton $allFrame.all -text "For all students in the class" \
                   3202: 	    -variable gCT(summary.who.$cmdnum) -value all 
                   3203:     pack $allFrame.all
                   3204: 
                   3205:     set sectionFrame [frame $whichFrame.section]
                   3206:     set allFrame [frame $whichFrame.all]
                   3207:     pack $sectionFrame $allFrame -side top
                   3208: 
                   3209:     set gCT(summary.which.$cmdnum) specific
                   3210: 
                   3211:     radiobutton $sectionFrame.section -text "For set:" \
                   3212: 	    -variable gCT(summary.which.$cmdnum) -value specific 
                   3213:     entry $sectionFrame.entry -textvariable gCT(summary.set.$cmdnum) -width 3 
                   3214:     pack $sectionFrame.section $sectionFrame.entry -side left
                   3215: 
                   3216:     radiobutton $allFrame.all -text "For all sets up to:" -variable \
                   3217: 	    gCT(summary.which.$cmdnum) -value upto 
                   3218:     entry $allFrame.entry -textvariable gCT(summary.set.$cmdnum) -width 3 
                   3219:     pack $allFrame.all $allFrame.entry -side left
                   3220: 
                   3221:     set firstFrame [frame $sortFrame.firstFrame -borderwidth 4 -relief groove]
                   3222:     set secondFrame [frame $sortFrame.secondFrame -borderwidth 4 \
                   3223: 	    -relief groove]
                   3224:     pack $firstFrame $secondFrame -side left
                   3225: 
                   3226:     set gCT(summary.first.$cmdnum) name
                   3227: 
                   3228:     label $firstFrame.label -text "Sorting Order - Primary"
                   3229:     radiobutton $firstFrame.name -text "Student Name" -variable \
                   3230: 	    gCT(summary.first.$cmdnum) -value name
                   3231:     radiobutton $firstFrame.number -text "Student Number" -variable \
                   3232: 	    gCT(summary.first.$cmdnum) -value number
                   3233:     radiobutton $firstFrame.section -text "Section" -variable \
                   3234: 	    gCT(summary.first.$cmdnum) -value section
                   3235:     radiobutton $firstFrame.grade -text "Grade" -variable gCT(summary.first.$cmdnum) \
                   3236: 	    -value grade
                   3237:     pack $firstFrame.label $firstFrame.name $firstFrame.number \
                   3238: 	    $firstFrame.section $firstFrame.grade -side top -anchor w
                   3239: 
                   3240:     set gCT(summary.second.$cmdnum) number
                   3241: 
                   3242:     label $secondFrame.label -text "Sorting Order - Secondary"
                   3243:     radiobutton $secondFrame.name -text "Student Name" -variable \
                   3244: 	    gCT(summary.second.$cmdnum) -value name
                   3245:     radiobutton $secondFrame.number -text "Student Number" -variable \
                   3246: 	    gCT(summary.second.$cmdnum) -value number
                   3247:     radiobutton $secondFrame.section -text "Section" -variable \
                   3248: 	    gCT(summary.second.$cmdnum) -value section
                   3249:     radiobutton $secondFrame.grade -text "Grade" -variable gCT(summary.second.$cmdnum) \
                   3250: 	    -value grade
                   3251:     pack $secondFrame.label $secondFrame.name $secondFrame.number \
                   3252: 	    $secondFrame.section $secondFrame.grade -side top -anchor w
                   3253: 
                   3254:     set defaultFrame [frame $file2Frame.defaultFrame]
                   3255:     set fileFrame [frame $file2Frame.fileFrame]
                   3256:     pack $defaultFrame $fileFrame -side top
                   3257: 
                   3258:     set gCT(summary.filename.$cmdnum) default 
                   3259: 
                   3260:     radiobutton $defaultFrame.default -text "Grader Chooses File Name" \
                   3261: 	-variable gCT(summary.filename.$cmdnum) -value default
                   3262:     pack $defaultFrame.default
                   3263: 
                   3264:     radiobutton $fileFrame.label -text "Specified Output File:" \
                   3265: 	-variable gCT(summary.filename.$cmdnum) -value specified
                   3266:     set entryFrame [frame $fileFrame.entryFrame]
                   3267:     button $fileFrame.select -text "Select File" \
1.7       albertel 3268: 	    -command "CTselectOutputFile $cmdnum"
1.6       albertel 3269:     pack $fileFrame.label $entryFrame $fileFrame.select -side left
                   3270:     entry $entryFrame.entry -textvariable gCT(summary.file.$cmdnum) \
                   3271: 	-xscrollcommand "$entryFrame.scroll set"
                   3272:     scrollbar $entryFrame.scroll -orient h -command \
                   3273: 	    "$entryFrame.entry xview"
                   3274:     pack $entryFrame.entry $entryFrame.scroll
                   3275:     pack configure $entryFrame.scroll -fill x
                   3276: 
                   3277:     button $buttonFrame.create -text "Create" -command \
                   3278: 	    "removeWindowEntry Summary
                   3279:              destroy $summary
                   3280:              CTcreateSummaryReport $num $cmdnum"
                   3281:     button $buttonFrame.cancel -text "Cancel" -command \
                   3282: 	    "removeWindowEntry Summary
                   3283:              destroy $summary"
                   3284:     pack $buttonFrame.create $buttonFrame.cancel -side left
                   3285: 
                   3286:     Centre_Dialog $summary default
                   3287: }
1.7       albertel 3288: 
                   3289: ###########################################################
                   3290: # CTselectOutputFile
                   3291: ###########################################################
                   3292: ###########################################################
                   3293: ###########################################################
                   3294: proc CTselectOutputFile { num } {
                   3295:     global gCT
                   3296:     set gCT(summary.filename.$num) specified
                   3297:     if { "" != [ set temp [tk_getSaveFile] ] } {set gCT(summary.file.$num) $temp}
                   3298: }    
1.6       albertel 3299: 
                   3300: ###########################################################
                   3301: # CTcreateSummaryReport
                   3302: ###########################################################
                   3303: ###########################################################
                   3304: ###########################################################
                   3305: proc CTcreateSummaryReport { num cmdnum } {
                   3306:     global gCT gFile
                   3307: 
                   3308:     displayStatus "Opening File" both $cmdnum
                   3309: 
                   3310:     switch $gCT(summary.who.$cmdnum) {
                   3311: 	all {
                   3312: 	    set file ClassSet$gCT(summary.set.$cmdnum).rpt
                   3313: 	}
                   3314: 	section	{
                   3315: 	    set file Sec$gCT(summary.section.$cmdnum)Set$gCT(summary.set.$cmdnum).rpt 
                   3316: 	}
                   3317: 	default	{
1.10      albertel 3318: 	    displayError "An error has occurred while creating a summary \
1.6       albertel 3319: 		    report $gCT(summary.section.$cmdnum)"
                   3320: 	    return
                   3321: 	}
                   3322:     }
                   3323: 
                   3324:     if { $gCT(summary.filename.$cmdnum) == "specified" } { 
                   3325: 	set file $gCT(summary.file.$cmdnum)
                   3326:     }
                   3327:     if { $file == "" } { 
                   3328: 	removeStatus
                   3329: 	displayError "Must specify a valid filename"
                   3330: 	return
                   3331:     }
                   3332:     updateStatusMessage "Creating Summary" $cmdnum
                   3333: 
                   3334:     set cwd [pwd]
                   3335:     cd $gFile($num)
                   3336:     set error [ catch {CTcreateSummary $file $cmdnum} ]
                   3337:     cd $cwd
                   3338: 
                   3339:     removeStatus $cmdnum
                   3340: 
1.9       albertel 3341:     if {!$error && "Yes" == [makeSure \
                   3342: 	       "Created summary file $file, would you like to see it?"]} {
1.6       albertel 3343: 	set fileId [open [file join $gFile($num) $file] r]
                   3344: 	CTputs $cmdnum [read $fileId]
                   3345: 	CToutput $num $cmdnum 
                   3346:     }
1.8       albertel 3347: }
                   3348: 
                   3349: ###########################################################
                   3350: # CTsetList
                   3351: ###########################################################
                   3352: ###########################################################
                   3353: ###########################################################
1.9       albertel 3354: proc CTsetList { file } {
1.8       albertel 3355:     set list ""
1.9       albertel 3356:     for { set i 0 } { $i < 100 } { incr i } {
                   3357: 	if { [file readable [file join $file records set$i.db]] } {
                   3358: 	    lappend list $i
                   3359: 	}
1.8       albertel 3360:     }
1.9       albertel 3361:     return $list
1.10      albertel 3362: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>