| 1 |
greg |
2.4 |
# 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 |
|
|
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 |
|
|
-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 |
|
|
} |
