Return to createof5.tcl CVS log

Up to [LON-CAPA] / capa / capa51 / GUITools / ideas / of5tool

Annotation of capa/capa51/GUITools/ideas/of5tool/createof5.tcl, revision 1.3

1.2       albertel    1: # tool to creat 1 out of N style questions
                      2: #  Copyright (C) 1992-2000 Michigan State University
                      3: #
                      4: #  The CAPA system is free software; you can redistribute it and/or
1.3     ! albertel    5: #  modify it under the terms of the GNU General Public License as
1.2       albertel    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
1.3     ! albertel   12: #  General Public License for more details.
1.2       albertel   13: #
1.3     ! albertel   14: #  You should have received a copy of the GNU General Public
1.2       albertel   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: proc createMainWindow {} {
                     25:     global probList
                     26: 
                     27:     toplevel .main
                     28:     
                     29:     set listFrame [ frame .main.listFrame ]
                     30:     set buttonFrame1 [ frame .main.buttonFrame1 ]
                     31:     set buttonFrame2 [ frame .main.buttonFrame2 ]
                     32:     pack $listFrame $buttonFrame1 $buttonFrame2 -side top
                     33: 
                     34:     set probList [ listbox $listFrame.list \
                     35: 		       -yscrollcommand "$listFrame.scroll set" \
                     36: 		       -width 80 -height 30 ]
                     37:     scrollbar $listFrame.scroll \
                     38:                 -command "$listFrame.list yview" \
                     39:                 -orient v
                     40:     pack $probList $listFrame.scroll -side left
                     41:     pack configure $listFrame.scroll -fill y
                     42: 
                     43:     button $buttonFrame1.quit -text "Quit" -command exitProgram
                     44:     button $buttonFrame1.newQuest -text "New Question" -command addQuestion
                     45:     button $buttonFrame1.editQuest -text "Edit Question" -command editQuestion
                     46:     button $buttonFrame1.delQuest -text "Delete Question" -command delQuestion
                     47:     button $buttonFrame1.moveQuest -text "Move Question" -command moveQuestion
                     48:     pack $buttonFrame1.quit $buttonFrame1.newQuest $buttonFrame1.editQuest \
                     49: 	$buttonFrame1.delQuest $buttonFrame1.moveQuest -side left
                     50: 
                     51:     button $buttonFrame2.save -text "Save" -command save
                     52:     button $buttonFrame2.export -text "Create .qz" -command export
                     53:     button $buttonFrame2.load -text "Load" -command load
                     54:     pack $buttonFrame2.save $buttonFrame2.export $buttonFrame2.load -side left
                     55:     
                     56: }
                     57: 
                     58: proc addQuestion {} {
                     59:     global probList problem
                     60: 
                     61:     if { $problem(adding) == 1 || $problem(editing) == 1 } {
                     62: 	return
                     63:     }
                     64: 
                     65:     set problem(adding) 1
                     66:     incr problem(num)
                     67:     
                     68:     set problemType [toplevel .problemType]
                     69:     
                     70:     label $problemType.label -text "Select a Type of Problem:"
                     71:     button $problemType.multipleChoice -text "Multiple Choice" \
                     72: 	-command " 
                     73: 	    destroy .problemType 
                     74: 	    MCadd
                     75: 	"
                     76:     pack $problemType.label $problemType.multipleChoice
                     77: }
                     78: 
                     79: proc updateProblemList { probnum } {
                     80:     global problem probList
                     81: 
                     82:     set numProbs [$probList size]
                     83:     
                     84:     if { $numProbs < $probnum } {
                     85:     } else {
                     86: 	$probList delete [ expr $probnum - 1 ]
                     87:     }
                     88:     
                     89:     set quest [string range $problem(prob.$probnum.quest) 0 40 ]
                     90:     set string "$probnum $problem(prob.$probnum.type) $quest"
                     91:     
                     92:     $probList insert [expr $probnum - 1] "$string"
                     93: }
                     94: 
                     95: proc editQuestion {} {
                     96:     global problem probList
                     97: 
                     98:     set probnum [$probList curselection]
                     99:     if { $probnum == "" } { return }
                    100:     #listboxes count from zero, we count from 1
                    101:     incr probnum 
                    102:     set problem(editing) $probnum
                    103: 
                    104:     switch $problem(prob.$probnum.type) {
                    105: 	"Multiple Choice" 
                    106: 	{
                    107: 	    MCadd
                    108: 	    for {set i 1 } { $i <= $problem(prob.$probnum.numleaf) } { incr i } {
                    109: 		MCupdateLeafList $i $probnum
                    110: 	    }
                    111: 	}
                    112: 	-
                    113: 	{
                    114: 	    tk_messageDialogue -icon error -type ok \
                    115: 		-message "Unable to edit questions of type $problem(prob.$probnum.type)"
                    116: 	}
                    117:     }
                    118: }
                    119: 
                    120: proc save {} {
                    121:     global problem
                    122:     
                    123:     set file [tk_getSaveFile -defaultextension .hack  \
                    124: 		  -filetypes {{{Hacked GUI Quizzer file} {.hack}}} ]
                    125:     if { $file == "" } { return }
                    126:     set fileid [open "$file" "w" ]
                    127:     foreach i [array names problem] {
                    128: 	puts $fileid "set problem($i) \"$problem($i)\""
                    129:     }
                    130:     close $fileid
                    131: }
                    132: 
                    133: proc load {} {
                    134:     global problem probList
                    135: 
                    136:     set file [tk_getOpenFile -defaultextension .hack \
                    137: 		  -filetypes {{{Hacked GUI Quizzer file} {.hack}}} ]
                    138:     if {$file == "" } { return }
                    139:     source $file
                    140:     
                    141:     $probList delete 0 end
                    142:     for { set i 1 } { $i <= $problem(num) } { incr i } {
                    143: 	updateProblemList $i
                    144:     }
                    145: }
                    146: 
                    147: proc exitProgram {} {
                    148:     global problem
                    149:     exit
                    150: }
                    151: 
                    152: wm withdraw .
                    153: set problem(num) 0
                    154: set problem(adding) 0
                    155: set problem(editing) 0
                    156: source "export.tcl"
                    157: source "multiplechoice.tcl"
                    158: MCinit
                    159: 
1.2       albertel  160: createMainWindow