| 1 |
greg |
2.5 |
# RCSid: $Id: do_scene.tcl,v 2.4 2003/02/22 02:07:30 greg Exp $
|
| 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 |
|
|
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 |
greg |
2.2 |
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 |
|
|
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 |
greg |
2.5 |
-send copyscene -view view_txt -glob $myglob(rif)}
|
| 220 |
greg |
2.1 |
place $w.copy -relwidth .1071 -relheight .0610 -relx .98 -rely .90 \
|
| 221 |
|
|
-anchor se
|
| 222 |
|
|
helplink $w.copy trad scene copy
|
| 223 |
|
|
}
|
