ViewVC Help
View File | Revision Log | Show Annotations | Download File | Root Listing
root/radiance/ray/src/util/do_scene3.6.tcl
Revision: 2.3
Committed: Fri Oct 28 11:10:16 1994 UTC (29 years, 5 months ago) by greg
Content type: application/x-tcl
Branch: MAIN
Changes since 2.2: +1 -1 lines
Log Message:
changed position of octree delete button

File Contents

# User Rev Content
1 greg 2.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 greg 2.3 place $w.odel -relwidth .1071 -relheight .0610 -relx .8000 -rely .0610
146 greg 2.1 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 greg 2.2 place $w.matb -relwidth .1200 -relheight .0610 -relx .0714 -rely .1463
152 greg 2.1 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 greg 2.2 place $w.illb -relwidth .1200 -relheight .0610 -relx .0714 -rely .2683
166 greg 2.1 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 greg 2.2 place $w.sceb -relwidth .1200 -relheight .0610 -relx .0714 -rely .3902
180 greg 2.1 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 greg 2.2 place $w.objb -relwidth .1200 -relheight .0610 -relx .0714 -rely .6829
194 greg 2.1 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 greg 2.2 place $w.autob -relwidth .1200 -relheight .0610 -relx .0714 -rely .7927
204 greg 2.1 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     }