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 .8000 -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 |
} |