0030575: Tests - v3d/materials unstable image screenshots of alpha-blending on GeForc...

[occt.git] / src / DrawResources / DrawDefault

# Copyright (c) 1999-2014 OPEN CASCADE SAS
#
# This file is part of Open CASCADE Technology software library.
#
# This library is free software; you can redistribute it and/or modify it under
# the terms of the GNU Lesser General Public License version 2.1 as published
# by the Free Software Foundation, with special exception defined in the file
# OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT
# distribution for complete text of the license and disclaimer of any warranty.
#
# Alternatively, this file may be used under the terms of Open CASCADE
# commercial license or contractual agreement.

# This script is to be executed automatically at DRAWEXE start.
#
# For that to happen, either environment DRAWDEFAULT should be set pointing
# to this file, or CASROOT variable should be set, so that the script is
# found as $CASROOT/src/DrawResources/DrawDefault

# indicate that DRAW is interactive environment
set tcl_interactive 1

# define location of standard DRAW scripts; normally it is 
# $CASROOT/src/DrawResources
set dir ""
if { [info exists env(DRAWHOME) ] } { 
  set dir $env(DRAWHOME)  
} else {
  if { [info exists env(CASROOT) ] } {
    set dir [file join $env(CASROOT) src DrawResources]
  } else {
    puts "Warning: CASROOT is not defined, some features may not load correctly"
    set dir [file dirname [info script]]
  }
}

# load standard DRAW scripts
if { [file isdirectory $dir] } { 
  foreach script {StandardCommands.tcl Geometry.tcl StandardViews.tcl
                  TestCommands.tcl CheckCommands.tcl Vector.tcl} {
    if [file exist [file join $dir $script]] {
      source [file join $dir $script]
    } else {
      puts "Warning: could not find command file $script"
    }
  }

  # and TK extensions
  set stationname $tcl_platform(platform)
  if [info exists tk_version] {
    source [file join $dir DrawTK.tcl]
    # setup the icon for main window
    if { ${stationname} == "windows" } {
      wm iconbitmap . -default [file join $dir lamp.ico]
    }
    wm title . Draw
  }
} else {
  puts "Warning: could not find DRAW directory"
}

# set default testing environment (unless already defined before)
if { ! [info exists env(CSF_TestScriptsPath)] } {
  if {[info exists ::env(CSF_OCCTTestsPath)] && [file isdirectory $env(CSF_OCCTTestsPath)]} {
    set env(CSF_TestScriptsPath) $env(CSF_OCCTTestsPath)
  } elseif { [info exists env(CASROOT)] && [file isdirectory $env(CASROOT)/tests] } {
    set env(CSF_TestScriptsPath) $env(CASROOT)/tests
  }
}
if {[info exists ::env(CSF_OCCTDataPath)] && [file isdirectory $env(CSF_OCCTDataPath)]} {
  if { ! [info exists env(CSF_TestDataPath)] } {
    set env(CSF_TestDataPath) $env(CSF_OCCTDataPath)
  } else {
    set env(CSF_TestDataPath) $env(CSF_TestDataPath)[_path_separator]$env(CSF_OCCTDataPath)
  }
} elseif { [info exists env(CASROOT)] && [file isdirectory $env(CASROOT)/tests] } {
  if { ! [info exists env(CSF_TestDataPath)] } {
    set env(CSF_TestDataPath) $env(CASROOT)/data
  } else {
    set env(CSF_TestDataPath) $env(CSF_TestDataPath)[_path_separator]$env(CASROOT)/data
  }
}

# load application-defined initialization script, which is expected to 
# be found either in the file pointed by environment variable CSF_DrawAppliInit,
# or in the file DrawAppliInit in the current directory
set draw_appli_init_file DrawAppliInit
if { [info exists env(CSF_DrawAppliInit)] } {
  set draw_appli_init_file $env(CSF_DrawAppliInit)
} 
if { [file readable $draw_appli_init_file] } {
  if { [catch {source $draw_appli_init_file} res] } {
    puts "Warning: problem while loading file $draw_appli_init_file: $res"
  }
} 

# on Windows, set special handler to update automatically environment variables
# in C subsystem when Tcl environment changes (see Mantis issue #23197)
if { $tcl_platform(platform) == "windows" && ! [catch {dgetenv PATH}] } {
    proc _update_c_env {envenv var op} { 
        global env
        if { $op == "unset" } {
            if { $var != "" } {
                dsetenv $var
            } else {
	        #"array get env varname" command calls _update_c_env with op="unset" and var=""
		#It leads to detach of trace from env array
                trace add variable env array _update_c_env
                trace add variable env read  _update_c_env
                trace add variable env write _update_c_env
                trace add variable env unset _update_c_env
            }
        } elseif { $op == "write" } {
            dsetenv $var $env($var)
        } elseif { $op == "read" } {
            return dgetenv $var
        }
    }
    #Execute "trace add ..." block from _update_c_env proc
    _update_c_env env "" "unset"
}

# arm signal handler with default FPE setting
dsetsignal

# silent return from the script
return