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
}
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>