File:  [LON-CAPA] / capa / capa51 / GUITools / ideas / of5tool / createof5.tcl
Revision 1.2: download - view: text, annotated - select for diffs
Fri Jul 7 18:37:05 2000 UTC (24 years, 1 month ago) by albertel
Branches: MAIN
CVS tags: version5-1-2-first_release, HEAD
- added GPL notices

    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>