1############################################################################# 2# Author: # 3# ------ # 4# Anton Kokalj Email: Tone.Kokalj@ijs.si # 5# Department of Physical and Organic Chemistry Phone: x 386 1 477 3523 # 6# Jozef Stefan Institute Fax: x 386 1 477 3811 # 7# Jamova 39, SI-1000 Ljubljana # 8# SLOVENIA # 9# # 10# Source: $XCRYSDEN_TOPDIR/Tcl/isoControl.tcl 11# ------ # 12# Copyright (c) 1996-2003 by Anton Kokalj # 13############################################################################# 14 15proc IsoControl_InitVar {} { 16 global isoControl prop isosurf 17 18 #--- 19 # default font for thermometer 20 set def_font [font create] 21 eval {font configure $def_font} [font actual fixed] 22 font configure $def_font -size [expr int([font actual fixed -size] * 1.5)] 23 #--- 24 25 if { ![info exists isoControl(cpl_basis)] } { 26 # this "if" is used in isoRender.tcl as an indication if 27 # IsoControl_InitVar was already called 28 set isoControl(cpl_basis) MONOCHROME 29 } 30 if { ![info exists isoControl(cpl_function)] } { 31 set isoControl(cpl_function) LINEAR 32 } 33 34 if { ![info exists isoControl(colorplane)] } {set isoControl(colorplane) 0} 35 if { ![info exists isoControl(isoline)] } {set isoControl(isoline) 0} 36 if { ![info exists isoControl(colorplane_lighting)] } {set isoControl(colorplane_lighting) 0} 37 if { ![info exists isoControl(cpl_transparency)] } {set isoControl(cpl_transparency) 0} 38 if { ![info exists isoControl(cpl_thermometer)] } {set isoControl(cpl_thermometer) 0} 39 if { ![info exists isoControl(cpl_thermoTplw)] } {set isoControl(cpl_thermoTplw) 0} 40 41 if { ![info exists isoControl(cpl_thermoFmt)] } {set isoControl(cpl_thermoFmt) %+8.4f} 42 if { ![info exists isoControl(cpl_thermoLabel)] } {set isoControl(cpl_thermoLabel) " Scale: [encoding convertfrom symbol D] n(r)"} 43 if { ![info exists isoControl(cpl_thermoNTics)] } {set isoControl(cpl_thermoNTics) 6} 44 if { ![info exists isoControl(cpl_thermoFont)] } {set isoControl(cpl_thermoFont) $def_font} 45 if { ![info exists isosurf(2Dexpand)] } { set isosurf(2Dexpand) none } 46 if { ![info exists isosurf(2Dexpand_X)] } { set isosurf(2Dexpand_X) 1 } 47 if { ![info exists isosurf(2Dexpand_Y)] } { set isosurf(2Dexpand_Y) 1 } 48 if { ![info exists isosurf(2Dexpand_Z)] } { set isosurf(2Dexpand_Z) 1 } 49 50 if { ![info exists isosurf(tessellation_type)] } { set isosurf(tessellation_type) cubes } 51 if { ![info exists isosurf(normals_type)] } { set isosurf(normals_type) gradient } 52 53 if { ![info exists isoControl(anim_step)] } { 54 set isoControl(anim_step) 1 55 } 56 if { ![info exists isoControl(time_delay)] } { 57 set isoControl(time_delay) 100 58 } 59 if { ![info exists isoControl(cbfn_apply_to_all)] } { 60 set isoControl(cbfn_apply_to_all) 0 61 } 62 if { ![info exists isoControl(disp_apply_to_all)] } { 63 set isoControl(disp_apply_to_all) 0 64 } 65 if { ![info exists isoControl(anim_apply_to_all)] } { 66 set isoControl(anim_apply_to_all) 0 67 } 68 # 69 # just in case 70 # 71 if { ![info exists isoControl(3Dinterpl_degree)] } { 72 set isoControl(3Dinterpl_degree) 1 73 } 74 75 set n $isoControl(3Dinterpl_degree) 76 if { ![info exists isoControl(1,nslide)] } { 77 set isoControl(1,nslide) \ 78 [expr ([lindex [xc_iso grid] 2] - 1) * $n + 1] 79 } 80 if { ![info exists isoControl(2,nslide)] } { 81 set isoControl(2,nslide) \ 82 [expr ([lindex [xc_iso grid] 1] - 1) * $n + 1] 83 } 84 if { ![info exists isoControl(3,nslide)] } { 85 set isoControl(3,nslide) \ 86 [expr ([lindex [xc_iso grid] 0] - 1) * $n + 1] 87 } 88 89 if { ![info exists isoControl(current_slide)] } { 90 set isoControl(current_slide) 1 91 set isoControl(current_text_slide) "Current slide: $isoControl(current_slide) / $isoControl(1,nslide)" 92 } 93 94 if { ![info exists isoControl(2Dlowvalue)] } { 95 set isoControl(2Dlowvalue) $isosurf(minvalue) 96 } 97 if { ![info exists isoControl(2Dhighvalue)] } { 98 set isoControl(2Dhighvalue) $isosurf(maxvalue) 99 } 100 if { ![info exists isoControl(2Dnisoline)] } { 101 set isoControl(2Dnisoline) 15 102 } 103 if { ![info exists isoControl(isoline_color)] } { 104 set isoControl(isoline_color) monocolor 105 } 106 if { ![info exists isoControl(isoline_width)] } { 107 set isoControl(isoline_width) 2 108 } 109 if { ![info exists isoControl(isoline_monocolor)] } { 110 set isoControl(isoline_monocolor) #000000 111 } 112 if { ![info exists isoControl(isoline_stipple)] } { 113 set isoControl(isoline_stipple) {no stipple} 114 } 115 116 foreach i {1 2 3} { 117 if { ![info exists isoControl($i,cpl_basis)] } { 118 set isoControl($i,cpl_basis) $isoControl(cpl_basis) 119 } 120 if { ![info exists isoControl($i,cpl_function)] } { 121 set isoControl($i,cpl_function) $isoControl(cpl_function) 122 } 123 124 if { ![info exists isoControl($i,colorplane)] } { 125 set isoControl($i,colorplane) $isoControl(colorplane) 126 } 127 if { ![info exists isoControl($i,isoline)] } { 128 set isoControl($i,isoline) $isoControl(isoline) 129 } 130 if { ![info exists isoControl($i,colorplane_lighting)] } { 131 set isoControl($i,colorplane_lighting) $isoControl(colorplane_lighting) 132 } 133 if { ![info exists isoControl($i,cpl_transparency)] } { 134 set isoControl($i,cpl_transparency) $isoControl(cpl_transparency) 135 } 136 137 if { ![info exists isoControl($i,cpl_thermometer)] } { 138 set isoControl($i,cpl_thermometer) $isoControl(cpl_thermometer) 139 } 140 if { ![info exists isoControl($i,cpl_thermoTplw)] } { 141 set isoControl($i,cpl_thermoTplw) $isoControl(cpl_thermoTplw) 142 } 143 if { ![info exists isoControl($i,cpl_thermoFmt)] } { 144 set isoControl($i,cpl_thermoFmt) $isoControl(cpl_thermoFmt) 145 } 146 if { ![info exists isoControl($i,cpl_thermoLabel)] } { 147 set isoControl($i,cpl_thermoLabel) $isoControl(cpl_thermoLabel) 148 } 149 if { ![info exists isoControl($i,cpl_thermoNTics)] } { 150 set isoControl($i,cpl_thermoNTics) $isoControl(cpl_thermoNTics) 151 } 152 if { ![info exists isoControl($i,cpl_thermoFont)] } { 153 set isoControl($i,cpl_thermoFont) $isoControl(cpl_thermoFont) 154 } 155 156 if { ![info exists isosurf($i,2Dexpand)] } { 157 set isosurf($i,2Dexpand) $isosurf(2Dexpand) 158 } 159 if { ![info exists isosurf($i,2Dexpand_X)] } { 160 set isosurf($i,2Dexpand_X) $isosurf(2Dexpand_X) 161 } 162 if { ![info exists isosurf($i,2Dexpand_Y)] } { 163 set isosurf($i,2Dexpand_Y) $isosurf(2Dexpand_Y) 164 } 165 if { ![info exists isosurf($i,2Dexpand_Z)] } { 166 set isosurf($i,2Dexpand_Z) $isosurf(2Dexpand_Z) 167 } 168 169 if { ![info exists isoControl($i,anim_step)] } { 170 set isoControl($i,anim_step) $isoControl(anim_step) 171 } 172 if { ![info exists isoControl($i,time_delay)] } { 173 set isoControl($i,time_delay) $isoControl(time_delay) 174 } 175 if { ![info exists isoControl($i,current_slide)] } { 176 set isoControl($i,current_slide) $isoControl(current_slide) 177 } 178 179 if { ![info exists isoControl($i,2Dlowvalue)] } { 180 set isoControl($i,2Dlowvalue) $isoControl(2Dlowvalue) 181 } 182 if { ![info exists isoControl($i,2Dhighvalue)] } { 183 set isoControl($i,2Dhighvalue) $isoControl(2Dhighvalue) 184 } 185 if { ![info exists isoControl($i,2Dnisoline)] } { 186 set isoControl($i,2Dnisoline) $isoControl(2Dnisoline) 187 } 188 if { ![info exists isoControl($i,isoline_color)] } { 189 set isoControl($i,isoline_color) $isoControl(isoline_color) 190 } 191 if { ![info exists isoControl($i,isoline_width)] } { 192 set isoControl($i,isoline_width) $isoControl(isoline_width) 193 } 194 if { ![info exists isoControl($i,isoline_monocolor)] } { 195 set isoControl($i,isoline_monocolor) $isoControl(isoline_monocolor) 196 } 197 if { ![info exists isoControl($i,isoline_stipple)] } { 198 set isoControl($i,isoline_stipple) $isoControl(isoline_stipple) 199 } 200 } 201 202 # check if close-isocontrol button was pressed previously 203 204 if { [info exists isoControl(close,isosurf) ] } { set isoControl(isosurf) $isoControl(close,isosurf) } 205 if { [info exists isoControl(close,colorplane) ] } { set isoControl(colorplane) $isoControl(close,colorplane) } 206 if { [info exists isoControl(close,isoline) ] } { set isoControl(isoline) $isoControl(close,isoline) } 207 foreach i {1 2 3} { 208 if { [info exists isoControl(close,$i,colorplane)] } { set isoControl($i,colorplane) $isoControl(close,$i,colorplane) } 209 if { [info exists isoControl(close,$i,isoline)] } { set isoControl($i,isoline) $isoControl(close,$i,isoline) } 210 } 211} 212 213 214 215proc IsoControl_SetColorPlaneVar {type i} { 216 global isoControl prop isosurf 217 218 xcDebug "#1 Animation: def = $isoControl(current_slide)" 219 xcDebug "#1 Animation: 1 = $isoControl(1,current_slide)" 220 xcDebug "#1 Animation: 2 = $isoControl(2,current_slide)" 221 xcDebug "#1 Animation: 3 = $isoControl(3,current_slide)" 222 if { $type == "1st" } { 223 set isoControl($i,cpl_basis) $isoControl(cpl_basis) 224 set isoControl($i,cpl_function) $isoControl(cpl_function) 225 set isoControl($i,colorplane) $isoControl(colorplane) 226 set isoControl($i,isoline) $isoControl(isoline) 227 set isoControl($i,colorplane_lighting) $isoControl(colorplane_lighting) 228 set isoControl($i,cpl_transparency) $isoControl(cpl_transparency) 229 set isoControl($i,cpl_thermometer) $isoControl(cpl_thermometer) 230 set isoControl($i,cpl_thermoTplw) $isoControl(cpl_thermoTplw) 231 set isoControl($i,cpl_thermoFmt) $isoControl(cpl_thermoFmt) 232 set isoControl($i,cpl_thermoLabel) $isoControl(cpl_thermoLabel) 233 set isoControl($i,cpl_thermoNTics) $isoControl(cpl_thermoNTics) 234 set isoControl($i,cpl_thermoFont) $isoControl(cpl_thermoFont) 235 set isosurf($i,2Dexpand) $isosurf(2Dexpand) 236 set isosurf($i,2Dexpand_X) $isosurf(2Dexpand_X) 237 set isosurf($i,2Dexpand_Y) $isosurf(2Dexpand_Y) 238 set isosurf($i,2Dexpand_Z) $isosurf(2Dexpand_Z) 239 set isoControl($i,anim_step) $isoControl(anim_step) 240 #set isoControl($i,current_slide) $isoControl(current_slide) 241 set isoControl($i,2Dlowvalue) $isoControl(2Dlowvalue) 242 set isoControl($i,2Dhighvalue) $isoControl(2Dhighvalue) 243 set isoControl($i,2Dnisoline) $isoControl(2Dnisoline) 244 set isoControl($i,isoline_color) $isoControl(isoline_color) 245 set isoControl($i,isoline_width) $isoControl(isoline_width) 246 set isoControl($i,isoline_monocolor) $isoControl(isoline_monocolor) 247 set isoControl($i,isoline_stipple) $isoControl(isoline_stipple) 248 } else { 249 set isoControl(cpl_basis) $isoControl($i,cpl_basis) 250 set isoControl(cpl_function) $isoControl($i,cpl_function) 251 set isoControl(colorplane) $isoControl($i,colorplane) 252 set isoControl(isoline) $isoControl($i,isoline) 253 set isoControl(colorplane_lighting) $isoControl($i,colorplane_lighting) 254 set isoControl(cpl_transparency) $isoControl($i,cpl_transparency) 255 set isoControl(cpl_thermometer) $isoControl($i,cpl_thermometer) 256 set isoControl(cpl_thermoTplw) $isoControl($i,cpl_thermoTplw) 257 set isoControl(cpl_thermoFmt) $isoControl($i,cpl_thermoFmt) 258 set isoControl(cpl_thermoLabel) $isoControl($i,cpl_thermoLabel) 259 set isoControl(cpl_thermoNTics) $isoControl($i,cpl_thermoNTics) 260 set isoControl(cpl_thermoFont) $isoControl($i,cpl_thermoFont) 261 set isosurf(2Dexpand) $isosurf($i,2Dexpand) 262 set isosurf(2Dexpand_X) $isosurf($i,2Dexpand_X) 263 set isosurf(2Dexpand_Y) $isosurf($i,2Dexpand_Y) 264 set isosurf(2Dexpand_Z) $isosurf($i,2Dexpand_Z) 265 set isoControl(anim_step) $isoControl($i,anim_step) 266 set isoControl(time_delay) $isoControl($i,time_delay) 267 268 #set isoControl(current_slide) $isoControl($i,current_slide) 269 set isoControl(current_text_slide) "Current slide: $isoControl($i,current_slide) / $isoControl($i,nslide)" 270 set isoControl(2Dlowvalue) $isoControl($i,2Dlowvalue) 271 set isoControl(2Dhighvalue) $isoControl($i,2Dhighvalue) 272 set isoControl(2Dnisoline) $isoControl($i,2Dnisoline) 273 set isoControl(isoline_color) $isoControl($i,isoline_color) 274 set isoControl(isoline_width) $isoControl($i,isoline_width) 275 set isoControl(isoline_monocolor) $isoControl($i,isoline_monocolor) 276 set isoControl(isoline_stipple) $isoControl($i,isoline_stipple) 277 } 278 xcDebug "#2 Animation: def = $isoControl(current_slide)" 279 xcDebug "#2 Animation: 1 = $isoControl(1,current_slide)" 280 xcDebug "#2 Animation: 2 = $isoControl(2,current_slide)" 281 xcDebug "#2 Animation: 3 = $isoControl(3,current_slide)" 282 xcDebug "#2 isoControl(plane) = $isoControl(plane)" 283} 284 285 286 287proc IsoControl_UpdateColorplane {} { 288 global isoControl isosurf 289 290 # COLOR_BASIS & SCALE_FUNCTION 291 set item $isoControl(plane) 292 if $isoControl(cbfn_apply_to_all) { 293 set item {1 2 3} 294 } 295 foreach it $item { 296 set isoControl($it,cpl_basis) $isoControl(cpl_basis) 297 set isoControl($it,cpl_function) $isoControl(cpl_function) 298 } 299 300 # DISPLAY/RANGE/EXPAND/ISOLINE 301 set item $isoControl(plane) 302 if $isoControl(disp_apply_to_all) { 303 set item {1 2 3} 304 } 305 foreach it $item { 306 # check the following three vaiables 307 if { ![check_var { 308 {isoControl(2Dlowvalue) real} 309 {isoControl(2Dhighvalue) real} 310 {isoControl(2Dnisoline) posint} 311 {isoControl(isoline_width) posint} 312 } [list \ 313 $isoControl(2Dlowvalue_entry) \ 314 $isoControl(2Dhighvalue_entry) \ 315 $isoControl(2Dnisoline_entry) \ 316 $isoControl(2Disolinewidth_entry)]] } { 317 return 318 } 319 set isoControl($it,colorplane) $isoControl(colorplane) 320 set isoControl($it,isoline) $isoControl(isoline) 321 set isoControl($it,colorplane_lighting) $isoControl(colorplane_lighting) 322 set isoControl($it,cpl_transparency) $isoControl(cpl_transparency) 323 set isoControl($it,cpl_thermometer) $isoControl(cpl_thermometer) 324 set isoControl($it,cpl_thermoTplw) $isoControl(cpl_thermoTplw) 325 set isoControl($it,cpl_thermoFmt) $isoControl(cpl_thermoFmt) 326 set isoControl($it,cpl_thermoLabel) $isoControl(cpl_thermoLabel) 327 set isoControl($it,cpl_thermoNTics) $isoControl(cpl_thermoNTics) 328 set isoControl($it,cpl_thermoFont) $isoControl(cpl_thermoFont) 329 330 if { $isoControl(2Dnisoline) > $isoControl(max_allowed_2Dnisoline) } { 331 tk_dialog [WidgetName] WARNING "WARNING: more then $isoControl(max_allowed_2Dnisoline) isolines was requested; Maximum number is $isoControl(max_allowed_2Dnisoline) !!! Setting number of isolines to $isoControl(max_allowed_2Dnisoline)" \ 332 warning 0 OK 333 set isoControl(2Dnisoline) 50 334 } 335 set isoControl($it,2Dlowvalue) $isoControl(2Dlowvalue) 336 set isoControl($it,2Dhighvalue) $isoControl(2Dhighvalue) 337 set isoControl($it,2Dnisoline) $isoControl(2Dnisoline) 338 set isoControl($it,isoline_color) $isoControl(isoline_color) 339 set isoControl($it,isoline_width) $isoControl(isoline_width) 340 set isoControl($it,isoline_monocolor) $isoControl(isoline_monocolor) 341 set isoControl($it,isoline_stipple) $isoControl(isoline_stipple) 342 set isosurf($it,2Dexpand) $isosurf(2Dexpand) 343 set isosurf($it,2Dexpand_X) $isosurf(2Dexpand_X) 344 set isosurf($it,2Dexpand_Y) $isosurf(2Dexpand_Y) 345 set isosurf($it,2Dexpand_Z) $isosurf(2Dexpand_Z) 346 } 347 UpdateIsosurf 348} 349 350 351 352proc IsoControl_Show {type fiso fplane biso bplane1 bplane2 bplane3} { 353 global isoControl 354 355 if { $isoControl(plane) != {} } { 356 IsoControl_SetColorPlaneVar 1st $isoControl(plane) 357 } 358 359 if { $type == "isosurf" } { 360 set isoControl(plane) {} 361 $biso config -bd 3 362 $bplane1 config -bd 1 363 $bplane2 config -bd 1 364 $bplane3 config -bd 1 365 pack forget $fplane 366 pack $fiso -side top -fill both -expand 1 367 } else { 368 if { $type == "colorplane1" } { 369 set isoControl(plane) 1 370 $biso config -bd 1 371 $bplane1 config -bd 3 372 $bplane2 config -bd 1 373 $bplane3 config -bd 1 374 pack forget $fiso 375 pack $fplane -side top -fill both -expand 1 376 } elseif { $type == "colorplane2" } { 377 set isoControl(plane) 2 378 $biso config -bd 1 379 $bplane1 config -bd 1 380 $bplane2 config -bd 3 381 $bplane3 config -bd 1 382 pack forget $fiso 383 pack $fplane -side top -fill both -expand 1 384 } elseif { $type == "colorplane3" } { 385 set isoControl(plane) 3 386 $biso config -bd 1 387 $bplane1 config -bd 1 388 $bplane2 config -bd 1 389 $bplane3 config -bd 3 390 pack forget $fiso 391 pack $fplane -side top -fill both -expand 1 392 } 393 IsoControl_SetColorPlaneVar 2nd $isoControl(plane) 394 } 395} 396 397 398 399proc IsoControl_IsoLineShow {type d r e i df rf ef ifr} { 400 global isoControl 401 402 set dr 1 403 set rr 1 404 set er 1 405 set ir 1 406 if { $type == "display" } { 407 set dr 3 408 pack $df -padx 3 -pady 3 -ipady 3 -side top -fill x -expand 1 409 pack forget $rf $ef $ifr 410 } elseif { $type == "ranges" } { 411 set rr 3 412 pack $rf -padx 3 -pady 3 -ipady 3 -side top -fill x -expand 1 413 pack forget $df $ef $ifr 414 } elseif { $type == "expand" } { 415 set er 3 416 pack $ef -padx 3 -pady 3 -ipady 3 -side top -fill x -expand 1 417 pack forget $df $rf $ifr 418 } elseif { $type == "isoline" } { 419 set ir 3 420 pack $ifr -side top -fill x -expand 1 421 pack forget $df $rf $ef 422 } 423 $d config -bd $dr 424 $r config -bd $rr 425 $e config -bd $er 426 $i config -bd $ir 427} 428 429 430proc IsoControl_Hide {{t .iso}} { 431 global unmapWin 432 wm withdraw $t 433 xcUnmapWindow unmap $t $t $unmapWin(frame,main) isosurf_control 434} 435 436 437 438# isoControl(color_button) 439# isoControl(blend_button) 440proc IsoControl {} { 441 global isosurf nxdir nydir nzdir periodic xcFonts XCTrace prop \ 442 isoControl unmapWin 443 444 if {[winfo exists .iso] } { return } 445 446 # 447 # initializations 448 # 449 set isoControl(plane) {} 450 set isoControl(datagridDim) 3 451 452 IsoControl_InitVar 453 reloadButtonDisable 454 455 set t [xcToplevel .iso "Isosurface/Property-plane Controls" "IsoControls" . -0 0 1] 456 pack propagate .iso 457 458 xcRegisterUnmapWindow $t $unmapWin(frame,main) \ 459 isosurf_control -image unmap-isosurf 460 bind $t <Unmap> [list xcUnmapWindow unmap %W $t \ 461 $unmapWin(frame,main) isosurf_control] 462 bind $t <Map> [list xcUnmapWindow map %W $t \ 463 $unmapWin(frame,main) isosurf_control] 464 set ft [frame $t.ft] 465 set fb1 [frame $t.fb1] 466 set fb2 [frame $t.fb2] 467 if { $prop(type_of_run) == "UHF" } { 468 set fm [frame $t.fm] 469 pack $ft $fm -fill x 470 } else { 471 pack $ft -fill x 472 } 473 pack $fb1 -fill both -expand 1 474 475 set b1 [button $ft.b1 \ 476 -text "Isosurface" \ 477 -bd 3 \ 478 -highlightthickness 0 \ 479 -command [list IsoControl_Show isosurf $fb1 $fb2 \ 480 $ft.b1 $ft.b2 $ft.b3 $ft.b4]] 481 set b2 [button $ft.b2 \ 482 -text "Plane #1" \ 483 -bd 1 \ 484 -highlightthickness 0 \ 485 -command [list IsoControl_Show colorplane1 $fb1 $fb2 \ 486 $ft.b1 $ft.b2 $ft.b3 $ft.b4]] 487 set b3 [button $ft.b3 \ 488 -text "Plane #2" \ 489 -bd 1 \ 490 -highlightthickness 0 \ 491 -command [list IsoControl_Show colorplane2 $fb1 $fb2 \ 492 $ft.b1 $ft.b2 $ft.b3 $ft.b4]] 493 set b4 [button $ft.b4 \ 494 -text "Plane #3" \ 495 -bd 1 \ 496 -highlightthickness 0 \ 497 -command [list IsoControl_Show colorplane3 $fb1 $fb2 \ 498 $ft.b1 $ft.b2 $ft.b3 $ft.b4]] 499 pack $b1 $b2 $b3 $b4 -side left -fill both -expand 1 500 501 ######################################## 502 # if UHF 503 if { $prop(type_of_run) == "UHF" } { 504 set f0 [frame $fm.f0 -relief raised -bd 2] 505 frame $f0.1 -relief groove -bd 2 506 xcMenuEntry $f0.1 "What SPIN to take:" 30 \ 507 isosurf(spin) {ALPHA BETA ALPHA+BETA ALPHA-BETA} \ 508 -labelwidth 17 \ 509 -labelfont $xcFonts(small) \ 510 -entryfont $xcFonts(small_entry) 511 pack $f0 -side top -fill both 512 pack $f0.1 -padx 2 -pady 5 -ipady 3 -fill x 513 } 514 515 ######################## 516 ### IsoSURFACE frame ### 517 ######################## 518 set f [frame $fb1.f] 519 set left [frame $f.left -relief raised -bd 2] 520 set right [frame $f.right -relief raised -bd 2] 521 set bot [frame $fb1.bot -relief raised -bd 2] 522 pack $f -side top -expand 1 -fill both 523 pack $left $right -side left -fill both -expand 1 524 pack $bot -side bottom -fill both -expand 1 525 526 ######################################## 527 # LEFT FRAME 528 if { ![info exists isoControl(isosurf)] } { 529 set isoControl(isosurf) 1 530 } 531 set ckb [checkbutton $left.cb \ 532 -text "Display Isosurface" \ 533 -command "UpdateIsosurf" \ 534 -relief raised -bd 2 \ 535 -anchor w \ 536 -variable isoControl(isosurf)] 537 pack $ckb -side top -padx 5 -pady 5 -fill x 538 539 scale $left.sc -from 1 -to 4 -length 100 \ 540 -variable isosurf(3Dinterpl_degree) -orient horizontal \ 541 -label "Degree of triCubic Spline:" \ 542 -tickinterval 1 -resolution 1 \ 543 -width 7 -sliderlength 20 \ 544 -showvalue true -relief groove -bd 2 \ 545 -font $xcFonts(small) 546 pack $left.sc -side top -padx 2 -pady 5 -fill both -expand 1 547 548 set f1 [frame $left.f1 -relief groove -bd 2] 549 set f2 [frame $left.f2 -relief groove -bd 2] 550 set f3 [frame $left.f3 -relief groove -bd 2] 551 set f4 [frame $left.f4 -relief groove -bd 2] 552 pack $f3 $f4 $f1 $f2 -side top -padx 2 -pady 5 -fill both -expand 1 553 554 set frame_color [lindex \ 555 [GetWidgetConfig frame -background] end] 556 FillEntries $f1 {"Minimum grid value:"} \ 557 isosurf(minvalue) \ 558 18 9 top left \ 559 -e_relief flat -e_state disabled -e_bg $frame_color \ 560 -l_font $xcFonts(small) -e_font $xcFonts(small_entry) 561 FillEntries $f1 {"Maximum grid value:"} \ 562 isosurf(maxvalue) \ 563 18 9 top left \ 564 -e_relief flat -e_state disabled -e_bg $frame_color \ 565 -l_font $xcFonts(small) -e_font $xcFonts(small_entry) 566 set isosurf(isovalue_entry) [FillEntries $f1 {"Isovalue:"} \ 567 prop(isolevel) \ 568 18 9 top left \ 569 -l_font $xcFonts(small) -e_font $xcFonts(small_entry)] 570 focus $isosurf(isovalue_entry) 571 # 572 # make checkbutton for specifying +/- option 573 # 574 set ck [checkbutton $f1.ckb \ 575 -text "Render +/- isovalue" \ 576 -variable prop(pm_isolevel) \ 577 -command IsoControlCommand \ 578 -anchor w] 579 pack $ck -side bottom -expand 1 -fill both -padx 5 -pady 2 580 581 # 582 # isosurface triangulation algorithm 583 # 584 set wlist_ [RadioButCmd $f3 "Isosurface tessellation type:" \ 585 isosurf(tessellation_type) UpdateIsosurf \ 586 top left 0 1 2 "cubes" "tetrahedrons"] 587 foreach w $wlist_ { 588 $w configure -font $xcFonts(small) 589 } 590 591 # 592 # isosurface normals computation algorithm 593 # 594 set wlist_ [RadioButCmd $f4 "Isosurface normals type:" \ 595 isosurf(normals_type) UpdateIsosurf \ 596 top left 0 1 2 "gradient" "triangles"] 597 foreach w $wlist_ { 598 $w configure -font $xcFonts(small) 599 } 600 601 ############### 602 # EXPAND option; just for periodic systems 603 604 set disabled_color [lindex \ 605 [GetWidgetConfig button -disabledforeground] end] 606 set enabled_color [lindex \ 607 [GetWidgetConfig scale -foreground] end] 608 set enable "\ 609 $f2.b.scX configure -foreground $enabled_color; \ 610 $f2.b.scY configure -foreground $enabled_color; \ 611 $f2.b.scZ configure -foreground $enabled_color" 612 set disable " \ 613 $f2.b.scX configure -foreground $disabled_color; \ 614 $f2.b.scY configure -foreground $disabled_color; \ 615 $f2.b.scZ configure -foreground $disabled_color" 616 617 if { $periodic(dim) > 0 } { 618 label $f2.l -text "Expand Isosurface:" -relief flat 619 set lfont [ModifyFont [$f2.l cget -font] $f2.l -underline 1] 620 $f2.l configure -font $lfont 621 set r1 [radiobutton $f2.r1 \ 622 -text "do not expand" \ 623 -variable isosurf(expand) \ 624 -value "none" \ 625 -anchor w \ 626 -font $xcFonts(small) \ 627 -command "xcDisableAll $f2.b; catch {eval $disable}"] 628 set r2 [radiobutton $f2.r2 \ 629 -text "to whole structure" \ 630 -variable isosurf(expand) \ 631 -value "whole" \ 632 -anchor w \ 633 -font $xcFonts(small) \ 634 -command "xcDisableAll $f2.b; catch {eval $disable}"] 635 set r3 [radiobutton $f2.r3 \ 636 -text "separately in each direction" \ 637 -variable isosurf(expand) \ 638 -value "specify" \ 639 -anchor w \ 640 -font $xcFonts(small) \ 641 -command "xcEnableAll $f2.b; catch {eval $enable}"] 642 pack $f2.l -side top -expand 1 643 pack $r1 $r2 $r3 -side top -fill x 644 645 set f2a [frame $f2.a -relief flat -width 40] 646 set f2b [frame $f2.b -relief flat] 647 pack $f2a -side left 648 pack $f2b -side left -expand 1 -fill x 649 650 set XCTrace(scX) [scale $f2b.scX -from 1 -to $nxdir -length 100 \ 651 -variable isosurf(expand_X) -orient horizontal \ 652 -label "repeat in X-dir:" -tickinterval 1 -resolution 1 \ 653 -showvalue true \ 654 -font $xcFonts(small) \ 655 -width 7 -sliderlength 20] 656 # TRACE -- nxdir 657 trace variable nxdir w xcTrace 658 pack $XCTrace(scX) -side top 659 if { $periodic(dim) > 1} { 660 set XCTrace(scY) [scale $f2b.scY -from 1 -to $nydir -length 100 \ 661 -variable isosurf(expand_Y) -orient horizontal \ 662 -label "repeat in Y-dir:" -tickinterval 1 -resolution 1 \ 663 -showvalue true \ 664 -font $xcFonts(small) \ 665 -width 7 -sliderlength 20] 666 # TRACE -- nydir 667 trace variable nydir w xcTrace 668 pack $XCTrace(scY) -side top 669 } 670 if { $periodic(dim) > 2 } { 671 set XCTrace(scZ) [scale $f2b.scZ -from 1 -to $nzdir -length 100 \ 672 -variable isosurf(expand_Z) -orient horizontal \ 673 -label "repeat in Z-dir:" -tickinterval 1 -resolution 1 \ 674 -showvalue true \ 675 -font $xcFonts(small) \ 676 -width 7 -sliderlength 20] 677 # TRACE -- nzdir 678 trace variable nzdir w xcTrace 679 pack $XCTrace(scZ) -side top 680 } 681 } 682 683 ######################################## 684 # RIGHT FRAME 685 set f1 [frame $right.f1 -relief groove -bd 2] 686 set f2 [frame $right.f2 -relief groove -bd 2] 687 set f3 [frame $right.f3 -relief groove -bd 2] 688 set f4 [frame $right.f4 -relief groove -bd 2] 689 set f5 [frame $right.f5] 690 pack $f1 $f2 $f3 $f4 -side top -padx 2 -pady 5 -fill x 691 pack $f5 -side top -padx 2 -pady 5 -fill both -expand 1 692 693 set wlist1 [RadioButCmd $f1 "Render isosurface as:" \ 694 isosurf(type_of_isosurf) UpdateIsosurf \ 695 top left 0 1 2 "solid" "wire" "dot"] 696 697 set wlist2 [RadioButCmd $f2 "Isosurface's ShadeModel:" \ 698 isosurf(shade_model) UpdateIsosurf \ 699 top left 0 1 2 "smooth" "flat"] 700 701 set wlist3 [RadioButCmd $f3 "Two-sided lighting:" \ 702 isosurf(twoside_lighting) ConvertTwoSideVar \ 703 top left 0 1 2 "off" "on"] 704 705 set wlist4 [RadioButCmd $f4 "Transparency of isosurface:" \ 706 isosurf(transparency) UpdateIsosurf \ 707 top left 0 1 2 "off" "on"] 708 709 foreach w [concat $wlist1 $wlist2 $wlist3 $wlist4] { 710 $w configure -font $xcFonts(small) 711 } 712 713 # REVERT FRONT&BACK SIDE 714 button $f5.b10 \ 715 -font $xcFonts(small) \ 716 -text "Revert (+) sides" \ 717 -command [list RevertIsoSides pos] 718 set isoControl(revert_button2) [button $f5.b10a \ 719 -font $xcFonts(small) \ 720 -text "Revert (-) sides" \ 721 -command [list RevertIsoSides neg]] 722 723 # REVERT NORMALS 724 button $f5.b11 \ 725 -font $xcFonts(small) \ 726 -text "Revert (+) normals" \ 727 -command [list RevertIsoNormals pos] 728 set isoControl(revert_button1) [button $f5.b12 \ 729 -font $xcFonts(small) \ 730 -text "Revert (-) normals" \ 731 -command [list RevertIsoNormals neg]] 732 733 set isoControl(smooth_button) [button $f5.b2a \ 734 -text "Surface smoothing" \ 735 -font $xcFonts(small) \ 736 -command SurfaceSmoothing] 737 $isoControl(smooth_button) config -state disabled 738 739 set isoControl(color_button) [button $f5.b2 \ 740 -text "Set COLOR parameters" \ 741 -font $xcFonts(small)] 742 743 set isoControl(blend_button) [button $f5.b3 \ 744 -text "Set TRANSPARENCY\nparameters" \ 745 -font $xcFonts(small)] 746 747 pack $f5.b10 $f5.b10a $f5.b11 $f5.b12 $f5.b2a $f5.b2 $f5.b3 \ 748 -fill x -side top -padx 2 -pady 5 749 750 set hid [button $bot.hid -text "Hide" \ 751 -command [list IsoControl_Hide $t]] 752 set can [button $bot.can -text "Close" \ 753 -command [list IsoControlCan $t]] 754 set sav [button $bot.sav -text "Save Grid" \ 755 -command IsoControlSave] 756 set sub [button $bot.sub -text "Submit" \ 757 -command UpdateIsosurf] 758 pack $hid $can $sav $sub -side left -pady 5 -expand 1 759 760 # 761 # get the state according to prop(pm_isolevel) variable 762 # (look the "Render +/- isovalue" checkbutton) 763 # 764 IsoControlCommand 765 766 767 ######################## 768 ### ColorPLANE frame ### 769 ######################## 770 set f0 [frame $fb2.f0 -relief raised -bd 2] 771 frame $f0.1 -relief groove -bd 2 772 set ckb [checkbutton $f0.1.cb \ 773 -text "Apply to Planes #1/#2/#3" \ 774 -relief raised -bd 2 \ 775 -anchor w \ 776 -variable isoControl(cbfn_apply_to_all)] 777 pack $ckb -side top -padx 5 -pady 5 -fill x 778 779 set f1 [frame $f0.f1] 780 set f2 [frame $f0.f2] 781 xcMenuEntry $f1 "Select color basis:" 30 \ 782 isoControl(cpl_basis) {MONOCHROME RAINBOW RGB GEOGRAPHIC BLUE-WHITE-RED BLACK-BROWN-WHITE} \ 783 -labelwidth 17 \ 784 -labelfont $xcFonts(small) \ 785 -entryfont $xcFonts(small_entry) \ 786 -labelanchor w 787 xcMenuEntry $f2 "Select scale function:" 30 \ 788 isoControl(cpl_function) {LINEAR LOG10 SQRT 3th-ROOT EXP(x) EXP(x^2)} \ 789 -labelwidth 17 \ 790 -labelfont $xcFonts(small) \ 791 -entryfont $xcFonts(small_entry) \ 792 -labelanchor w 793 pack $f0 -side top -fill both -expand 1 794 pack $f0.1 -padx 2 -pady 5 -ipady 3 -fill x 795 pack $f1 $f2 -side top -in $f0.1 -fill x 796 797 # 798 # DISPLAY/RANGES/EXPAND/ISOLINE 799 # 800 set f1 [frame $fb2.f1 -relief raised -bd 2] 801 set ckb [checkbutton $f1.cb \ 802 -text "Apply to Planes #1/#2/#3" \ 803 -relief raised -bd 2 \ 804 -anchor w \ 805 -variable isoControl(disp_apply_to_all)] 806 pack $ckb -side top -padx 5 -pady 5 -fill x 807 808 set f11 [frame $f1.1] 809 pack $f1 -side top -fill both -expand 1 810 pack $f11 -side top -fill both -expand 1 -padx 4 -pady 8 811 set mfb [frame $f11.mfb] 812 set mf [frame $f11.mf -relief raised -bd 2] 813 pack $mfb $mf -side top -padx 2 -fill both -expand 1 814 815 set df [frame $mf.d -relief groove -bd 2] 816 set rf [frame $mf.r -relief groove -bd 2] 817 set ef [frame $mf.e -relief groove -bd 2] 818 set ifr [frame $mf.i] 819 820 set d [button $mfb.d -text "Display" \ 821 -highlightthickness 0 -bd 1 \ 822 -command [list IsoControl_IsoLineShow display \ 823 $mfb.d $mfb.r $mfb.e $mfb.i \ 824 $df $rf $ef $ifr]] 825 set r [button $mfb.r -text "Ranges" \ 826 -highlightthickness 0 -bd 1 \ 827 -command [list IsoControl_IsoLineShow ranges \ 828 $mfb.d $mfb.r $mfb.e $mfb.i \ 829 $df $rf $ef $ifr]] 830 set e [button $mfb.e -text "Expand" \ 831 -highlightthickness 0 -bd 1 \ 832 -command [list IsoControl_IsoLineShow expand \ 833 $mfb.d $mfb.r $mfb.e $mfb.i\ 834 $df $rf $ef $ifr]] 835 set i [button $mfb.i -text "Isoline" \ 836 -highlightthickness 0 -bd 1 \ 837 -command [list IsoControl_IsoLineShow isoline \ 838 $mfb.d $mfb.r $mfb.e $mfb.i\ 839 $df $rf $ef $ifr]] 840 841 if { $periodic(dim) == 0 } { 842 $e config -state disabled 843 } 844 pack $d $r $e $i -side left -padx 0 -pady 0 -fill both -expand 1 845 846 IsoControl_IsoLineShow display $mfb.d $mfb.r $mfb.e $mfb.i \ 847 $df $rf $ef $ifr 848 849 850 # 851 # DISPLAY 852 # 853 set l [label $df.l -text "Property-plane display option:"] 854 set lfont [ModifyFont [$df.l cget -font] $df.l -underline 1] 855 $l configure -font $lfont 856 857 set ck1 [checkbutton $df.c1 \ 858 -text "display color-plane" \ 859 -variable isoControl(colorplane) \ 860 -width 21 \ 861 -anchor w] 862 set ck2 [checkbutton $df.c2 \ 863 -text "display isolines" \ 864 -variable isoControl(isoline) \ 865 -width 21 \ 866 -anchor w] 867 set ck3 [checkbutton $df.c3 \ 868 -text "lighting of color-plane" \ 869 -variable isoControl(colorplane_lighting) \ 870 -width 21 \ 871 -onvalue 1 \ 872 -offvalue 0 \ 873 -anchor w] 874 set ck4 [checkbutton $df.c4 \ 875 -text "transparent color-plane" \ 876 -variable isoControl(cpl_transparency) \ 877 -width 21 \ 878 -onvalue 1 -offvalue 0 \ 879 -anchor w] 880 set ck5 [checkbutton $df.c5 \ 881 -text "display thermometer" \ 882 -variable isoControl(cpl_thermometer) \ 883 -width 21 \ 884 -onvalue 1 -offvalue 0 \ 885 -anchor w] 886 set ck6 [checkbutton $df.c6 \ 887 -text "thermometer in toplevel" \ 888 -variable isoControl(cpl_thermoTplw) \ 889 -width 21 \ 890 -onvalue 1 -offvalue 0 \ 891 -anchor w] 892 set thermo [frame $df.f] 893 grid configure $l -column 0 -row 0 -columnspan 2 894 grid configure $ck1 -column 0 -row 1 895 grid configure $ck4 -column 0 -row 2 896 grid configure $ck2 -column 1 -row 1 897 grid configure $ck3 -column 1 -row 2 898 grid configure $ck5 -column 0 -row 3 899 grid configure $ck6 -column 1 -row 3 900 grid configure $thermo -column 0 -row 4 -columnspan 2 901 902 # thermometer-widgets 903 set tf1 [frame $thermo.1 -relief groove -bd 2] 904 set tf11 [frame $tf1.1] 905 set tf12 [frame $tf1.2] 906 label $tf11.__l -text "Thermometer settings:" -anchor w 907 pack $tf11.__l -side top -fill x 908 FillEntries $tf11 { 909 "Format string:" 910 "Label:" 911 "No. of tics:" 912 } { 913 isoControl(cpl_thermoFmt) 914 isoControl(cpl_thermoLabel) 915 isoControl(cpl_thermoNTics) 916 } 14 20 917 button $tf12.font -text "Set Font" -command isoControl_thermoFont 918 pack $tf1 -side top -fill both -expand 1 -padx 5 -pady 5 919 pack $tf11 $tf12 -side left -fill x -expand 1 -padx 5 -pady 5 920 pack $tf12.font -side top -fill x -expand 1 921 922 # 923 # RANGES 924 # 925 set frame_color [lindex \ 926 [GetWidgetConfig frame -background] end] 927 FillEntries $rf {"Minimum 3D grid value:"} \ 928 isosurf(minvalue) \ 929 25 9 top left \ 930 -e_relief flat -e_state disabled -e_bg $frame_color \ 931 -l_font $xcFonts(small) -e_font $xcFonts(small_entry) 932 FillEntries $rf {"Maximum 3D grid value:"} \ 933 isosurf(maxvalue) \ 934 25 9 top left \ 935 -e_relief flat -e_state disabled -e_bg $frame_color \ 936 -l_font $xcFonts(small) -e_font $xcFonts(small_entry) 937 938 set isoControl(2Dlowvalue_entry) [FillEntries $rf \ 939 {"Lowest rendered value:"} isoControl(2Dlowvalue) \ 940 25 9 top left \ 941 -l_font $xcFonts(small) -e_font $xcFonts(small_entry)] 942 set isoControl(2Dhighvalue_entry) [FillEntries $rf \ 943 {"Highest rendered value:"} isoControl(2Dhighvalue) \ 944 25 9 top left \ 945 -l_font $xcFonts(small) -e_font $xcFonts(small_entry)] 946 set isoControl(2Dnisoline_entry) [FillEntries $rf \ 947 {"Number of isolines:"} \ 948 isoControl(2Dnisoline) \ 949 25 9 top left \ 950 -l_font $xcFonts(small) -e_font $xcFonts(small_entry)] 951 952 953 # 954 # EXPAND 955 # 956 set f21 [frame $ef.top] 957 set f22 [frame $ef.bot] 958 pack $f21 $f22 -side top -fill both -expand 1 959 960 set enable "\ 961 $f22.scX configure -foreground $enabled_color; \ 962 $f22.scY configure -foreground $enabled_color; \ 963 $f22.scZ configure -foreground $enabled_color" 964 set disable " \ 965 $f22.scX configure -foreground $disabled_color; \ 966 $f22.scY configure -foreground $disabled_color; \ 967 $f22.scZ configure -foreground $disabled_color" 968 if { $periodic(dim) > 0 } { 969 label $f21.l -text "Expand Property-plane:" -relief flat 970 $f21.l configure -font $lfont 971 set r1 [radiobutton $f21.r1 \ 972 -text "do not expand" \ 973 -variable isosurf(2Dexpand) \ 974 -value "none" \ 975 -anchor w \ 976 -font $xcFonts(small) \ 977 -command "xcDisableAll $f22; catch {eval $disable}"] 978 set r2 [radiobutton $f21.r2 \ 979 -text "to whole structure" \ 980 -variable isosurf(2Dexpand) \ 981 -value "whole" \ 982 -anchor w \ 983 -font $xcFonts(small) \ 984 -command "xcDisableAll $f22; catch {eval $disable}"] 985 set r3 [radiobutton $f21.r3 \ 986 -text "separately in each direction" \ 987 -variable isosurf(2Dexpand) \ 988 -value "specify" \ 989 -anchor w \ 990 -font $xcFonts(small) \ 991 -command "xcEnableAll $f22; catch {eval $enable}"] 992 pack $f21.l -side top -expand 1 993 pack $r1 $r2 $r3 -side top -fill x 994 995 set XCTrace(2DscX) [scale $f22.scX -from 1 -to $nxdir -length 100 \ 996 -variable isosurf(2Dexpand_X) -orient horizontal \ 997 -label "repeat in X-dir:" -tickinterval 1 -resolution 1 \ 998 -showvalue true \ 999 -font $xcFonts(small) \ 1000 -width 7 -sliderlength 20] 1001 # TRACE -- nxdir 1002 trace variable nxdir w xcTrace 1003 pack $XCTrace(2DscX) -side left -pady 5 -expand 1 -fill x 1004 if { $periodic(dim) > 1} { 1005 set XCTrace(2DscY) [scale $f22.scY -from 1 -to $nydir \ 1006 -length 100 \ 1007 -variable isosurf(2Dexpand_Y) -orient horizontal \ 1008 -label "repeat in Y-dir:" -tickinterval 1 -resolution 1 \ 1009 -showvalue true \ 1010 -font $xcFonts(small) \ 1011 -width 7 -sliderlength 20] 1012 # TRACE -- nydir 1013 trace variable nydir w xcTrace 1014 pack $XCTrace(2DscY) -side left -pady 5 -expand 1 -fill x 1015 } 1016 if { $periodic(dim) > 2 } { 1017 set XCTrace(2DscZ) [scale $f22.scZ -from 1 -to $nzdir \ 1018 -length 100 \ 1019 -variable isosurf(2Dexpand_Z) -orient horizontal \ 1020 -label "repeat in Z-dir:" -tickinterval 1 -resolution 1 \ 1021 -showvalue true \ 1022 -font $xcFonts(small) \ 1023 -width 7 -sliderlength 20] 1024 # TRACE -- nzdir 1025 trace variable nzdir w xcTrace 1026 pack $XCTrace(2DscZ) -side left -pady 5 -expand 1 -fill x 1027 } 1028 } 1029 1030 # 1031 # Isoline 1032 # 1033 set mf1 [frame $ifr.1 -relief groove -bd 2] 1034 set mf2 [frame $ifr.2 -relief groove -bd 2] 1035 set mf3 [frame $ifr.3 -relief groove -bd 2] 1036 pack $mf1 $mf2 $mf3 -side top -expand 1 -fill both -padx 3 -pady 3 1037 1038 set isoControl(bmc) [button $mf1.b -text "set color" \ 1039 -command IsoControl_SetIsolineColor] 1040 1041 RadioButVarCmd $mf1 "Isoline Color:" isoControl(isoline_color) \ 1042 IsoControl_IsolineColor left top 0 0 \ 1043 {monocolor} {property color} 1044 pack $isoControl(bmc) -side left -padx 2 1045 1046 RadioBut $mf2 "Isoline Stipple:" isoControl(isoline_stipple) left top 0 1 \ 1047 {no stipple} {stipple negative} {full stipple} 1048 # this is temporal, since "Isoline Stipple" is not yet working 1049 xcDisableAll $mf2 1050 1051 # here goes isoline_width entry 1052 set isoControl(2Disolinewidth_entry) [FillEntries \ 1053 $mf3 {"Isoline width:"} \ 1054 isoControl(isoline_width) \ 1055 14 10 left left] 1056 1057 ################### 1058 # ANIMATION FRAME # 1059 ################### 1060 set f4 [frame $fb2.f4 -relief raised -bd 2] 1061 frame $f4.1 -relief groove -bd 2 1062 pack $f4 -side top -fill x -expand 1 1063 pack $f4.1 -padx 2 -pady 5 -ipady 3 -side top -fill x -expand 1 1064 1065 set ckb [checkbutton $f4.1.cb \ 1066 -text "Apply to Planes #1/#2/#3" \ 1067 -relief raised -bd 2 \ 1068 -anchor w \ 1069 -variable isoControl(anim_apply_to_all)] 1070 pack $ckb -side top -padx 5 -pady 5 -fill x 1071 1072 # slide label 1073 set f41 [frame $f4.1.1] 1074 pack $f41 -side top -expand 1 -padx 2 1075 label $f41.l1 -textvariable isoControl(current_text_slide) -anchor c 1076 set lfont [ModifyFont [$f41.l1 cget -font] $f41.l1 -size 16 -underline 1] 1077 $f41.l1 configure -font $lfont 1078 pack $f41.l1 -side left -padx 5 -fill x -expand 1 1079 1080 # scales 1081 set f41a [frame $f4.1.1a] 1082 pack $f41a -side top -expand 1 -fill x -padx 2 1083 scale $f41a.s1 -from 1 -to 10 -length 170 \ 1084 -variable isoControl(anim_step) -orient horizontal \ 1085 -label "Animation Step:" -tickinterval 3 -resolution 1 \ 1086 -showvalue true \ 1087 -font $xcFonts(small) \ 1088 -width 7 -sliderlength 20 1089 scale $f41a.s2 -from 0 -to 1000 -length 170 \ 1090 -variable isoControl(time_delay) -orient horizontal \ 1091 -label "Delay between slides (in msec):" -tickinterval 200 -resolution 10 \ 1092 -showvalue true \ 1093 -font $xcFonts(small) \ 1094 -width 7 -sliderlength 20 1095 pack $f41a.s1 $f41a.s2 -side left -padx 5 -expand 1 1096 1097 set f42 [frame $f4.1.2] 1098 pack $f42 -side bottom -expand 1 -padx 2 -pady 5 1099 set first [button $f42.1st -image first -anchor center \ 1100 -command [list IsoControl_Animate first]] 1101 set backw [button $f42.bck -image backward -anchor center \ 1102 -command [list IsoControl_Animate backward]] 1103 set previ [button $f42.prv -image previous -anchor center \ 1104 -command [list IsoControl_Animate previous]] 1105 set stop [button $f42.sto -image stop -anchor center \ 1106 -command [list IsoControl_Animate stop]] 1107 set next [button $f42.nxt -image next -anchor center \ 1108 -command [list IsoControl_Animate next]] 1109 set forw [button $f42.frw -image forward -anchor center \ 1110 -command [list IsoControl_Animate forward]] 1111 set last [button $f42.lst -image last -anchor center \ 1112 -command [list IsoControl_Animate last]] 1113 pack $first $backw $previ $stop $next $forw $last -side left 1114 1115 foreach {wid text} [list \ 1116 $first "First slide" \ 1117 $backw "Play backward" \ 1118 $previ "Previous slide" \ 1119 $stop "Stop playing" \ 1120 $next "Next slide" \ 1121 $forw "Play forward" \ 1122 $last "Last slide"] { 1123 DynamicHelp::register $wid balloon $text 1124 } 1125 1126 ######################################## 1127 # BOTTOM FRAME 1128 set f5 [frame $fb2.f5 -relief raised -bd 2] 1129 pack $f5 -side top -fill both -expand 1 1130 1131 set hid [button $f5.hid -text "Hide" \ 1132 -command [list IsoControl_Hide $t]] 1133 set can [button $f5.can -text "Close" \ 1134 -command [list IsoControlCan $t]] 1135 set sav [button $f5.sav -text "Save Grid" \ 1136 -command IsoControlSave] 1137 set sub [button $f5.sub -text "Submit" \ 1138 -command IsoControl_UpdateColorplane] 1139 pack $hid $can $sav $sub -side left -pady 5 -expand 1 1140 1141} 1142 1143 1144proc IsoControl_SetIsolineColorOK {type t} { 1145 global isoControl mody_col 1146 1147 if { $type == "OK" } { 1148 set cID [xcModifyColorGetID] 1149 set isoControl(isoline_monocolor) "#$mody_col($cID,hxred)$mody_col($cID,hxgreen)$mody_col($cID,hxblue)" 1150 if [winfo exists .iso] { 1151 IsoControl_UpdateColorplane 1152 } else { 1153 UpdatePropertyPlane 1154 } 1155 } 1156 destroy $t 1157} 1158proc IsoControl_SetIsolineColor {} { 1159 global isoControl 1160 set t [xcToplevel [WidgetName] \ 1161 "Set Isoline Color" "Isoline Color" . -0 0 1] 1162 xcModifyColor $t "Set Isoline Color:" $isoControl(isoline_monocolor) \ 1163 groove left left 100 100 70 5 20 1164 1165 set ok [DefaultButton [WidgetName $t] -text "OK" \ 1166 -command [list IsoControl_SetIsolineColorOK OK $t]] 1167 set can [button [WidgetName $t] -text "Cancel" \ 1168 -command [list IsoControl_SetIsolineColorOK Cancel $t]] 1169 pack $ok $can -padx 10 -pady 10 -expand 1 1170} 1171proc IsoControl_IsolineColor item { 1172 global isoControl 1173 1174 if { $isoControl(isoline_color) == "monocolor" } { 1175 $isoControl(bmc) config -state normal 1176 } else { 1177 $isoControl(bmc) config -state disabled 1178 } 1179} 1180 1181 1182proc IsoControl_Animate what { 1183 global isoControl prop 1184 1185 if { ![info exists isoControl(stop_playing)] } { 1186 set isoControl(stop_playing) 0 1187 } 1188 1189 # 1190 # when I will do PLANE123 simultaneously animation, the isoControl(plane) 1191 # plane must be called as last with IsoControl_SetCurrentSlide routine, 1192 # because isoControl(current_text_slide) variable is set in this routine 1193 # 1194 set do 1 1195 set item $isoControl(plane) 1196 xcDebug "IsoControl_Animate: $item $isoControl(anim_step) $isoControl($item,current_slide) / $isoControl($item,nslide)" 1197 1198 if $isoControl(anim_apply_to_all) { 1199 if { $item == 1 } { 1200 set item {2 3 1} 1201 } elseif { $item == 2 } { 1202 set item {3 1 2} 1203 } else { 1204 set item {1 2 3} 1205 } 1206 } 1207 switch -exact -- $what { 1208 stop { 1209 set isoControl(stop_playing) [expr {$isoControl(stop_playing) ? 0 : 1}] 1210 } 1211 first { 1212 foreach i $item { 1213 if { $isoControl($i,current_slide) == 1 && \ 1214 [llength $item] == 1 } { 1215 return 1216 } 1217 set isoControl($i,current_slide) 1 1218 } 1219 } 1220 backward { 1221 SetWatchCursor 1222 while $do { 1223 set finished 0 1224 set nitems [llength $item] 1225 foreach i $item { 1226 set do 0 1227 if { $isoControl($i,current_slide) == 1 } { 1228 incr finished 1229 } 1230 if { $isoControl($i,current_slide) > 1 } { 1231 IsoControl_SetCurrentSlide $i -$isoControl(anim_step) 1232 set do 1 1233 } 1234 } 1235 if { $finished == $nitems || $isoControl(stop_playing)} { 1236 set do 0 1237 set isoControl(stop_playing) 0 1238 ResetCursor 1239 xcSwapBuffers 1240 return 1241 } 1242 IsoControl_UpdateColorplane 1243 1244 after $isoControl(time_delay) 1245 } 1246 ResetCursor 1247 xcSwapBuffers 1248 return 1249 } 1250 previous { 1251 foreach i $item { 1252 if { $isoControl($i,current_slide) == 1 && \ 1253 [llength $item] == 1 } { 1254 return 1255 } 1256 IsoControl_SetCurrentSlide $i -$isoControl(anim_step) 1257 } 1258 } 1259 next { 1260 foreach i $item { 1261 if { $isoControl($i,current_slide) == \ 1262 $isoControl($i,nslide) && [llength $item] == 1 } { 1263 return 1264 } 1265 IsoControl_SetCurrentSlide $i $isoControl(anim_step) 1266 } 1267 } 1268 forward { 1269 SetWatchCursor 1270 while $do { 1271 set finished 0 1272 set nitems [llength $item] 1273 foreach i $item { 1274 set do 0 1275 if { $isoControl($i,current_slide) == $isoControl($i,nslide) } { 1276 incr finished 1277 } 1278 if { $isoControl($i,current_slide) < $isoControl($i,nslide) } { 1279 IsoControl_SetCurrentSlide $i $isoControl(anim_step) 1280 set do 1 1281 } 1282 } 1283 if { $finished == $nitems || $isoControl(stop_playing) } { 1284 set do 0 1285 set isoControl(stop_playing) 0 1286 ResetCursor 1287 xcSwapBuffers 1288 return 1289 } 1290 IsoControl_UpdateColorplane 1291 1292 after $isoControl(time_delay) 1293 } 1294 ResetCursor 1295 xcSwapBuffers 1296 return 1297 } 1298 last { 1299 foreach i $item { 1300 if { $isoControl($i,current_slide) == \ 1301 $isoControl($i,nslide) && [llength $item] == 1 } { 1302 return 1303 } 1304 set isoControl($i,current_slide) $isoControl($i,nslide) 1305 } 1306 } 1307 } 1308 1309 set i $isoControl(plane) 1310 set isoControl(current_text_slide) "Current slide: $isoControl($i,current_slide) / $isoControl($i,nslide)" 1311 1312 IsoControl_UpdateColorplane 1313} 1314 1315 1316proc IsoControl_SetCurrentSlide {i incr} { 1317 global isoControl 1318 1319 xcDebug "IsoControl_SetCurrentSlide: $i, $incr" 1320 incr isoControl($i,current_slide) $incr 1321 if { $isoControl($i,current_slide) < 1 } { 1322 set isoControl($i,current_slide) 1 1323 } elseif { $isoControl($i,current_slide) > $isoControl($i,nslide) } { 1324 set isoControl($i,current_slide) $isoControl($i,nslide) 1325 } 1326 # 1327 # update isoControl(current_text_slide) only if isoControl(plane) plane 1328 # is requested 1329 # 1330 if { $i == $isoControl(plane) } { 1331 set isoControl(current_text_slide) "Current slide: $isoControl($i,current_slide) / $isoControl($i,nslide)" 1332 update 1333 } 1334 xcDebug "IsoControl_SetCurrentSlide: $i $incr $isoControl($i,current_slide) / $isoControl($i,nslide)" 1335 1336} 1337 1338 1339 1340proc IsoControlCan {t {dim 3}} { 1341 global isoControl isosurf 1342 1343 #set button [tk_dialog [WidgetName] WARNING "Are You sure to Close PropertyPlane/IsoSurface. All data will be lost.\n\n Really Close???" warning 0 No Yes] 1344 #if { $button == 0 } { 1345 # return 1346 #} 1347 #unset isosurf(3Dinterpl_degree_old) 1348 #unset isoControl(1,nslide) 1349 #unset isoControl(2,nslide) 1350 #unset isoControl(3,nslide) 1351 #xcTraceDelete nxdir 1352 #xcTraceDelete nydir 1353 #xcTraceDelete nzdir 1354 #xcTraceDelete isosurf(3Dinterpl_degree) 1355 #xc_iso finish 1356 #.mesa render 1357 1358 # display-off the isosurface and colorplanes 1359 1360 if { $dim == 3 } { 1361 set isoControl(close,isosurf) $isoControl(isosurf) 1362 } 1363 set isoControl(close,colorplane) $isoControl(colorplane) 1364 set isoControl(close,isoline) $isoControl(isoline) 1365 1366 set isoControl(isosurf) 0 1367 set isoControl(colorplane) 0 1368 set isoControl(isoline) 0 1369 if { $dim == 3 } { 1370 foreach i {1 2 3} { 1371 set isoControl(close,$i,colorplane) $isoControl($i,colorplane) 1372 set isoControl(close,$i,isoline) $isoControl($i,isoline) 1373 set isoControl($i,colorplane) 0 1374 set isoControl($i,isoline) 0 1375 } 1376 UpdateIsosurf 1377 } elseif { $dim == 2 } { 1378 UpdatePropertyPlane 1379 } 1380 CancelProc $t 1381} 1382 1383 1384 1385proc IsoControlSave {} { 1386 global xcMisc system 1387 1388 set filehead [file tail [filehead $xcMisc(titlefile)]] 1389 set filetypes { 1390 {{XCrySDen Structure File} {.xsf} } 1391 {{All Files} * } 1392 } 1393 cd $system(PWD) 1394 set sfile [tk_getSaveFile -initialdir [pwd] \ 1395 -title "Save Calculated Grid of Points" \ 1396 -defaultextension .xsf \ 1397 -initialfile $filehead.xsf \ 1398 -filetypes $filetypes] 1399 cd $system(SCRDIR) 1400 if { $sfile == {} } { 1401 return 0 1402 } 1403 1404 set ident1 UNKNOWN 1405 set ident2 {} 1406 # Let the user specify some identifier for the datagrid 1407 OneEntryToplevel [WidgetName] "DataGrid Identifier" Identifier \ 1408 "Please specify identifier for DataGrid:" 80 ident2 text 30 30 1409 if { $ident2 == "" } { 1410 set ident2 DataGrid_generated_by_XCrySDen1.0 1411 } 1412 regsub -all { } $ident2 _ ident2 1413 1414 if [winfo exists .iso] { 1415 # 3D 1416 set dg DATAGRID3D 1417 } elseif [winfo exists .iso2D] { 1418 #2D 1419 set dg DATAGRID2D 1420 } 1421 1422 _IsoControlSave $sfile $ident1 $ident2 $dg 1423} 1424 1425proc _IsoControlSave {sfile ident1 ident2 dg} { 1426 global system 1427 1428 xc_iso save $sfile $ident1 1429 1430 # take care about the newlines newline 1431 set content [ReadFile -nonewline $system(SCRDIR)/xc_struc.$system(PID)] 1432 set datablock 0 1433 set out {} 1434 foreach line [split $content \n] { 1435 if [string match BEGIN_BLOCK_* $line] { 1436 set datablock 1 1437 } 1438 if !$datablock { 1439 append out "$line\n" 1440 } 1441 if [string match END_BLOCK_* $line] { 1442 set datablock 0 1443 } 1444 } 1445 append out "BEGIN_BLOCK_$dg\n" 1446 append out "$ident2\n" 1447 append out [ReadFile -nonewline $sfile] 1448 append out "\nEND_BLOCK_$dg" 1449 WriteFile $sfile $out w 1450} 1451 1452 1453 1454proc ConvertTwoSideVar {{var {}}} { 1455 global isosurf 1456 1457 if { ! [info exists isosurf(old_twoside_lighting)] } { 1458 set isosurf(old_twoside_lighting) off 1459 } 1460 1461 if { $var == {}} { 1462 switch -exact -- $isosurf(twoside_lighting) { 1463 0 { set isosurf(twoside_lighting) off } 1464 1 { set isosurf(twoside_lighting) on } 1465 } 1466 } else { 1467 switch -exact -- $var { 1468 on - 1 - true { 1469 xc_setGLparam lightmodel -two_side_iso 1 1470 1471 # (GL_CCW,GL_CW): this is a dirty trick, namely, the 1472 # two-side lighting is taking for negative-isosurface 1473 # the back-side as front side and vice versa 1474 if { $isosurf(old_twoside_lighting) == "off" } { 1475 xc_setGLparam isonormal -what isosurf_neg 1476 } 1477 } 1478 off - 0 - false { 1479 xc_setGLparam lightmodel -two_side_iso 0 1480 1481 # (GL_CCW,GL_CW): this is a dirty trick, namely, the 1482 # two-side lighting is taking for negative-isosurface 1483 # the back-side as front side and vice versa 1484 if { $isosurf(old_twoside_lighting) == "on" } { 1485 xc_setGLparam isonormal -what isosurf_neg 1486 } 1487 } 1488 } 1489 # now render the changes 1490 .mesa render 1491 1492 set isosurf(old_twoside_lighting) $var 1493 } 1494} 1495 1496 1497 1498proc RevertIsoSides what { 1499 global openGL 1500 1501 # just in case if openGL(isoside_$what) does not exist 1502 if ![info exists openGL(isoside_$what)] { 1503 set openGL(isoside_$what) [xc_getGLparam frontface -what isosurf_$what] 1504 xcDebug "openGL(isoside_$what):: $openGL(isoside_$what)" 1505 } 1506 1507 if { $openGL(isoside_$what) == "CCW" } { 1508 set openGL(isoside_$what) "CW" 1509 } else { 1510 set openGL(isoside_$what) "CCW" 1511 } 1512 1513 xc_setGLparam frontface -what isosurf_$what \ 1514 -frontface $openGL(isoside_$what) 1515 # now render the changes 1516 .mesa render 1517} 1518 1519 1520proc RevertIsoNormals what { 1521 global openGL 1522 1523 xc_setGLparam isonormal -what isosurf_$what 1524 # now render the changes 1525 .mesa render 1526} 1527 1528 1529proc SurfaceSmoothing {} { 1530 global isoControl fillEntries 1531 1532 set isoControl(smooth_nstep) [xc_iso get smoothsteps] 1533 set isoControl(smooth_weight) [xc_iso get smoothwieght] 1534 1535 set t [xcToplevel [WidgetName] "Surface Smoothing" "SurfSmooth" \ 1536 .iso 20 20 1] 1537 1538 message $t.m -aspect 800 \ 1539 -relief groove -bd 2 \ 1540 -text "Reasonable values for weight are between 0.1 and 1. Lighter weight will require more steps for smoothing, but will perturb the surface less !!!" 1541 pack $t.m -side top -padx 3m -pady 3m -ipadx 1m -ipady 1m 1542 1543 set f [frame $t.f] 1544 1545 FillEntries $t { 1546 "Smoothing steps:" 1547 "Smoothing weight:" 1548 } {isoControl(smooth_nstep) isoControl(smooth_weight)} 17 7 1549 set foclist $fillEntries 1550 set varlist { 1551 {isoControl(smooth_nstep) int} {isoControl(smooth_weight) real} 1552 } 1553 1554 button $t.b1 -text "Close" -command [list CancelProc $t] 1555 button $t.b2 -text "Update" \ 1556 -command [list SurfaceSmoothingOK $t $foclist $varlist] 1557 1558 pack $f -side bottom -expand 1 -fill both -padx 3m -pady 3m 1559 pack $t.b1 $t.b2 -side left -expand 1 -padx 2m -pady 2m 1560} 1561proc SurfaceSmoothingOK {t foclist varlist} { 1562 global isoControl 1563 1564 if ![check_var $varlist $foclist] { 1565 return 1566 } 1567 xc_iso smoothsteps $isoControl(smooth_nstep) 1568 xc_iso smoothweight $isoControl(smooth_weight) 1569 xc_iso smoothing 1570 UpdateIsosurf 1571 return 1572} 1573 1574 1575 1576proc IsoControlCommand {} { 1577 global isoControl prop 1578 1579 if $prop(pm_isolevel) { 1580 # 1581 # render +isolevel and -isolevel isosurfaces 1582 # 1583 1584 $isoControl(color_button) configure -command \ 1585 [list MultiWidget {} -b_height 2 -testbutton 1 \ 1586 -create_tplw 1 \ 1587 -tplw_args {xcToplevel [WidgetName] "Set OpenGL parameters" \ 1588 "OpenGLPar"} \ 1589 -command { \ 1590 {"Front Side Color\nfor positive values" \ 1591 {SetOpenGLPar _POS_FRONT_COLOR_ ISOSURF}} \ 1592 {"Back Side Color\nfor positive values" \ 1593 {SetOpenGLPar _POS_BACK_COLOR_ ISOSURF}} \ 1594 {"Front Side Color\nfor negative values" \ 1595 {SetOpenGLPar _NEG_FRONT_COLOR_ ISOSURF}} \ 1596 {"Back Side Color\nfor negative values" \ 1597 {SetOpenGLPar _NEG_BACK_COLOR_ ISOSURF}} } \ 1598 -bottom_button { \ 1599 {Close CancelProc} {Update UpdateOpenGLPar} } ] 1600 1601 $isoControl(blend_button) configure -command \ 1602 [list MultiWidget [WidgetName] -b_height 2 -testbutton 2 \ 1603 -create_tplw 1 \ 1604 -tplw_args {xcToplevel [WidgetName] "Set OpenGL parameters" \ 1605 "OpenGLPar"} \ 1606 -command { \ 1607 {"Transparency" \ 1608 {SetOpenGLPar _BLEND_ ISOSURF}} \ 1609 {"Front Side Color\nfor positive values" \ 1610 {SetOpenGLPar _POS_FRONT_COLOR_ ISOSURF}} \ 1611 {"Back Side Color\nfor positive values" \ 1612 {SetOpenGLPar _POS_BACK_COLOR_ ISOSURF}} \ 1613 {"Front Side Color\nfor negative values" \ 1614 {SetOpenGLPar _NEG_FRONT_COLOR_ ISOSURF}} \ 1615 {"Back Side Color\nfor negative values" \ 1616 {SetOpenGLPar _NEG_BACK_COLOR_ ISOSURF}} } \ 1617 -bottom_button { \ 1618 {Close CancelProc} {Update UpdateOpenGLPar} } ] 1619 $isoControl(revert_button1) configure -state normal 1620 $isoControl(revert_button2) configure -state normal 1621 } else { 1622 # 1623 # render just isolevel isosurface 1624 # 1625 $isoControl(color_button) configure -command \ 1626 [list MultiWidget {} -b_height 2 -testbutton 1 \ 1627 -create_tplw 1 \ 1628 -tplw_args {xcToplevel [WidgetName] "Set OpenGL parameters" \ 1629 "OpenGLPar"} \ 1630 -command { \ 1631 {"Front Side Color" \ 1632 {SetOpenGLPar _ONE_FRONT_COLOR_ ISOSURF}} \ 1633 {"Back Side Color" \ 1634 {SetOpenGLPar _ONE_BACK_COLOR_ ISOSURF}} } \ 1635 -bottom_button { \ 1636 {Close CancelProc} {Update UpdateOpenGLPar} } ] 1637 1638 $isoControl(blend_button) configure -command \ 1639 [list MultiWidget [WidgetName] -b_height 2 -testbutton 2 \ 1640 -create_tplw 1 \ 1641 -tplw_args {xcToplevel [WidgetName] "Set OpenGL parameters" \ 1642 "OpenGLPar"} \ 1643 -command { \ 1644 {"Transparency" \ 1645 {SetOpenGLPar _BLEND_ ISOSURF}} \ 1646 {"Front Side Color" \ 1647 {SetOpenGLPar _ONE_FRONT_COLOR_ ISOSURF}} \ 1648 {"Back Side Color" \ 1649 {SetOpenGLPar _ONE_BACK_COLOR_ ISOSURF}} } \ 1650 -bottom_button { \ 1651 {Close CancelProc} {Update UpdateOpenGLPar} } ] 1652 $isoControl(revert_button1) configure -state disabled 1653 $isoControl(revert_button2) configure -state disabled 1654 } 1655} 1656 1657 1658# procs for updateing the font for thermometer 1659proc isoControl_thermoFont {} { 1660 global isoControl 1661 1662 puts stderr "*** 1. isoControl_thermoFont: $isoControl(cpl_thermoFont)" 1663 1664 set font [fontToplevelWidget [WidgetName] \ 1665 "Sample Font Text" $isoControl(cpl_thermoFont)] 1666 1667 puts stderr "*** 2. isoControl_thermoFont: $font" 1668 1669 global isoControl 1670 if { $font != {} } { 1671 set isoControl(cpl_thermoFont) $font 1672 } 1673} 1674