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
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:
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:
160: createMainWindow
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>