Annotation of capa/capa51/GUITools/ideas/of5tool/createof5.tcl, revision 1.1
1.1 ! albertel 1: proc createMainWindow {} {
! 2: global probList
! 3:
! 4: toplevel .main
! 5:
! 6: set listFrame [ frame .main.listFrame ]
! 7: set buttonFrame1 [ frame .main.buttonFrame1 ]
! 8: set buttonFrame2 [ frame .main.buttonFrame2 ]
! 9: pack $listFrame $buttonFrame1 $buttonFrame2 -side top
! 10:
! 11: set probList [ listbox $listFrame.list \
! 12: -yscrollcommand "$listFrame.scroll set" \
! 13: -width 80 -height 30 ]
! 14: scrollbar $listFrame.scroll \
! 15: -command "$listFrame.list yview" \
! 16: -orient v
! 17: pack $probList $listFrame.scroll -side left
! 18: pack configure $listFrame.scroll -fill y
! 19:
! 20: button $buttonFrame1.quit -text "Quit" -command exitProgram
! 21: button $buttonFrame1.newQuest -text "New Question" -command addQuestion
! 22: button $buttonFrame1.editQuest -text "Edit Question" -command editQuestion
! 23: button $buttonFrame1.delQuest -text "Delete Question" -command delQuestion
! 24: button $buttonFrame1.moveQuest -text "Move Question" -command moveQuestion
! 25: pack $buttonFrame1.quit $buttonFrame1.newQuest $buttonFrame1.editQuest \
! 26: $buttonFrame1.delQuest $buttonFrame1.moveQuest -side left
! 27:
! 28: button $buttonFrame2.save -text "Save" -command save
! 29: button $buttonFrame2.export -text "Create .qz" -command export
! 30: button $buttonFrame2.load -text "Load" -command load
! 31: pack $buttonFrame2.save $buttonFrame2.export $buttonFrame2.load -side left
! 32:
! 33: }
! 34:
! 35: proc addQuestion {} {
! 36: global probList problem
! 37:
! 38: if { $problem(adding) == 1 || $problem(editing) == 1 } {
! 39: return
! 40: }
! 41:
! 42: set problem(adding) 1
! 43: incr problem(num)
! 44:
! 45: set problemType [toplevel .problemType]
! 46:
! 47: label $problemType.label -text "Select a Type of Problem:"
! 48: button $problemType.multipleChoice -text "Multiple Choice" \
! 49: -command "
! 50: destroy .problemType
! 51: MCadd
! 52: "
! 53: pack $problemType.label $problemType.multipleChoice
! 54: }
! 55:
! 56: proc updateProblemList { probnum } {
! 57: global problem probList
! 58:
! 59: set numProbs [$probList size]
! 60:
! 61: if { $numProbs < $probnum } {
! 62: } else {
! 63: $probList delete [ expr $probnum - 1 ]
! 64: }
! 65:
! 66: set quest [string range $problem(prob.$probnum.quest) 0 40 ]
! 67: set string "$probnum $problem(prob.$probnum.type) $quest"
! 68:
! 69: $probList insert [expr $probnum - 1] "$string"
! 70: }
! 71:
! 72: proc editQuestion {} {
! 73: global problem probList
! 74:
! 75: set probnum [$probList curselection]
! 76: if { $probnum == "" } { return }
! 77: #listboxes count from zero, we count from 1
! 78: incr probnum
! 79: set problem(editing) $probnum
! 80:
! 81: switch $problem(prob.$probnum.type) {
! 82: "Multiple Choice"
! 83: {
! 84: MCadd
! 85: for {set i 1 } { $i <= $problem(prob.$probnum.numleaf) } { incr i } {
! 86: MCupdateLeafList $i $probnum
! 87: }
! 88: }
! 89: -
! 90: {
! 91: tk_messageDialogue -icon error -type ok \
! 92: -message "Unable to edit questions of type $problem(prob.$probnum.type)"
! 93: }
! 94: }
! 95: }
! 96:
! 97: proc save {} {
! 98: global problem
! 99:
! 100: set file [tk_getSaveFile -defaultextension .hack \
! 101: -filetypes {{{Hacked GUI Quizzer file} {.hack}}} ]
! 102: if { $file == "" } { return }
! 103: set fileid [open "$file" "w" ]
! 104: foreach i [array names problem] {
! 105: puts $fileid "set problem($i) \"$problem($i)\""
! 106: }
! 107: close $fileid
! 108: }
! 109:
! 110: proc load {} {
! 111: global problem probList
! 112:
! 113: set file [tk_getOpenFile -defaultextension .hack \
! 114: -filetypes {{{Hacked GUI Quizzer file} {.hack}}} ]
! 115: if {$file == "" } { return }
! 116: source $file
! 117:
! 118: $probList delete 0 end
! 119: for { set i 1 } { $i <= $problem(num) } { incr i } {
! 120: updateProblemList $i
! 121: }
! 122: }
! 123:
! 124: proc exitProgram {} {
! 125: global problem
! 126: exit
! 127: }
! 128:
! 129: wm withdraw .
! 130: set problem(num) 0
! 131: set problem(adding) 0
! 132: set problem(editing) 0
! 133: source "export.tcl"
! 134: source "multiplechoice.tcl"
! 135: MCinit
! 136:
! 137: createMainWindow
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>