1 |
# RCSid: $Id$ |
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" \ |
150 |
-font $lbfont -selectmode extended |
151 |
bind $w.mat.lb <Button-2> "movselfil materials %y" |
152 |
pack $w.mat.sb -side right -fill y |
153 |
pack $w.mat.lb -side left -expand yes -fill both |
154 |
place $w.mat -relwidth .5714 -relheight .0976 -relx .2143 -rely .1463 |
155 |
eval $w.mat.lb insert end $radvar(materials) |
156 |
helplink "$w.mat.lb $w.matb" trad scene materials |
157 |
# Illum listbox |
158 |
button $w.illb -text Illum -relief raised \ |
159 |
-command "lbgetf illum" |
160 |
set mybox(illum) $w.ill.lb |
161 |
place $w.illb -relwidth .1200 -relheight .0610 -relx .0714 -rely .2683 |
162 |
frame $w.ill |
163 |
scrollbar $w.ill.sb -relief sunken -command "$w.ill.lb yview" |
164 |
listbox $w.ill.lb -relief sunken -yscroll "$w.ill.sb set" \ |
165 |
-font $lbfont -selectmode extended |
166 |
bind $w.ill.lb <Button-2> "movselfil illum %y" |
167 |
pack $w.ill.sb -side right -fill y |
168 |
pack $w.ill.lb -side left -expand yes -fill both |
169 |
place $w.ill -relwidth .5714 -relheight .0976 -relx .2143 -rely .2683 |
170 |
eval $w.ill.lb insert end $radvar(illum) |
171 |
helplink "$w.ill.lb $w.illb" trad scene illum |
172 |
# Scene listbox |
173 |
button $w.sceb -text Scene -relief raised \ |
174 |
-command "lbgetf scene" |
175 |
set mybox(scene) $w.sce.lb |
176 |
place $w.sceb -relwidth .1200 -relheight .0610 -relx .0714 -rely .3902 |
177 |
frame $w.sce |
178 |
scrollbar $w.sce.sb -relief sunken -command "$w.sce.lb yview" |
179 |
listbox $w.sce.lb -relief sunken -yscroll "$w.sce.sb set" \ |
180 |
-font $lbfont -selectmode extended |
181 |
bind $w.sce.lb <Button-2> "movselfil scene %y" |
182 |
pack $w.sce.sb -side right -fill y |
183 |
pack $w.sce.lb -side left -expand yes -fill both |
184 |
place $w.sce -relwidth .5714 -relheight .2683 -relx .2143 -rely .3902 |
185 |
eval $w.sce.lb insert end $radvar(scene) |
186 |
helplink "$w.sce.lb $w.sceb" trad scene scene |
187 |
# Objects listbox |
188 |
button $w.objb -text Objects -relief raised \ |
189 |
-command "lbgetf objects" |
190 |
set mybox(objects) $w.obj.lb |
191 |
place $w.objb -relwidth .1200 -relheight .0610 -relx .0714 -rely .6829 |
192 |
frame $w.obj |
193 |
scrollbar $w.obj.sb -relief sunken -command "$w.obj.lb yview" |
194 |
listbox $w.obj.lb -relief sunken -yscroll "$w.obj.sb set" \ |
195 |
-font $lbfont -selectmode extended |
196 |
bind $w.obj.lb <Button-2> "movselfil objects %y" |
197 |
pack $w.obj.sb -side right -fill y |
198 |
pack $w.obj.lb -side left -expand yes -fill both |
199 |
place $w.obj -relwidth .5714 -relheight .2683 -relx .2143 -rely .6829 |
200 |
eval $w.obj.lb insert end $radvar(objects) |
201 |
button $w.autob -text Auto -relief raised -command getdepend |
202 |
place $w.autob -relwidth .1200 -relheight .0610 -relx .0714 -rely .7927 |
203 |
helplink "$w.obj.lb $w.objb $w.autob" trad scene objects |
204 |
# View button |
205 |
button $w.vwb -text Edit -relief raised -command vwselfil |
206 |
place $w.vwb -relwidth .1071 -relheight .0610 -relx .8214 -rely .4000 |
207 |
helplink $w.vwb trad scene edit |
208 |
# Delete button |
209 |
button $w.del -text Discard -relief raised -command delselfil |
210 |
place $w.del -relwidth .1071 -relheight .0610 -relx .8214 -rely .5000 |
211 |
helplink $w.del trad scene discard |
212 |
# Revert and Copy buttons |
213 |
button $w.revert -text Revert -relief raised \ |
214 |
-command "copyscene $rifname" |
215 |
place $w.revert -relwidth .1071 -relheight .0610 -relx .98 -rely .98 \ |
216 |
-anchor se |
217 |
helplink $w.revert trad scene revert |
218 |
button $w.copy -text Copy -relief raised -command {getfile -grab \ |
219 |
-send copyscene -view view_txt -glob $rif_glob} |
220 |
place $w.copy -relwidth .1071 -relheight .0610 -relx .98 -rely .90 \ |
221 |
-anchor se |
222 |
helplink $w.copy trad scene copy |
223 |
} |