Return to seating.tcl CVS log

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

Annotation of capa/capa51/GUITools/seating.tcl, revision 1.1

1.1     ! albertel    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: }