# randomiz a seating chart file # 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 RSgetSeats { file } { set seats "" set fileId [open $file ] while { 1 } { set line [gets $fileId] if { [eof $fileId] } { break } set location [string first " #" $line] incr location -1 if { $location > 0 } { set line [string range $line 0 $location] } set line [string trim $line] lappend seats $line } return $seats } proc RSprocessSeats { seats moveVar unmoveVar } { upvar $moveVar move upvar $unmoveVar unmove set length [llength $seats] for {set i 0} {$i < $length} {incr i} { set seat [lindex $seats $i] if { [set location [string first " !" $seat]] > 0 } { incr location -1 set seat [string trim [string range $seat 0 $location] ] set unmove($i) $seat } else { lappend move $seat } } } proc RSdoAssignment { movable unmovableVar outputfile } { upvar $unmovableVar unmovable set fileId [open $outputfile "w"] set totallength [expr {[llength $movable] + [llength [array names unmovable]]}] for { set i 0 } { $i < $totallength } { incr i } { if { [set which [lsearch [array names unmovable] $i]] != -1} { set which [lindex [array names unmovable] $which] set seat $unmovable($which) unset unmovable($which) } else { set which [expr int(rand() * [llength $movable])] set seat [lindex $movable $which] set movable [lreplace $movable $which $which] } puts $fileId $seat } close $fileId } proc RSassign {file output seed} { set move "" expr srand($seed) RSprocessSeats [RSgetSeats $file] move unmove RSdoAssignment $move unmove $output } proc RSopenFile { num which } { global gRS set gRS($num.$which) [tk_getOpenFile] } proc RSsaveFile { num which } { global gRS set gRS($num.$which) [tk_getSaveFile] } proc RSrun { num } { global gRS RSassign $gRS($num.file) $gRS($num.output) $gRS($num.seed) displayMessage "Done" } proc RSstart {num} { global gRS set gRS($num.file) "" set gRS($num.output) "" set gRS($num.seed) 100 set window [toplevel .randomSeating$num] set infoFrame [frame $window.infoFrame] set pathFrame [frame $window.pathFrame] set seedFrame [frame $window.seedFrame] set buttonFrame [frame $window.buttonFrame] pack $infoFrame $pathFrame $seedFrame $buttonFrame set inputFrame [frame $pathFrame.inputFrame] set outputFrame [frame $pathFrame.outputFrame] pack $inputFrame $outputFrame label $inputFrame.label -text "Input File:" set ientryFrame [frame $inputFrame.ientryFrame] button $inputFrame.select -text "Select File" \ -command "RSopenFile $num file" pack $inputFrame.label $ientryFrame $inputFrame.select -side left entry $ientryFrame.entry -textvariable gRS($num.file) \ -xscrollcommand "$ientryFrame.scroll set" scrollbar $ientryFrame.scroll -orient h -command \ "$ientryFrame.entry xview" pack $ientryFrame.entry $ientryFrame.scroll pack configure $ientryFrame.scroll -fill x label $outputFrame.label -text "Output File:" set oentryFrame [frame $outputFrame.oentryFrame] button $outputFrame.select -text "Select File" \ -command "RSsaveFile $num output" pack $outputFrame.label $oentryFrame $outputFrame.select -side left entry $oentryFrame.entry -textvariable gRS($num.output) \ -xscrollcommand "$oentryFrame.scroll set" scrollbar $oentryFrame.scroll -orient h -command \ "$oentryFrame.entry xview" pack $oentryFrame.entry $oentryFrame.scroll pack configure $oentryFrame.scroll -fill x scale $seedFrame.seed -from 1 -to 30000 -variable gRS($num.seed) \ -label "Random number seed" -orient h -length 300 pack $seedFrame.seed button $buttonFrame.assign -text Assign -command "RSrun $num" button $buttonFrame.exit -text "Exit" -command \ "unset gRS($num.file); unset gRS($num.output); unset gRS($num.seed); destroy $window" pack $buttonFrame.assign $buttonFrame.exit -side left }