ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/util/do_scene3.6.tcl
Revision: 2.2
Committed: Fri Oct 28 10:43:32 1994 UTC (29 years, 5 months ago) by greg
Content type: application/x-tcl
Branch: MAIN
Changes since 2.1: +5 -5 lines
Log Message:
fixed size defaults for smaller dispaly

File Contents

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