Return to seating.tcl CVS log

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

Initial revision

    1: proc RSgetSeats { file } {
    2:     set seats ""
    3:     set fileId [open $file ]
    4:     while { 1 } {
    5: 	set line [gets $fileId]
    6: 	if { [eof $fileId] } { break }
    7: 	set location [string first " #" $line]
    8: 	incr location -1
    9: 	if { $location > 0 } { set line [string range $line 0 $location] }
   10: 	set line [string trim $line]
   11: 	lappend seats $line
   12:     }
   13:     return $seats
   14: }
   15: 
   16: proc RSprocessSeats { seats moveVar unmoveVar } {
   17:     upvar $moveVar move
   18:     upvar $unmoveVar unmove
   19:     set length [llength $seats]
   20:     for {set i 0} {$i < $length} {incr i} {
   21: 	set seat [lindex $seats $i]
   22: 	if { [set location [string first " !" $seat]] > 0 } {
   23: 	    incr location -1
   24: 	    set seat [string trim [string range $seat 0 $location] ]
   25: 	    set unmove($i) $seat
   26: 	} else {
   27: 	    lappend move $seat
   28: 	}
   29:     }
   30: }
   31: 
   32: proc RSdoAssignment { movable unmovableVar outputfile } {
   33:     upvar $unmovableVar unmovable
   34:     
   35:     set fileId [open $outputfile "w"]
   36:     set totallength [expr {[llength $movable] + [llength [array names unmovable]]}]
   37:     for { set i 0 } { $i < $totallength } { incr i } {
   38: 	if { [set which [lsearch [array names unmovable] $i]] != -1} {
   39: 	    set which [lindex [array names unmovable] $which]
   40: 	    set seat $unmovable($which)
   41: 	    unset unmovable($which)
   42: 	} else {
   43: 	    set which [expr int(rand() * [llength $movable])]
   44: 	    set seat [lindex $movable $which]
   45: 	    set movable [lreplace $movable $which $which]
   46: 	}
   47: 	puts $fileId $seat
   48:     }
   49:     close $fileId
   50: }
   51: 
   52: proc RSassign {file output seed} {
   53:     set move ""
   54:     expr srand($seed)
   55:     RSprocessSeats [RSgetSeats $file] move unmove
   56:     RSdoAssignment $move unmove $output
   57: }
   58: 
   59: proc RSopenFile { num which } {
   60:     global gRS
   61:     set gRS($num.$which) [tk_getOpenFile]
   62: }
   63: 
   64: proc RSsaveFile { num which } {
   65:     global gRS
   66:     set gRS($num.$which) [tk_getSaveFile]
   67: }
   68: 
   69: proc RSrun { num } {
   70:     global gRS
   71:     RSassign $gRS($num.file) $gRS($num.output) $gRS($num.seed)
   72:     displayMessage "Done"
   73: }
   74: 
   75: proc RSstart {num} {
   76:     global gRS
   77:     set gRS($num.file) ""
   78:     set gRS($num.output) ""
   79:     set gRS($num.seed) 100
   80: 
   81:     set window [toplevel .randomSeating$num]
   82: 
   83:     set infoFrame [frame $window.infoFrame]
   84:     set pathFrame [frame $window.pathFrame]
   85:     set seedFrame [frame $window.seedFrame]
   86:     set buttonFrame [frame $window.buttonFrame]
   87:     pack $infoFrame $pathFrame $seedFrame $buttonFrame
   88: 
   89:     set inputFrame [frame $pathFrame.inputFrame]
   90:     set outputFrame [frame $pathFrame.outputFrame]
   91:     pack $inputFrame $outputFrame
   92: 
   93:     label $inputFrame.label -text "Input File:"
   94:     set ientryFrame [frame $inputFrame.ientryFrame]
   95:     button $inputFrame.select -text "Select File" \
   96: 	-command "RSopenFile $num file"
   97:     pack $inputFrame.label $ientryFrame $inputFrame.select -side left
   98:     entry $ientryFrame.entry -textvariable gRS($num.file) \
   99: 	    -xscrollcommand "$ientryFrame.scroll set"
  100:     scrollbar $ientryFrame.scroll -orient h -command \
  101: 	    "$ientryFrame.entry xview"
  102:     pack $ientryFrame.entry $ientryFrame.scroll
  103:     pack configure $ientryFrame.scroll -fill x
  104: 
  105:     label $outputFrame.label -text "Output File:"
  106:     set oentryFrame [frame $outputFrame.oentryFrame]
  107:     button $outputFrame.select -text "Select File" \
  108: 	-command "RSsaveFile $num output"
  109:     pack $outputFrame.label $oentryFrame $outputFrame.select -side left
  110:     entry $oentryFrame.entry -textvariable gRS($num.output) \
  111: 	    -xscrollcommand "$oentryFrame.scroll set"
  112:     scrollbar $oentryFrame.scroll -orient h -command \
  113: 	    "$oentryFrame.entry xview"
  114:     pack $oentryFrame.entry $oentryFrame.scroll
  115:     pack configure $oentryFrame.scroll -fill x
  116: 
  117:     scale $seedFrame.seed -from 1 -to 30000 -variable gRS($num.seed) \
  118: 	-label "Random number seed" -orient h -length 300
  119:     pack $seedFrame.seed
  120: 
  121:     button $buttonFrame.assign -text Assign -command "RSrun $num"
  122:     button $buttonFrame.exit -text "Exit" -command \
  123: 	"unset gRS($num.file); unset gRS($num.output); unset gRS($num.seed); destroy $window"
  124:     pack $buttonFrame.assign $buttonFrame.exit -side left
  125: }