Annotation of capa/capa51/GUITools/seating.tcl, revision 1.2
1.2 ! albertel 1: # randomiz a seating chart file
! 2: # Copyright (C) 1992-2000 Michigan State University
! 3: #
! 4: # The CAPA system is free software; you can redistribute it and/or
! 5: # modify it under the terms of the GNU Library General Public License as
! 6: # published by the Free Software Foundation; either version 2 of the
! 7: # License, or (at your option) any later version.
! 8: #
! 9: # The CAPA system is distributed in the hope that it will be useful,
! 10: # but WITHOUT ANY WARRANTY; without even the implied warranty of
! 11: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
! 12: # Library General Public License for more details.
! 13: #
! 14: # You should have received a copy of the GNU Library General Public
! 15: # License along with the CAPA system; see the file COPYING. If not,
! 16: # write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
! 17: # Boston, MA 02111-1307, USA.
! 18: #
! 19: # As a special exception, you have permission to link this program
! 20: # with the TtH/TtM library and distribute executables, as long as you
! 21: # follow the requirements of the GNU GPL in regard to all of the
! 22: # software in the executable aside from TtH/TtM.
! 23:
1.1 albertel 24: proc RSgetSeats { file } {
25: set seats ""
26: set fileId [open $file ]
27: while { 1 } {
28: set line [gets $fileId]
29: if { [eof $fileId] } { break }
30: set location [string first " #" $line]
31: incr location -1
32: if { $location > 0 } { set line [string range $line 0 $location] }
33: set line [string trim $line]
34: lappend seats $line
35: }
36: return $seats
37: }
38:
39: proc RSprocessSeats { seats moveVar unmoveVar } {
40: upvar $moveVar move
41: upvar $unmoveVar unmove
42: set length [llength $seats]
43: for {set i 0} {$i < $length} {incr i} {
44: set seat [lindex $seats $i]
45: if { [set location [string first " !" $seat]] > 0 } {
46: incr location -1
47: set seat [string trim [string range $seat 0 $location] ]
48: set unmove($i) $seat
49: } else {
50: lappend move $seat
51: }
52: }
53: }
54:
55: proc RSdoAssignment { movable unmovableVar outputfile } {
56: upvar $unmovableVar unmovable
57:
58: set fileId [open $outputfile "w"]
59: set totallength [expr {[llength $movable] + [llength [array names unmovable]]}]
60: for { set i 0 } { $i < $totallength } { incr i } {
61: if { [set which [lsearch [array names unmovable] $i]] != -1} {
62: set which [lindex [array names unmovable] $which]
63: set seat $unmovable($which)
64: unset unmovable($which)
65: } else {
66: set which [expr int(rand() * [llength $movable])]
67: set seat [lindex $movable $which]
68: set movable [lreplace $movable $which $which]
69: }
70: puts $fileId $seat
71: }
72: close $fileId
73: }
74:
75: proc RSassign {file output seed} {
76: set move ""
77: expr srand($seed)
78: RSprocessSeats [RSgetSeats $file] move unmove
79: RSdoAssignment $move unmove $output
80: }
81:
82: proc RSopenFile { num which } {
83: global gRS
84: set gRS($num.$which) [tk_getOpenFile]
85: }
86:
87: proc RSsaveFile { num which } {
88: global gRS
89: set gRS($num.$which) [tk_getSaveFile]
90: }
91:
92: proc RSrun { num } {
93: global gRS
94: RSassign $gRS($num.file) $gRS($num.output) $gRS($num.seed)
95: displayMessage "Done"
96: }
97:
98: proc RSstart {num} {
99: global gRS
100: set gRS($num.file) ""
101: set gRS($num.output) ""
102: set gRS($num.seed) 100
103:
104: set window [toplevel .randomSeating$num]
105:
106: set infoFrame [frame $window.infoFrame]
107: set pathFrame [frame $window.pathFrame]
108: set seedFrame [frame $window.seedFrame]
109: set buttonFrame [frame $window.buttonFrame]
110: pack $infoFrame $pathFrame $seedFrame $buttonFrame
111:
112: set inputFrame [frame $pathFrame.inputFrame]
113: set outputFrame [frame $pathFrame.outputFrame]
114: pack $inputFrame $outputFrame
115:
116: label $inputFrame.label -text "Input File:"
117: set ientryFrame [frame $inputFrame.ientryFrame]
118: button $inputFrame.select -text "Select File" \
119: -command "RSopenFile $num file"
120: pack $inputFrame.label $ientryFrame $inputFrame.select -side left
121: entry $ientryFrame.entry -textvariable gRS($num.file) \
122: -xscrollcommand "$ientryFrame.scroll set"
123: scrollbar $ientryFrame.scroll -orient h -command \
124: "$ientryFrame.entry xview"
125: pack $ientryFrame.entry $ientryFrame.scroll
126: pack configure $ientryFrame.scroll -fill x
127:
128: label $outputFrame.label -text "Output File:"
129: set oentryFrame [frame $outputFrame.oentryFrame]
130: button $outputFrame.select -text "Select File" \
131: -command "RSsaveFile $num output"
132: pack $outputFrame.label $oentryFrame $outputFrame.select -side left
133: entry $oentryFrame.entry -textvariable gRS($num.output) \
134: -xscrollcommand "$oentryFrame.scroll set"
135: scrollbar $oentryFrame.scroll -orient h -command \
136: "$oentryFrame.entry xview"
137: pack $oentryFrame.entry $oentryFrame.scroll
138: pack configure $oentryFrame.scroll -fill x
139:
140: scale $seedFrame.seed -from 1 -to 30000 -variable gRS($num.seed) \
141: -label "Random number seed" -orient h -length 300
142: pack $seedFrame.seed
143:
144: button $buttonFrame.assign -text Assign -command "RSrun $num"
145: button $buttonFrame.exit -text "Exit" -command \
146: "unset gRS($num.file); unset gRS($num.output); unset gRS($num.seed); destroy $window"
147: pack $buttonFrame.assign $buttonFrame.exit -side left
148: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to seating.tcl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / GUITools