ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/util/do_scene3.6.tcl
Revision: 2.9
Committed: Fri May 17 13:53:04 1996 UTC (27 years, 10 months ago) by greg
Content type: application/x-tcl
Branch: MAIN
Changes since 2.8: +0 -5 lines
Log Message:
moved globbing patterns to trad.wsh main file

File Contents

# Content
1 # SCCSid "$SunId$ LBL"
2 #
3 # Track octree and scene files
4 #
5
6 proc newfent f { # add file to our list
7 global rifname radvar mybox myvar
8 set rd [file dirname $rifname]
9 if {[string first $rd $f] == 0} {
10 set f [string range $f [expr [string length $rd] + 1] end]
11 }
12 if {[lsearch -exact $radvar($myvar) $f] == -1} {
13 lappend radvar($myvar) $f
14 $mybox($myvar) insert end $f
15 $mybox($myvar) yview end
16 }
17 }
18
19 proc lbgetf nm { # get list box files
20 global myglob radvar mybox myvar curpat curmess
21 set myvar $nm
22 set oldnum [llength $radvar($nm)]
23 if [getfile -grab -perm -glob $myglob($nm) -view view_txt -send newfent] {
24 set curmess "Added [expr [llength $radvar($nm)] - $oldnum] entries."
25 } elseif {[llength $radvar($nm)] > $oldnum} {
26 set radvar($nm) [lreplace $radvar($nm) $oldnum end]
27 set curmess "Cancelled."
28 }
29 $mybox($nm) delete 0 end
30 eval $mybox($nm) insert end $radvar($nm)
31 set myglob($nm) $curpat
32 unset myvar
33 }
34
35 proc oct_delete {} { # delete octree file
36 global radvar curmess
37 if {"$radvar(OCTREE)" == {} || ! [file isfile $radvar(OCTREE)]} {
38 set curmess {No octree file.}
39 return
40 }
41 if [tk_dialog .dlg {Verification} \
42 "Really delete octree file $radvar(OCTREE)?" \
43 questhead 0 {Delete} {Cancel}] {
44 return 0
45 }
46 if [catch {exec rm $radvar(OCTREE) < /dev/null} curmess] {return 0}
47 set curmess {Octree file deleted.}
48 return 1
49 }
50
51 proc getdepend {} { # get object dependencies
52 global radvar curmess mybox
53 set curmess "Please wait..."
54 update
55 foreach newf [eval exec raddepend $radvar(illum) $radvar(scene)] {
56 if {[lsearch -exact $radvar(objects) $newf] < 0} {
57 lappend radvar(objects) $newf
58 }
59 }
60 $mybox(objects) delete 0 end
61 eval $mybox(objects) insert end $radvar(objects)
62 set curmess "Done."
63 }
64
65 proc vwselfil {} { # View selected file entries
66 global mybox
67 foreach n {materials illum scene objects} {
68 foreach sl [$mybox($n) curselection] {
69 lappend files [$mybox($n) get $sl]
70 }
71 }
72 view_txt $files
73 }
74
75 proc movselfil {n y} { # move selected files to new position
76 global radvar mybox curmess
77 set dl [delselfil]
78 if {"$dl" == {}} { # get it from another window
79 set dl [selection get]
80 set curmess "Pasted [llength $dl] entries."
81 } else {
82 set curmess "Moved [llength $dl] entries."
83 }
84 if [llength $dl] {
85 # The following should return "end" if past end, but doesn't!
86 set i [$mybox($n) nearest $y]
87 # So, we hack rather badly to discover the truth...
88 if {$i == [$mybox($n) size] - 1 && $y > 12 &&
89 [$mybox($n) nearest [expr $y - 12]] == $i} {
90 set i end
91 }
92 eval $mybox($n) insert $i $dl
93 if {"$i" == "end"} {
94 eval lappend radvar($n) $dl
95 } else {
96 set radvar($n) [eval linsert {$radvar($n)} $i $dl]
97 }
98 }
99 }
100
101 proc delselfil {} { # Delete selected file entries
102 global radvar mybox curmess
103 set dl {}
104 foreach n {materials illum scene objects} {
105 foreach sl [lsort -integer -decreasing [$mybox($n) curselection]] {
106 set i [lsearch -exact $radvar($n) [$mybox($n) get $sl]]
107 set dl "[lindex $radvar($n) $i] $dl"
108 set radvar($n) [lreplace $radvar($n) $i $i]
109 $mybox($n) delete $sl
110 }
111 }
112 set curmess "Discarded [llength $dl] entries."
113 return $dl
114 }
115
116 proc copyscene rf { # Copy scene data from specified RIF
117 global mybox radvar
118 load_vars [file tail $rf] {OCTREE materials illum scene objects}
119 foreach n {materials illum scene objects} {
120 $mybox($n) delete 0 end
121 eval $mybox($n) insert end $radvar($n)
122 }
123 }
124
125 proc do_scene w { # Create scene screen
126 global radvar mybox rifname
127 if {"$w" == "done"} {
128 unset mybox
129 return
130 }
131 set lbfont -*-courier-medium-r-normal--12-*-*-*-*-*-iso8859-1
132 frame $w
133 # Octree entry
134 label $w.octl -text Octree
135 place $w.octl -relwidth .1071 -relheight .0610 -relx .0714 -rely .0610
136 entry $w.oct -textvariable radvar(OCTREE) -relief sunken
137 place $w.oct -relwidth .5714 -relheight .0610 -relx .2143 -rely .0610
138 helplink $w.oct trad scene octree
139 button $w.odel -text Delete -relief raised -command oct_delete
140 place $w.odel -relwidth .1071 -relheight .0610 -relx .8000 -rely .0610
141 helplink $w.odel trad scene octdelete
142 # Materials listbox
143 button $w.matb -text Materials -relief raised \
144 -command "lbgetf materials"
145 set mybox(materials) $w.mat.lb
146 place $w.matb -relwidth .1200 -relheight .0610 -relx .0714 -rely .1463
147 frame $w.mat
148 scrollbar $w.mat.sb -relief sunken -command "$w.mat.lb yview"
149 listbox $w.mat.lb -relief sunken -yscroll "$w.mat.sb set" -font $lbfont
150 bind $w.mat.lb <Button-2> "movselfil materials %y"
151 pack $w.mat.sb -side right -fill y
152 pack $w.mat.lb -side left -expand yes -fill both
153 place $w.mat -relwidth .5714 -relheight .0976 -relx .2143 -rely .1463
154 eval $w.mat.lb insert end $radvar(materials)
155 helplink "$w.mat.lb $w.matb" trad scene materials
156 # Illum listbox
157 button $w.illb -text Illum -relief raised \
158 -command "lbgetf illum"
159 set mybox(illum) $w.ill.lb
160 place $w.illb -relwidth .1200 -relheight .0610 -relx .0714 -rely .2683
161 frame $w.ill
162 scrollbar $w.ill.sb -relief sunken -command "$w.ill.lb yview"
163 listbox $w.ill.lb -relief sunken -yscroll "$w.ill.sb set" -font $lbfont
164 bind $w.ill.lb <Button-2> "movselfil illum %y"
165 pack $w.ill.sb -side right -fill y
166 pack $w.ill.lb -side left -expand yes -fill both
167 place $w.ill -relwidth .5714 -relheight .0976 -relx .2143 -rely .2683
168 eval $w.ill.lb insert end $radvar(illum)
169 helplink "$w.ill.lb $w.illb" trad scene illum
170 # Scene listbox
171 button $w.sceb -text Scene -relief raised \
172 -command "lbgetf scene"
173 set mybox(scene) $w.sce.lb
174 place $w.sceb -relwidth .1200 -relheight .0610 -relx .0714 -rely .3902
175 frame $w.sce
176 scrollbar $w.sce.sb -relief sunken -command "$w.sce.lb yview"
177 listbox $w.sce.lb -relief sunken -yscroll "$w.sce.sb set" -font $lbfont
178 bind $w.sce.lb <Button-2> "movselfil scene %y"
179 pack $w.sce.sb -side right -fill y
180 pack $w.sce.lb -side left -expand yes -fill both
181 place $w.sce -relwidth .5714 -relheight .2683 -relx .2143 -rely .3902
182 eval $w.sce.lb insert end $radvar(scene)
183 helplink "$w.sce.lb $w.sceb" trad scene scene
184 # Objects listbox
185 button $w.objb -text Objects -relief raised \
186 -command "lbgetf objects"
187 set mybox(objects) $w.obj.lb
188 place $w.objb -relwidth .1200 -relheight .0610 -relx .0714 -rely .6829
189 frame $w.obj
190 scrollbar $w.obj.sb -relief sunken -command "$w.obj.lb yview"
191 listbox $w.obj.lb -relief sunken -yscroll "$w.obj.sb set" -font $lbfont
192 bind $w.obj.lb <Button-2> "movselfil objects %y"
193 pack $w.obj.sb -side right -fill y
194 pack $w.obj.lb -side left -expand yes -fill both
195 place $w.obj -relwidth .5714 -relheight .2683 -relx .2143 -rely .6829
196 eval $w.obj.lb insert end $radvar(objects)
197 button $w.autob -text Auto -relief raised -command getdepend
198 place $w.autob -relwidth .1200 -relheight .0610 -relx .0714 -rely .7927
199 helplink "$w.obj.lb $w.objb $w.autob" trad scene objects
200 # View button
201 button $w.vwb -text Edit -relief raised -command vwselfil
202 place $w.vwb -relwidth .1071 -relheight .0610 -relx .8214 -rely .4000
203 helplink $w.vwb trad scene edit
204 # Delete button
205 button $w.del -text Discard -relief raised -command delselfil
206 place $w.del -relwidth .1071 -relheight .0610 -relx .8214 -rely .5000
207 helplink $w.del trad scene discard
208 # Revert and Copy buttons
209 button $w.revert -text Revert -relief raised \
210 -command "copyscene $rifname"
211 place $w.revert -relwidth .1071 -relheight .0610 -relx .98 -rely .98 \
212 -anchor se
213 helplink $w.revert trad scene revert
214 button $w.copy -text Copy -relief raised -command {getfile -grab \
215 -send copyscene -view view_txt -glob $rif_glob}
216 place $w.copy -relwidth .1071 -relheight .0610 -relx .98 -rely .90 \
217 -anchor se
218 helplink $w.copy trad scene copy
219 }