ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/util/do_scene3.6.tcl
Revision: 2.10
Committed: Sat Feb 22 02:07:30 2003 UTC (21 years, 1 month ago) by greg
Content type: application/x-tcl
Branch: MAIN
CVS Tags: rad3R7P1, rad4R0, rad3R5, rad3R6, rad3R6P1, rad3R8, rad3R9, rad3R7P2
Changes since 2.9: +1 -1 lines
Log Message:
Changes and check-in for 3.5 release
Includes new source files and modifications not recorded for many years
See ray/doc/notes/ReleaseNotes for notes between 3.1 and 3.5 release

File Contents

# User Rev Content
1 greg 2.10 # RCSid: $Id$
2 greg 2.1 #
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 greg 2.4 if [getfile -grab -perm -glob $myglob($nm) -view view_txt -send newfent] {
24 greg 2.1 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 greg 2.8 if {"$radvar(OCTREE)" == {} || ! [file isfile $radvar(OCTREE)]} {
38 greg 2.1 set curmess {No octree file.}
39     return
40     }
41     if [tk_dialog .dlg {Verification} \
42     "Really delete octree file $radvar(OCTREE)?" \
43 greg 2.7 questhead 0 {Delete} {Cancel}] {
44 greg 2.1 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 greg 2.6 update
55 greg 2.1 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 greg 2.3 place $w.odel -relwidth .1071 -relheight .0610 -relx .8000 -rely .0610
141 greg 2.1 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 greg 2.2 place $w.matb -relwidth .1200 -relheight .0610 -relx .0714 -rely .1463
147 greg 2.1 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 greg 2.2 place $w.illb -relwidth .1200 -relheight .0610 -relx .0714 -rely .2683
161 greg 2.1 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 greg 2.2 place $w.sceb -relwidth .1200 -relheight .0610 -relx .0714 -rely .3902
175 greg 2.1 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 greg 2.2 place $w.objb -relwidth .1200 -relheight .0610 -relx .0714 -rely .6829
189 greg 2.1 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 greg 2.2 place $w.autob -relwidth .1200 -relheight .0610 -relx .0714 -rely .7927
199 greg 2.1 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 greg 2.4 button $w.copy -text Copy -relief raised -command {getfile -grab \
215 greg 2.1 -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     }