Return to createof5.tcl CVS log

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

- fixed license notices the reference the GNU GPL rather than the GNU LGPL

# tool to creat 1 out of N style questions
#  Copyright (C) 1992-2000 Michigan State University
#
#  The CAPA system is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License as
#  published by the Free Software Foundation; either version 2 of the
#  License, or (at your option) any later version.
#
#  The CAPA system is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#  General Public License for more details.
#
#  You should have received a copy of the GNU General Public
#  License along with the CAPA system; see the file COPYING.  If not,
#  write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
#  Boston, MA 02111-1307, USA.
#
#  As a special exception, you have permission to link this program
#  with the TtH/TtM library and distribute executables, as long as you
#  follow the requirements of the GNU GPL in regard to all of the
#  software in the executable aside from TtH/TtM.

proc createMainWindow {} {
    global probList

    toplevel .main
    
    set listFrame [ frame .main.listFrame ]
    set buttonFrame1 [ frame .main.buttonFrame1 ]
    set buttonFrame2 [ frame .main.buttonFrame2 ]
    pack $listFrame $buttonFrame1 $buttonFrame2 -side top

    set probList [ listbox $listFrame.list \
		       -yscrollcommand "$listFrame.scroll set" \
		       -width 80 -height 30 ]
    scrollbar $listFrame.scroll \
                -command "$listFrame.list yview" \
                -orient v
    pack $probList $listFrame.scroll -side left
    pack configure $listFrame.scroll -fill y

    button $buttonFrame1.quit -text "Quit" -command exitProgram
    button $buttonFrame1.newQuest -text "New Question" -command addQuestion
    button $buttonFrame1.editQuest -text "Edit Question" -command editQuestion
    button $buttonFrame1.delQuest -text "Delete Question" -command delQuestion
    button $buttonFrame1.moveQuest -text "Move Question" -command moveQuestion
    pack $buttonFrame1.quit $buttonFrame1.newQuest $buttonFrame1.editQuest \
	$buttonFrame1.delQuest $buttonFrame1.moveQuest -side left

    button $buttonFrame2.save -text "Save" -command save
    button $buttonFrame2.export -text "Create .qz" -command export
    button $buttonFrame2.load -text "Load" -command load
    pack $buttonFrame2.save $buttonFrame2.export $buttonFrame2.load -side left
    
}

proc addQuestion {} {
    global probList problem

    if { $problem(adding) == 1 || $problem(editing) == 1 } {
	return
    }

    set problem(adding) 1
    incr problem(num)
    
    set problemType [toplevel .problemType]
    
    label $problemType.label -text "Select a Type of Problem:"
    button $problemType.multipleChoice -text "Multiple Choice" \
	-command " 
	    destroy .problemType 
	    MCadd
	"
    pack $problemType.label $problemType.multipleChoice
}

proc updateProblemList { probnum } {
    global problem probList

    set numProbs [$probList size]
    
    if { $numProbs < $probnum } {
    } else {
	$probList delete [ expr $probnum - 1 ]
    }
    
    set quest [string range $problem(prob.$probnum.quest) 0 40 ]
    set string "$probnum $problem(prob.$probnum.type) $quest"
    
    $probList insert [expr $probnum - 1] "$string"
}

proc editQuestion {} {
    global problem probList

    set probnum [$probList curselection]
    if { $probnum == "" } { return }
    #listboxes count from zero, we count from 1
    incr probnum 
    set problem(editing) $probnum

    switch $problem(prob.$probnum.type) {
	"Multiple Choice" 
	{
	    MCadd
	    for {set i 1 } { $i <= $problem(prob.$probnum.numleaf) } { incr i } {
		MCupdateLeafList $i $probnum
	    }
	}
	-
	{
	    tk_messageDialogue -icon error -type ok \
		-message "Unable to edit questions of type $problem(prob.$probnum.type)"
	}
    }
}

proc save {} {
    global problem
    
    set file [tk_getSaveFile -defaultextension .hack  \
		  -filetypes {{{Hacked GUI Quizzer file} {.hack}}} ]
    if { $file == "" } { return }
    set fileid [open "$file" "w" ]
    foreach i [array names problem] {
	puts $fileid "set problem($i) \"$problem($i)\""
    }
    close $fileid
}

proc load {} {
    global problem probList

    set file [tk_getOpenFile -defaultextension .hack \
		  -filetypes {{{Hacked GUI Quizzer file} {.hack}}} ]
    if {$file == "" } { return }
    source $file
    
    $probList delete 0 end
    for { set i 1 } { $i <= $problem(num) } { incr i } {
	updateProblemList $i
    }
}

proc exitProgram {} {
    global problem
    exit
}

wm withdraw .
set problem(num) 0
set problem(adding) 0
set problem(editing) 0
source "export.tcl"
source "multiplechoice.tcl"
MCinit

createMainWindow