Return to multiplechoice.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

# program to allow adding and Deleting leaves from a 1 of N tool
#  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 MCinit {} {
    global problem

    set problem(MCeditleaf) 0
}

proc MCadd {} {
    global problem MCchoiceList
    
    set addMultiple [toplevel .mcaddMultiple]
    
    if { $problem(editing) == 0 } {
	set probnum $problem(num)
	set problem(prob.$problem(num).numleaf) 0
	set problem(prob.$problem(num).type) "Multiple Choice"
	set problem(prob.$problem(num).val) 1
    } else {
	set probnum $problem(editing)
    }

    set labelFrame [frame $addMultiple.labelFrame ]
    set probValFrame [frame $addMultiple.probValFrame ]
    set hintFrame [frame $addMultiple.hintFrame ]
    set explFrame [frame $addMultiple.explFrame ]
    set questFrame [frame $addMultiple.questFrame ]
    set listFrame [frame $addMultiple.listFrame ]
    set buttonFrame [frame $addMultiple.buttonFrame]
    pack $labelFrame $probValFrame $questFrame $hintFrame $explFrame \
	$listFrame $buttonFrame -side top
    pack config $probValFrame -anchor w

    label $labelFrame.probLabel -text "Problem $probnum"
    pack $labelFrame.probLabel

    label $probValFrame.label -text "Problem Value\n"
    scale $probValFrame.value -variable problem(prob.$probnum.val) -from 1 -to 9 -orient h
    pack $probValFrame.label $probValFrame.value -side left

    label $questFrame.label -text "Question:"
    entry $questFrame.entry -textvariable problem(prob.$probnum.quest) \
	-width 80 -xscrollcommand "$questFrame.scroll set"
    scrollbar $questFrame.scroll -command "$questFrame.entry xview" \
	-orient h
    pack $questFrame.label $questFrame.entry $questFrame.scroll -side top
    pack configure $questFrame.label -anchor w
    pack configure $questFrame.scroll -fill x

    label $hintFrame.label -text "Hint:"
    entry $hintFrame.entry -textvariable problem(prob.$probnum.hint) \
	-width 80 -xscrollcommand "$hintFrame.scroll set"
    scrollbar $hintFrame.scroll -command "$hintFrame.entry xview" \
	-orient h
    pack $hintFrame.label $hintFrame.entry $hintFrame.scroll -side top
    pack configure $hintFrame.label -anchor w
    pack configure $hintFrame.scroll -fill x

    label $explFrame.label -text "Explanation:"
    entry $explFrame.entry -textvariable problem(prob.$probnum.expl) \
	-width 80 -xscrollcommand "$explFrame.scroll set"
    scrollbar $explFrame.scroll -command "$explFrame.entry xview" \
	-orient h
    pack $explFrame.label $explFrame.entry $explFrame.scroll -side top
    pack configure $explFrame.label -anchor w
    pack configure $explFrame.scroll -fill x

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

    button $buttonFrame.leaf -text "Add leaf" -command MCaddLeaf
    button $buttonFrame.edit -text "Edit leaf" -command MCeditLeafOptions
    button $buttonFrame.done -text "Done" -command "
        if { [ MCcheckIfDone $probnum ] } {
	   destroy $addMultiple
	   set problem(adding) 0
           set problem(editing) 0
           set problem(editleaf) 0
           updateProblemList $probnum
        } else {
           tk_messageBox -icon error \
               -message "At least one leaf needs all options to be correct."
               -type ok
        }
    "
    button $buttonFrame.cancel -text "Cancel" -command "
	destroy $addMultiple
	incr problem(num) -1
	#(FIXME) unset possible set vars dealing with this problem
    "
    pack $buttonFrame.done $buttonFrame.leaf $buttonFrame.edit \
	$buttonFrame.cancel -side left
}

proc MCaddLeaf {} {
    global problem

    if { $problem(editing) == 0 } {
	set probnum $problem(num)
    } else {
	set probnum $problem(editing)
    }

    if { $problem(MCeditleaf) == 0 } { 
	set leaf [incr problem(prob.$probnum.numleaf)]
	set problem(prob.$probnum.leaf.$leaf.numoptions) 1
    } else {
	set leaf $problem(MCeditleaf)
    }

    set addLeaf [toplevel .mcaddleaf]
    
    set labelFrame [frame $addLeaf.label]
    set buttonFrame [frame $addLeaf.button]
    pack $labelFrame $buttonFrame -side top
    pack configure $buttonFrame -anchor s

    label $labelFrame.label -text "Adding options for leaf $leaf"
    pack $labelFrame.label -side top


    for { set i 1 } { $i <= $problem(prob.$probnum.leaf.$leaf.numoptions) } { incr i } {	
	set leafFrame [frame $addLeaf.frame$i]
	label $leafFrame.label -text "Leaf $leaf Option $i:"
	checkbutton $leafFrame.correct -text Correct -offvalue 2 \
	    -variable problem(prob.$probnum.leaf.$leaf.option.$i.correct)
	entry $leafFrame.entry \
	    -textvariable problem(prob.$probnum.leaf.$leaf.option.$i) \
	    -width 80 -xscrollcommand "$leafFrame.scroll set"
	scrollbar $leafFrame.scroll -command "$leafFrame.entry xview" \
	    -orient h
	pack $leafFrame -before $buttonFrame
	pack $leafFrame.label $leafFrame.correct $leafFrame.entry \
	    $leafFrame.scroll -side top -anchor w
	pack configure $leafFrame.scroll -fill x
    }

    button $buttonFrame.add -text "Add option" -command {
	if { $problem(editing) == 0 } { set probnum $problem(num)
	} else { set probnum $problem(editing) }
	
	if { $problem(MCeditleaf) == 0 } { set leaf $problem(prob.$probnum.numleaf)
	} else { set leaf $problem(MCeditleaf) }
	set optnum [incr problem(prob.$probnum.leaf.$leaf.numoptions)] 
	set leafFrame [frame .mcaddleaf.frame$optnum]
	pack $leafFrame -before .mcaddleaf.button

	label $leafFrame.label -text "Leaf $leaf Option $optnum:"
	checkbutton $leafFrame.correct -text Correct -offvalue 2 \
	    -variable problem(prob.$probnum.leaf.$leaf.option.$optnum.correct)
	entry $leafFrame.entry \
	    -textvariable problem(prob.$probnum.leaf.$leaf.option.$optnum) \
	    -width 80 -xscrollcommand "$leafFrame.scroll set"
	scrollbar $leafFrame.scroll \
	    -command "$leafFrame.entry xview" \
	    -orient h
	pack $leafFrame.label $leafFrame.correct $leafFrame.entry \
	    $leafFrame.scroll -side top -anchor w
	pack configure $leafFrame.scroll -fill x
    }
    button $buttonFrame.cancel -text "Cancel" -command "
	destroy $addLeaf
	#(FIXME) this needs to do alot more
    "
    button $buttonFrame.done -text "Done" \
	-command "
	          destroy .mcaddleaf
	          MCupdateLeafList $leaf $probnum 
                  set problem(MCeditleaf) 0"
    pack $buttonFrame.add $buttonFrame.cancel $buttonFrame.done -side left
}

proc MCcheckIfDone { probnum } {
    global problem

    set found 0
    for { set i 1 } { i <= $problem(prob.$probnum.numleaf } { incr i } {
	set found 1
	for { set j 1 } { j <= $problem(prob.$probnum.leaf.$i.numoptions) } { incr j } {
	    catch {
		if { $problem(prob.$probnum.leaf.$i.option.$j.correct) != 1 } {
		    set found 0
		}
	    }
	}
    }
    return $found
}


proc MCeditLeafOptions {} {
    global problem MCchoiceList

    set leaf [$MCchoiceList curselection]
    if { $leaf == "" } { return }
    incr leaf
    set problem(MCeditleaf) $leaf

    if { $problem(editing) == 0 } {
	set probnum $problem(num)
    } else {
	set probnum $problem(editing)
    }

    MCaddLeaf
}

proc MCupdateLeafList { leaf probnum } {
    global problem MCchoiceList

    set numLeafs [$MCchoiceList size]
    set numOpt $problem(prob.$probnum.leaf.$leaf.numoptions)

    if { $numLeafs < $leaf } {
    } else {
	$MCchoiceList delete  [ expr $leaf - 1 ]
    }

    set string "Leaf $leaf, $numOpt options"
    
    $MCchoiceList insert [ expr $leaf - 1 ] "$string"
}

proc MCexportHeader { fileid probnum } {
    global problem

    puts $fileid "//****************************"
    puts $fileid "/LET prob_val=$problem(prob.$probnum.val)"
    if { $problem(prob.$probnum.hint) != "" } {
	puts $fileid "/HIN $problem(prob.$probnum.hint)"
    } else {
	puts $fileid "//HIN No hint unless this line is uncommented and modified"
    }
    if { $problem(prob.$probnum.expl) != "" } {
	puts $fileid "/EXP $problem(prob.$probnum.expl)"
    } else {
	puts $fileid "//EXP No explanation unless this line is uncommented and modified"
    }
    puts $fileid "/IMP \"../Tools/Problem\#\""
    puts $fileid "$problem(prob.$probnum.quest)"
    puts $fileid "//----------------------------"
}

proc MCexportLeafs { fileid probnum } {
    global problem

    #(FIXME) need to put out same number of Opts?
    #(FIXME) extra char at begging of alphabet so as to get rid of the expr?
    set alphabet abcdefghijklmnopqrstuvwxyz

    for { set i 1 } { $i <= $problem(prob.$probnum.numleaf) } { incr i } {
	for { set j 1 } { $j <= $problem(prob.$probnum.leaf.$i.numoptions) } { incr j } {
	    set var ""
	    append var s $i [string index $alphabet [ expr $j - 1 ] ]
	    puts $fileid "/LET $var=\"$problem(prob.$probnum.leaf.$i.option.$j)\""
	}
	puts $fileid "/LET mix$i=random(1,$problem(prob.$probnum.leaf.$i.numoptions),1)"
	for { set j 1 } { $j <= $problem(prob.$probnum.leaf.$i.numoptions) } { incr j } {
	    set var ""
	    append var a $i [string index $alphabet [ expr $j - 1 ] ]
	    puts $fileid "/LET $var=$problem(prob.$probnum.leaf.$i.option.$j.correct)"
	}
	puts $fileid "//"
    }
    puts $fileid "//Nof5aux follows"
}

proc MCexportAns { fileid probnum } {
    global problem

    #(FIXME) need to put out same number of Opts?
    #(FIXME) extra char at begging of alphabet so as to get rid of the expr?
    set alphabet abcdefghijklmnopqrstuvwxyz
    set ALPHABET ABCDEFGHIJKLMNOPQRSTUVWXYZ

    for { set i 1 } { $i <= $problem(prob.$probnum.numleaf) } { incr i } {
	set questStr "/LET s$i=choose(mix$i"
	set ansStr "/LET a$i=choose(mix$i"
	for { set j 1 } { $j <= $problem(prob.$probnum.leaf.$i.numoptions) } { incr j } {
	    append questStr ",s$i"
	    append questStr [string index $alphabet [ expr $j - 1 ] ]
	    append ansStr ",a$i"
	    append ansStr [string index $alphabet [ expr $j - 1 ] ]
	}
	append questStr ")"
	append ansStr ")"
	puts $fileid "$questStr"
	puts $fileid "$ansStr"
    }    
    puts $fileid "/LET seed=random(1,300,1)"
    set line "/MAP(seed;"
    set end ";"
    for { set i 1 } { $i <= $problem(prob.$probnum.numleaf) } { incr i } {
	if { $i != $problem(prob.$probnum.numleaf) } {
	    append line "M$i,"
	    append end "s$i,"
	} else {
	    append line "M$i"
	    append end "s$i)"
	}
    }
    append line $end
    puts $fileid "$line"
    puts $fileid "/LET it=tex(\"\\item\[\] \",\"\")"
    puts $fileid "/DIS(tex(\"\\begin\{choicelist\}\",\"\"))"
    for { set i 1 } { $i <= $problem(prob.$probnum.numleaf) } { incr i } {
	puts $fileid "/DIS(it) [string index $ALPHABET [expr $i - 1] ]) /DIS (M$i)"
    }
    puts $fileid "/DIS(tex(\"\\end\{choicelist\}\",\"\"))"
    set line "/MAP(seed;"
    set end ";"
    for { set i 1 } { $i <= $problem(prob.$probnum.numleaf) } { incr i } {
	if { $i != $problem(prob.$probnum.numleaf) } {
	    append line "b$i,"
	    append end "a$i,"
	} else {
	    append line "b$i"
	    append end "a$i)"
	}
    }
    append line $end
    puts $fileid "$line"
    for { set i 1 } { $i <= $problem(prob.$probnum.numleaf) } { incr i } {
	puts $fileid "/LET NM$i=b$i*(b$i==1)+1"
    }
    for { set i 1 } { $i <= $problem(prob.$probnum.numleaf) } { incr i } {
	puts $fileid "/LET lett$i=choose(NM$i,\"\",\"[string index $ALPHABET [expr $i -1 ] ]\")"
    }
    set line "/LET Nof5right=lett1"
    for { set i 2 } { $i <= $problem(prob.$probnum.numleaf) } { incr i } {
	append line "+lett$i"
    }
    puts $fileid "$line"
    puts $fileid "//**************************"
    puts $fileid "/DIS(stdline)"
    puts $fileid "/ANS(Nof5right,wgt=prob_val,str=mc)"
    puts $fileid "//**************************"
}