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/xcInit.tcl 11# ------ # 12# Copyright (c) 1996-2003 by Anton Kokalj # 13############################################################################# 14 15############################################################################### 16# xcrysden TEMPORARY FILES: 17# 18# xc_gengeom.$$ --- produced with gengeom with M1_INFO 19# xc_struc.$$ --- produced with gengeom with .not. M1_INFO -> used by xcrys 20# xc_str2xcr.$$ --- produced by str2xcr program (converted WIEN2k struct file 21# to "xsf" format) 22# xc_wnstr.struct--- temporary WIEN2k struct file 23# xc_wienstruct.$$-- wien struct file (copy of original WIEN2k struct file) 24# xc_inp.$$ --- crystal95's input (also xc_tmp.$$) 25# xc_output.$$ --- crystal95's output 26# xc_tmp.$$ --- something insignificant 27# xc_bin.$$ --- binary file produced by "xcrys" interpreter; used 28# for isosurface evaluation 29# xc_binVrt.$$ --- binary file produced by "xcrys" interpreter; used 30# to stote the current gridvertices 31# xc_datagrid.$$ --- binary file where datagrid from DATAGRIDXD is stored 32# xc_ndsfp.$$ --- Wigner-Seitz nodes:: nodes for primitive cell mode 33# xc_ndsfc.$$ --- Wigner-Seitz nodes:: nodes for conventional cell mode 34# xc_klist.$$ --- k-list-file for the kPath program 35# xc_rho.$$ --- rho-3Ddatagrid file for WIEN 36# here are variables that need to be initialised more than once 37 38proc InitGlobalVar {} { 39 global species nxdir nydir nzdir \ 40 periodic \ 41 inp n_groupsel groupsel AdvGeom \ 42 prop \ 43 XCState \ 44 dispmode mode2D \ 45 geng \ 46 ws \ 47 colSh \ 48 sInfo \ 49 system \ 50 isoControl \ 51 openGL \ 52 undoMenu undoAdvGeom \ 53 pDen \ 54 colSh \ 55 xsfAnim gifAnim \ 56 light \ 57 glLight \ 58 atomLabel \ 59 toglEPS 60 61 # 62 # array xcMisc will be used for various things; it is to prevent to many 63 # global variables 64 # 65 # xcMisc(titlefile) ... name of the file that appears on the main window 66 # title 67 68 set species {} 69 70 set nxdir 1 71 set nydir 1 72 set nzdir 1 73 74 # PERIODIC global variable -> data about dimensionality goes here 75 # periodic(dim) ... what is the dimensionality of the system 76 set periodic(dim) 0 77 set periodic(igroup) 1; #igroup according to gengeom program 78 79 set dispmode(style) 3D 80 set mode2D(WF) Off 81 set mode2D(PL) Off 82 set mode2D(PB) Off 83 set mode2D(BS1) Off 84 set mode2D(BS2) Off 85 set mode2D(SF) Off 86 87 set arraylist [list inp AdvGeom XCState prop] 88 89 set varlist [list n_groupsel groupsel] 90 91 foreach array $arraylist { 92 if [array exists $array] { unset $array } 93 } 94 foreach var $varlist { 95 if [info exists $var] { unset $var } 96 } 97 98 #default #3 gengeom's argument is 1 99 if { ! [info exists system(c95_version)] } { set system(c95_version) none } 100 set geng(M3_ARGUMENT) [GetGengM3Arg ANGS $system(c95_version)] 101 102 # what to do with IsoXXXX ??? 103 # close all other toplevels ??? 104 105 # WIGNER-SEITZ CELL 106 set ws(not_config_yet) 1 107 108 # initialization of mody array 109 ModConst 110 111 # this is associated with XCRYSDEN INFO RECORD (core xcrys interpreter) 112 if { [info exists sInfo] } { unset sInfo } 113 114 if ![info exists colSh] { 115 set colSh(scheme) atomic 116 set colSh(slab_fractional) 1 117 set colSh(slab_dir) "-z" 118 set colSh(slab_colbas) monochrome 119 set colSh(slab_coltyp) combined 120 set colSh(slab_alpha) 0.65 121 set colSh(dist_x) 0.0 122 set colSh(dist_y) 0.0 123 set colSh(dist_z) 0.0 124 set colSh(dist_r) 1.0 125 set colSh(dist_colbas) monochrome 126 set colSh(dist_coltyp) combined 127 set colSh(dist_alpha) 0.65 128 } 129 130 # this should be the same as ISOLINE_MAXLEVEL in isosurf.h file 131 set isoControl(max_allowed_2Dnisoline) 100 132 133 ################################ 134 # initialization of openGL array 135 ################################ 136 set openGL(src_blend_list) { 137 GL_ZERO 138 GL_ONE 139 GL_DST_COLOR 140 GL_ONE_MINUS_DST_COLOR 141 GL_SRC_ALPHA 142 GL_ONE_MINUS_SRC_ALPHA 143 GL_DST_ALPHA 144 GL_ONE_MINUS_DST_ALPHA 145 GL_SRC_ALPHA_SATURATE 146 } 147 148 set openGL(dst_blend_list) { 149 GL_ZERO 150 GL_ONE 151 GL_SRC_COLOR 152 GL_ONE_MINUS_SRC_COLOR 153 GL_SRC_ALPHA 154 GL_ONE_MINUS_SRC_ALPHA 155 GL_DST_ALPHA 156 GL_ONE_MINUS_DST_ALPHA 157 } 158 159 160 xc_setGLparam frontface -what isosurf_one -frontface CCW 161 xc_setGLparam frontface -what isosurf_pos -frontface CCW 162 xc_setGLparam frontface -what isosurf_neg -frontface CCW 163 164 set pos [xc_getGLparam frontface -what isosurf_pos] 165 set neg [xc_getGLparam frontface -what isosurf_neg] 166 #xcDebug -stderr "Pos: $pos" 167 #xcDebug -stderr "Neg: $neg" 168 set openGL(isoside_pos) [lindex $pos 0] 169 set openGL(isoside_neg) [lindex $neg 0] 170 171 set openGL(front_ambient_R) 0 172 set openGL(front_ambient_G) 0 173 set openGL(front_ambient_B) 0 174 175 set openGL(front_diffuse_R) 0 176 set openGL(front_diffuse_G) 0 177 set openGL(front_diffuse_B) 0 178 179 set openGL(front_specular_R) 0 180 set openGL(front_specular_G) 0 181 set openGL(front_specular_B) 0 182 183 set openGL(front_emission_R) 0 184 set openGL(front_emission_G) 0 185 set openGL(front_emission_B) 0 186 187 #### 188 189 set openGL(back_ambient_R) 0 190 set openGL(back_ambient_G) 0 191 set openGL(back_ambient_B) 0 192 193 set openGL(back_diffuse_R) 0 194 set openGL(back_diffuse_G) 0 195 set openGL(back_diffuse_B) 0 196 197 set openGL(back_specular_R) 0 198 set openGL(back_specular_G) 0 199 set openGL(back_specular_B) 0 200 201 set openGL(back_emission_R) 0 202 set openGL(back_emission_G) 0 203 set openGL(back_emission_B) 0 204 205 set undoMenu(active_fg) #ffffff 206 set undoMenu(active_bg) #0000ff 207 set undoMenu(default_fg) #000000 208 set undoMenu(default_bg) #ffffff 209 210 set undoAdvGeom(start_index) 0 211 set undoAdvGeom(current_index) 0 212 set undoAdvGeom(list) {} 213 set undoAdvGeom(redo_start_index) 0 214 set undoAdvGeom(redo_current_index) 0 215 set undoAdvGeom(redo_list) {} 216 217 if [info exists pDen(nsurface)] { unset pDen(nsurface) } 218 set pDen(type) gauss 219 set pDen(radius) cov 220 set pDen(level) 1.0 221 set pDen(cutoff) 1.0 222 set pDen(colorscheme) atomic 223 set pDen(drawstyle) wire 224 set pDen(surfacetype) molsurf 225 set pDen(resolution) 0.35 226 set pDen(smoothsteps) 0 227 set pDen(smoothweight) 0.2 228 set pDen(transparent) 0 229 set pDen(shademodel) smooth 230 set pDen(monocolor) {0.8 0.8 0.2} 231 set pDen(tessellation) cube 232 set pDen(normals) gradient 233 234 set pDen(t_type) GAUSSIAN 235 set pDen(t_radius) {Covalent radii} 236 set pDen(t_colorscheme) {Atomic colors} 237 set pDen(t_drawstyle) Wire 238 set pDen(t_surfacetype) {Pseudo density} 239 set pDen(t_shademodel) Smooth 240 set pDen(t_tessellation) Cube 241 set pDen(t_normals) Gradient 242 243 set colSh(slabrange_min) 0.00 244 set colSh(slabrange_max) 1.00 245 246 set xsfAnim(not_anim) 0 247 248 set gifAnim(create) 0 249 set gifAnim(gif_transp) 0 250 set gifAnim(gif_minimize) 0 251 set gifAnim(gif_global_colormap) 0 252 set gifAnim(edit_param) 1 253 set gifAnim(movie_format) mpeg 254 set gifAnim(temp_files_dir) tmp 255 set gifAnim(frame_files_format) PPM 256 set gifAnim(ntime_first_frame) 1 257 set gifAnim(ntime_last_frame) 1 258 set gifAnim(delay) 10 259 set gifAnim(loop) 0 260 set gifAnim(make_gifAnim) 0 261 262 263 set atomLabel(fontBrowser) "Simple Font Browser" 264 set atomLabel(globalFont) "" 265 set atomLabel(globalFont.brightColor) {1.0 1.0 1.0} 266 set atomLabel(globalFont.darkColor) {0.0 0.0 0.0} 267 set atomLabel(globalFont.do_display) 1 268 269 set atomLabel(atomFont) "" 270 set atomLabel(atomFont.id) "" 271 set atomLabel(atomFont.label) "" 272 set atomLabel(atomFont.brightColor) {1.0 1.0 1.0} 273 set atomLabel(atomFont.darkColor) {0.0 0.0 0.0} 274 set atomLabel(atomFont.do_display) 1 275 276 set light On 277 #if { ! [info exists glLight(nlights)] } { 278 # set glLight(nlights) 6 279 #} 280 281 set toglEPS(DRAW_BACKGROUND) 0 282 set toglEPS(SIMPLE_LINE_OFFSET) 0 283 set toglEPS(SILENT) 0 284 set toglEPS(BEST_ROOT) 1 285 set toglEPS(OCCLUSION_CULL) 1 286 set toglEPS(NO_TEXT) 0 287 set toglEPS(LANDSCAPE) 0 288 set toglEPS(NO_PS3_SHADING) 0 289 set toglEPS(NO_PIXMAP) 0 290 set toglEPS(NO_BLENDING) 0 291} 292 293 294proc xcInit {} { 295 #global system Const geng 296 297 # take care of the scratch directory 298 if { ! [file isdirectory $system(SCRDIR)] } { 299 puts stderr "ERROR: SCRATCH directory \"$system(SCRDIR)\" does not exist" 300 exit 1 301 } 302 if { ! [file writable $system(SCRDIR)] } { 303 error "SCRATCH directory \"$system(SCRDIR)\" is not writeable" 304 exit 1 305 } 306 307 set system(USER_DIR) $system(TOPDIR) 308 309 ###################################################################### 310 # initialize XCRYSDEN'S LIBRARY: variables needed for keeping xcrysden 311 # alive will be loaded here 312 set xcMisc(status_init_label) "Initializing library ..." 313 source $system(TOPDIR)/Tcl/xcInitLib.tcl 314 315 ########################################################## 316 # now read the user-custom file; USER MAY CHANGE SOMETHING 317 # if ![user-custom-file present] 318 if { [file exists $env(HOME)/.xcrysden/custom-definitions] } { 319 source $env(HOME)/.xcrysden/custom-definitions 320 } else { 321 source $system(TOPDIR)/Tcl/custom-definitions 322 } 323 # backward compatibility; now in custom-definitions we use 324 # xcMisc(printCommand) for consistency 325 if { [info exists xcMisc(printCommand)] } { 326 set printCanvas(printCommand) $xcMisc(printCommand) 327 } 328 329 #if $xcMisc(debug) { 330 # #debug 331 # #lappend auto_path $xcMisc(dev_dir) 332 #} 333 334 # ------------------------------------------------------------------------ 335 # GOTO $system(SCRDIR) 336 cd $system(SCRDIR) 337 # ------------------------------------------------------------------------ 338 # make the 444 core file on $system(SCRDIR) 339 catch {exec touch core} 340 catch {exec chmod 444 core} 341 342 343 ########################### 344 # make some subdirectories; so far we need just 1 345 if { [file isdirectory $system(SCRDIR)/dir1] } { 346 file delete -force $system(SCRDIR)/dir1 347 } 348 file mkdir $system(SCRDIR)/dir1 349 set system(SCRDIR_1) $system(SCRDIR)/dir1 350 351 352 set xcMisc(status_init_label) "Checking packages ..." 353 ####################################################################### 354 # check software packages 355 356 check_package_awk 357 check_package_terminal 358 check_package_crystal 359 find_package_imagemagick 360 find_package_gifsicle 361 find_package_whirlgif 362 find_package_mencoder 363 find_package_ppmtompeg 364 find_package_babel 365 find_package_xwd 366 find_package_xsf2_manipulator 367 368 determine_movie_encoders 369 370 ####################################################################### 371 372 ################### 373 # FORTRAN UNIT NAME 374 set system(ftn_name) [FtnName] 375 376 ################################################# 377 # IMPORTANT CONSTANTS 378 # ----------------------------------------------- 379 set Const(bohr) 0.529177; # conversion factor for Ang/Bohr in c95 380 381 ################################################## 382 # INITIALIZATION OF GLOBAL VARIABLES 383 # ------------------------------------------------ 384 set xcMisc(status_init_label) "Creating initializing variables ..." 385 InitGlobalVar 386 387 ################################################## 388 # load atom names 389 AtomNames 390 391 ################################################### 392 # THIS IS FOR GENGEOM PROGRAM 393 # usage of "gengeom" program: 394 # 395 # gengeom MODE1 MODE2 MODE3 IGRP NXDIR NYDIR NZDIR OUTPUT INPUT 396 # 0 1 2 3 4 5 6 7 8 9 397 # 398 set geng(M1_INFO) 0; #INFO mode 399 set geng(M1_PRIM) 1; #PRIMITIV CELL; in case of H/R PARAPIPEDAL SHAPE 400 set geng(M1_CONV) 2; #CONVENTIONAL CELL; in case of H/R it is PARAP. SHAPE 401 set geng(M1_HEXA_SHAPE) 3; #THREEPLE CELL for H/R; HEXAGONAL SHAPE 402 set geng(M1_PRIM3) 4; #PRIMITIV cell for H/R; HEXAGONAL SHAPE 403 404 set geng(M2_CELL) 1; #CELL is unit of repetition 405 set geng(M2_TR_ASYM_UNIT) 2; #translation asymetric unit is unit of repetition 406 #default gengeom's #3 argument 407 set geng(M3_ARGUMENT) [GetGengM3Arg ANGS $system(c95_version)] 408 409 set geng(IGRP_HEXA) 8; # hexagonal groups 410 set geng(IGRP_TRIG) 9; # trigonal groups 411 412 wm iconbitmap . @$system(BMPDIR)/xcrysden.xbm 413 #wm iconmask . @$system(BMPDIR)/xcrysden_mask.xbm 414 415 set xcMisc(status_init_label) "Building GUI ..." 416} 417 418 419 420 421 422################################################################### 423### MAIN --- MAIN --- MAIN --- MAIN --- MAIN --- MAIN --- MAIN ### 424################################################################### 425 426package provide Tk ; #puts stderr tk_version=$tk_version 427 428# ------------------------------------------------------------------------ 429# First process the "argc/argv". The order of arguments is 430# XCRYSDEN_TOPDIR XCRYSDEN_SCRATCH and the user specified command line 431# options 432# ------------------------------------------------------------------------ 433 434set system(TOPDIR) [lindex $argv 0] 435set system(SCRDIR) [lindex $argv 1] 436 437# ------------------------------------------------------------------------ 438# Load xcrys.dll 439# ------------------------------------------------------------------------ 440if { [file exists $system(TOPDIR)/bin/xcrys.dll] } { 441 load $system(TOPDIR)/bin/xcrys.dll 442} elseif { [info exists env(XCRYSDEN_LIB_BINDIR)] && [file exists $env(XCRYSDEN_LIB_BINDIR)/xcrys.dll] } { 443 load $env(XCRYSDEN_LIB_BINDIR)/xcrys.dll 444} 445 446# ------------------------------------------------------------------------ 447# some dirty fixes needed to get the program work under CYGWIN 448# ------------------------------------------------------------------------ 449source $system(TOPDIR)/Tcl/cygwin.tcl 450 451# ------------------------------------------------------------------------ 452# Load Bwidgets package 453# ------------------------------------------------------------------------ 454 455set bwidget [glob -nocomplain $system(TOPDIR)/external/lib/bwidget-*] 456if { $bwidget != "" } { 457 set BWidget_dir $bwidget 458 lappend auto_path $BWidget_dir 459} 460package require BWidget 461 462# ------------------------------------------------------------------------ 463# take care of trace/fulltrace utility 464# ------------------------------------------------------------------------ 465 466if { [info exists env(XCRYSDEN_TRACE)] || [info exists env(XCRYSDEN_FULLTRACE)] } { 467 # BWidget needs some special treatment if XCTR is enabled 468 foreach file [glob $BWidget_dir/*.tcl] { 469 if { $file != "$BWidget_dir/pkgIndex.tcl" && [file exists $file] } { 470 source $file 471 } 472 } 473 474 # take care of XCTR 475 set xctr(recording) 0 476 source [file join $system(TOPDIR) Tcl xctr.tcl] 477} 478 479#source $system(TOPDIR)/Tcl/parseComLinArg.tcl 480 481 482# ------------------------------------------------------------------------ 483# Palette 484# ------------------------------------------------------------------------ 485 486# this was the 0.3 palette: 487#tk_setPalette "#ddd" 488#tk_setPalette "#b5b193" 489#tk_setPalette "#ee9" 490#tk_setPalette "#bbb" 491 492 493# ------------------------------------------------------------------------ 494# check for stale files in $env(XCRYSDEN_SCRATCH) 495# ------------------------------------------------------------------------ 496proc clean_xcrysden_scratch {} { 497 global env 498 499 set time [clock seconds] 500 set five_days [expr 5*24*3600] 501 foreach item [glob -nocomplain -directory $env(XCRYSDEN_SCRATCH) xc_*] { 502 set item_time [file atime $item] 503 if { [expr {$time - $item_time}] > $five_days } { 504 lappend stale_item $item 505 } 506 } 507 508 if { [info exists stale_item] > 0 } { 509 set respond [tk_messageBox -parent . -type yesno -default yes -icon question \ 510 -title "Cleaning XCRYSDEN_SCRATCH ?" \ 511 -message "Possible stale files older then 10 days exist in XCRYSDEN_SCRATCH directory.\n\nDo you want to delete them?"] 512 513 if { $respond == "yes" } { 514 puts stderr "*** cleaning XCRYSDEN_SCRATCH directory: $stale_item" 515 catch { eval file delete -force $stale_item } 516 } 517 } 518} 519clean_xcrysden_scratch 520 521 522# ------------------------------------------------------------------------ 523# Welcome images 524# ------------------------------------------------------------------------ 525 526image create photo kpath -format gif \ 527 -file $system(TOPDIR)/images/xcrysden_kpath.gif 528image create photo welcome -format gif \ 529 -file $system(TOPDIR)/images/xcrysden-welcome.gif -width 480 -height 320 530 531 532# ------------------------------------------------------------------------ 533# make a WELCOME window 534# ------------------------------------------------------------------------ 535 536proc centerWelcome {thisWin} { 537 set w 500 538 set h 350 539 # root window height/width 540 set rh [winfo screenheight $thisWin] 541 set rw [winfo screenwidth $thisWin] 542 543 set reqX [expr {($rw-$w)/2}] 544 set reqY [expr {($rh-$h)/2}] 545 546 wm geometry $thisWin +${reqX}+${reqY} 547} 548 549puts stderr "Running on platform : $xcrys(platform)" 550puts stderr " Operating system : $tcl_platform(os)" 551 552if { "[lindex $argv 2]" != "--quiet" } { 553 554 # MACOSX has problems with wm iconify/wm deiconify requests, so 555 # don't use them 556 557 if { $tcl_platform(os) != "Darwin" } { 558 #catch {wm iconify .} 559 catch {wm withdraw .} 560 toplevel .title 561 frame .title.f -relief flat -bd 0 -bg #fff 562 label .title.f.l -image welcome -anchor center -relief flat -bd 0 563 set xcMisc(status_init_label) "Initializing ..." 564 label .title.f.l2 -textvariable xcMisc(status_init_label) \ 565 -relief flat -bd 0 566 pack .title.f 567 pack .title.f.l .title.f.l2 -side top -fill both -padx 0m -pady 0m 568 569 centerWelcome .title 570 571 wm overrideredirect .title true 572 update 573 } 574} 575 576 577# ------------------------------------------------------------------------ 578# load necessary initialization 579# ------------------------------------------------------------------------ 580 581eval [info body xcInit] 582 583 584# ------------------------------------------------------------------------ 585# start recording the tracing 586# ------------------------------------------------------------------------ 587 588set xctr(recording) 1 589 590# ------------------------------------------------------------------------ 591# do renaming such that exit is associated with clean_exit that cleans the TMPDIR 592# ------------------------------------------------------------------------ 593rename exit exit_tcl 594rename clean_exit exit 595 596# provide a custom "cd" when in debug mode to trace changing directories 597 598if { [info exists env(XCRYSDEN_DEBUG)] } { 599 rename cd cd_tcl 600 601 proc cd_debug {dir} { 602 puts stderr "*** " 603 puts stderr "*** cd into $dir" 604 puts stderr "*** " 605 cd_tcl $dir 606 } 607 608 rename cd_debug cd 609} 610 611# create a photo image "container" for printing into PPM files 612# (see file xcAppInit.c & togl_ppm.c) 613 614image create photo $xcrys(print.image) 615 616## simple variable debugger 617#proc tracer {varname args} { 618# upvar #0 $varname var 619# puts stderr "$varname was updated to be \"$var\" 620# from 621# [info level 0] 622# from 623# [info level 1] 624# from 625# [info level 2]" 626#} 627#trace add variable xcMisc(titlefile) write "tracer xcMisc(titlefile)" 628 629# ------------------------------------------------------------------------ 630# parse command-line options or simple start the Viewer 631# ------------------------------------------------------------------------ 632 633if { [llength $argv] > 2 } { 634 parseComLinArg [lrange $argv 2 end] 635} else { 636 ViewMol . 637} 638
