mirror of
https://git.dev.opencascade.org/repos/occt.git
synced 2025-04-03 17:56:21 +03:00
e816dce36e
1) Extend Poly_Triangulation by mesh purpose, possibility to be cleared and late-load deferred data interfaces. 2) Update BRep_TFace to store list of triangulations istead of single one. And also active one. Update getter and setter of single triangulation and add new methods to interaction with whole triangulations list. 3) Update BRep_Tool to get single triangulation of face according to the input mesh purpose or whole triangulations list. 4) Update BRep_Builder to make face by not only single triangulation but whole triangulations list with specified active one. 5) Add new methods to BRepTools to interact with shape triangulations (Load/Unload/Activate/LoadAll/UnloadAllTriangulation(s)) 6) Add new 'tlateload'command for shape to load/unload/activate triangulations. 7) Update 'trinfo' command by '-lods' options to print detailaed information about LODs of this shape 8) Support empty triangulations by selection. Use bounding box selection in this case. 9) Add new 'outdisplist' option to XDispaly command to print list of displayed objects to output variable but not to theDI 10) Add new '-noecho' option to vdisplay command to skip printing of displayed objects to theDI 11) Create new RWMesh_TriangulationSource as mesh data wrapper for delayed triangulation loading. 12) Create new RWMesh_TriangulationReader as base interface for reading primitive array from the buffer. 13) Cache nodes/triangles number defined in glTF file 14) Use RWMesh_TriangulationSource class as base of RWGltf_GltfLatePrimitiveArray one and RWMesh_TriangulationReader class as base of RWGltf_TriangulationReader one 15) Add possibilty to support of LODs by glTF reader. It is possible to skip data loading and load them later 16) Add new '-skiplateloading' (to skip triangulation loading), '-keeplate' (to keep information about deferred storage to load/unload triangulation later), '-toprintdebuginfo' (to print additional debug information) options to ReadGltf command 17) Add new test of glTF late loading
1207 lines
40 KiB
Tcl
1207 lines
40 KiB
Tcl
# Copyright (c) 2013-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 file defines scripts for verification of OCCT tests.
|
|
# It provides top-level commands starting with 'check'.
|
|
# Type 'help check*' to get their synopsis.
|
|
# See OCCT Tests User Guide for description of the test system.
|
|
#
|
|
# Note: procedures with names starting with underscore are for internal use
|
|
# inside the test system.
|
|
############################################################################
|
|
|
|
help checkcolor {
|
|
Check pixel color.
|
|
Use: checkcolor x y red green blue
|
|
x y - pixel coordinates
|
|
red green blue - expected pixel color (values from 0 to 1)
|
|
Function check color with tolerance (5x5 area)
|
|
}
|
|
# Procedure to check color using command vreadpixel with tolerance
|
|
proc checkcolor { coord_x coord_y rd_get gr_get bl_get } {
|
|
puts "Coordinate x = $coord_x"
|
|
puts "Coordinate y = $coord_y"
|
|
puts "RED color of RGB is $rd_get"
|
|
puts "GREEN color of RGB is $gr_get"
|
|
puts "BLUE color of RGB is $bl_get"
|
|
|
|
if { $coord_x <= 1 || $coord_y <= 1 } {
|
|
puts "Error : minimal coordinate is x = 2, y = 2. But we have x = $coord_x y = $coord_y"
|
|
return -1
|
|
}
|
|
|
|
set color ""
|
|
catch { [set color "[vreadpixel ${coord_x} ${coord_y} rgb]"] }
|
|
if {"$color" == ""} {
|
|
puts "Error : Pixel coordinates (${position_x}; ${position_y}) are out of view"
|
|
}
|
|
set rd [lindex $color 0]
|
|
set gr [lindex $color 1]
|
|
set bl [lindex $color 2]
|
|
set rd_int [expr int($rd * 1.e+05)]
|
|
set gr_int [expr int($gr * 1.e+05)]
|
|
set bl_int [expr int($bl * 1.e+05)]
|
|
set rd_ch [expr int($rd_get * 1.e+05)]
|
|
set gr_ch [expr int($gr_get * 1.e+05)]
|
|
set bl_ch [expr int($bl_get * 1.e+05)]
|
|
|
|
if { $rd_ch != 0 } {
|
|
set tol_rd [expr abs($rd_ch - $rd_int)/$rd_ch]
|
|
} else {
|
|
set tol_rd $rd_int
|
|
}
|
|
if { $gr_ch != 0 } {
|
|
set tol_gr [expr abs($gr_ch - $gr_int)/$gr_ch]
|
|
} else {
|
|
set tol_gr $gr_int
|
|
}
|
|
if { $bl_ch != 0 } {
|
|
set tol_bl [expr abs($bl_ch - $bl_int)/$bl_ch]
|
|
} else {
|
|
set tol_bl $bl_int
|
|
}
|
|
|
|
set status 0
|
|
if { $tol_rd > 0.2 } {
|
|
puts "Warning : RED light of additive color model RGB is invalid"
|
|
set status 1
|
|
}
|
|
if { $tol_gr > 0.2 } {
|
|
puts "Warning : GREEN light of additive color model RGB is invalid"
|
|
set status 1
|
|
}
|
|
if { $tol_bl > 0.2 } {
|
|
puts "Warning : BLUE light of additive color model RGB is invalid"
|
|
set status 1
|
|
}
|
|
|
|
if { $status != 0 } {
|
|
puts "Warning : Colors of default coordinate are not equal"
|
|
}
|
|
|
|
global stat
|
|
if { $tol_rd > 0.2 || $tol_gr > 0.2 || $tol_bl > 0.2 } {
|
|
set info [_checkpoint $coord_x $coord_y $rd_ch $gr_ch $bl_ch]
|
|
set stat [lindex $info end]
|
|
if { ${stat} != 1 } {
|
|
puts "Error : Colors are not equal in default coordinate and in the near coordinates too"
|
|
return $stat
|
|
} else {
|
|
puts "Point with valid color was found"
|
|
return $stat
|
|
}
|
|
} else {
|
|
set stat 1
|
|
}
|
|
}
|
|
|
|
# Procedure to check color in the point near default coordinate
|
|
proc _checkpoint {coord_x coord_y rd_ch gr_ch bl_ch} {
|
|
set x_start [expr ${coord_x} - 2]
|
|
set y_start [expr ${coord_y} - 2]
|
|
set mistake 0
|
|
set i 0
|
|
while { $mistake != 1 && $i <= 5 } {
|
|
set j 0
|
|
while { $mistake != 1 && $j <= 5 } {
|
|
set position_x [expr ${x_start} + $j]
|
|
set position_y [expr ${y_start} + $i]
|
|
puts $position_x
|
|
puts $position_y
|
|
|
|
set color ""
|
|
catch { [set color "[vreadpixel ${position_x} ${position_y} rgb]"] }
|
|
if {"$color" == ""} {
|
|
puts "Warning : Pixel coordinates (${position_x}; ${position_y}) are out of view"
|
|
incr j
|
|
continue
|
|
}
|
|
set rd [lindex $color 0]
|
|
set gr [lindex $color 1]
|
|
set bl [lindex $color 2]
|
|
set rd_int [expr int($rd * 1.e+05)]
|
|
set gr_int [expr int($gr * 1.e+05)]
|
|
set bl_int [expr int($bl * 1.e+05)]
|
|
|
|
if { $rd_ch != 0 } {
|
|
set tol_rd [expr abs($rd_ch - $rd_int)/$rd_ch]
|
|
} else {
|
|
set tol_rd $rd_int
|
|
}
|
|
if { $gr_ch != 0 } {
|
|
set tol_gr [expr abs($gr_ch - $gr_int)/$gr_ch]
|
|
} else {
|
|
set tol_gr $gr_int
|
|
}
|
|
if { $bl_ch != 0 } {
|
|
set tol_bl [expr abs($bl_ch - $bl_int)/$bl_ch]
|
|
} else {
|
|
set tol_bl $bl_int
|
|
}
|
|
|
|
if { $tol_rd > 0.2 || $tol_gr > 0.2 || $tol_bl > 0.2 } {
|
|
puts "Warning : Point with true color was not found near default coordinates"
|
|
set mistake 0
|
|
} else {
|
|
set mistake 1
|
|
}
|
|
incr j
|
|
}
|
|
incr i
|
|
}
|
|
return $mistake
|
|
}
|
|
|
|
# auxiliary: check argument
|
|
proc _check_arg {check_name check_result {get_value 0}} {
|
|
upvar ${check_result} ${check_result}
|
|
upvar arg arg
|
|
upvar narg narg
|
|
upvar args args
|
|
if { $arg == ${check_name} } {
|
|
if { ${get_value} == "?" } {
|
|
set next_arg_index [expr $narg + 1]
|
|
if { $next_arg_index < [llength $args] && ! [regexp {^-[^0-9]} [lindex $args $next_arg_index]] } {
|
|
set ${check_result} "[lindex $args $next_arg_index]"
|
|
set narg ${next_arg_index}
|
|
} else {
|
|
set ${check_result} "true"
|
|
}
|
|
} elseif {${get_value}} {
|
|
incr narg
|
|
if { $narg < [llength $args] && ! [regexp {^-[^0-9]} [lindex $args $narg]] } {
|
|
set ${check_result} "[lindex $args $narg]"
|
|
} else {
|
|
error "Option ${check_result} requires argument"
|
|
}
|
|
} else {
|
|
set ${check_result} "true"
|
|
}
|
|
return 1
|
|
}
|
|
return 0
|
|
}
|
|
|
|
help checknbshapes {
|
|
Compare number of sub-shapes in "shape" with given reference data
|
|
|
|
Use: checknbshapes shape [options...]
|
|
Allowed options are:
|
|
-vertex N
|
|
-edge N
|
|
-wire N
|
|
-face N
|
|
-shell N
|
|
-solid N
|
|
-compsolid N
|
|
-compound N
|
|
-shape N
|
|
-t: compare the number of sub-shapes in "shape" counting
|
|
the same sub-shapes with different location as different sub-shapes.
|
|
-m msg: print "msg" in case of error
|
|
-ref [nbshapes a]: compare the number of sub-shapes in "shape" and in "a".
|
|
-vertex N, -edge N and other options are still working.
|
|
}
|
|
proc checknbshapes {shape args} {
|
|
puts "checknbshapes ${shape} ${args}"
|
|
upvar ${shape} ${shape}
|
|
|
|
set nbVERTEX -1
|
|
set nbEDGE -1
|
|
set nbWIRE -1
|
|
set nbFACE -1
|
|
set nbSHELL -1
|
|
set nbSOLID -1
|
|
set nbCOMPSOLID -1
|
|
set nbCOMPOUND -1
|
|
set nbSHAPE -1
|
|
|
|
set message ""
|
|
set count_locations 0
|
|
set ref_info ""
|
|
|
|
for {set narg 0} {$narg < [llength $args]} {incr narg} {
|
|
set arg [lindex $args $narg]
|
|
if {[_check_arg "-vertex" nbVERTEX 1] ||
|
|
[_check_arg "-edge" nbEDGE 1] ||
|
|
[_check_arg "-wire" nbWIRE 1] ||
|
|
[_check_arg "-face" nbFACE 1] ||
|
|
[_check_arg "-shell" nbSHELL 1] ||
|
|
[_check_arg "-solid" nbSOLID 1] ||
|
|
[_check_arg "-compsolid" nbCOMPSOLID 1] ||
|
|
[_check_arg "-compound" nbCOMPOUND 1] ||
|
|
[_check_arg "-shape" nbSHAPE 1] ||
|
|
[_check_arg "-t" count_locations] ||
|
|
[_check_arg "-m" message 1] ||
|
|
[_check_arg "-ref" ref_info 1]
|
|
} {
|
|
continue
|
|
}
|
|
# unsupported option
|
|
if { [regexp {^-} $arg] } {
|
|
error "Error: unsupported option \"$arg\""
|
|
}
|
|
error "Error: cannot interpret argument $narg ($arg)"
|
|
}
|
|
|
|
if { ${count_locations} == 0 } {
|
|
set nb_info [nbshapes ${shape}]
|
|
} else {
|
|
set nb_info [nbshapes ${shape} -t]
|
|
}
|
|
|
|
set EntityList {VERTEX EDGE WIRE FACE SHELL SOLID COMPSOLID COMPOUND SHAPE}
|
|
|
|
foreach Entity ${EntityList} {
|
|
set expr_string "${Entity} +: +(\[-0-9.+eE\]+)"
|
|
set to_compare {}
|
|
# get number of elements from ${shape}
|
|
if { [regexp "${expr_string}" ${nb_info} full nb_entity2] } {
|
|
lappend to_compare ${nb_entity2}
|
|
} else {
|
|
error "Error : command \"nbshapes ${shape}\" gives an empty result"
|
|
}
|
|
# get number of elements from options -vertex -edge and so on
|
|
set nb_entity1 [set nb${Entity}]
|
|
if { ${nb_entity1} != -1 } {
|
|
lappend to_compare ${nb_entity1}
|
|
}
|
|
# get number of elements from option -ref
|
|
if { [regexp "${expr_string}" ${ref_info} full nb_entity_ref] } {
|
|
lappend to_compare ${nb_entity_ref}
|
|
}
|
|
# skip comparing if no reference data was given
|
|
if {[llength $to_compare] == 1} {
|
|
continue
|
|
}
|
|
# compare all values, if they are equal, length of sorted list "to_compare"
|
|
# (with key -unique) should be equal to 1
|
|
set to_compare [lsort -dictionary -unique $to_compare]
|
|
if { [llength $to_compare] != 1 } {
|
|
puts "Error : ${message} is WRONG because number of ${Entity} entities in shape \"${shape}\" is ${nb_entity2}"
|
|
} else {
|
|
puts "OK : ${message} is GOOD because number of ${Entity} entities is equal to number of expected ${Entity} entities"
|
|
}
|
|
}
|
|
}
|
|
|
|
# Procedure to check equality of two reals with tolerance (relative and absolute)
|
|
help checkreal {
|
|
Compare value with expected
|
|
Use: checkreal name value expected tol_abs tol_rel
|
|
}
|
|
proc checkreal {name value expected tol_abs tol_rel} {
|
|
if { abs ($value - $expected) > $tol_abs + $tol_rel * abs ($expected) } {
|
|
puts "Error: $name = $value is not equal to expected $expected"
|
|
} else {
|
|
puts "Check of $name OK: value = $value, expected = $expected"
|
|
}
|
|
return
|
|
}
|
|
|
|
# Procedure to check equality of two 3D points with tolerance
|
|
help checkpoint {
|
|
Compare two 3D points with given tolerance
|
|
Use: checkpoint name {valueX valueY valueZ} {expectedX expectedY expectedZ} tolerance
|
|
}
|
|
proc checkpoint {theName theValue theExpected theTolerance} {
|
|
set e 0.0001
|
|
foreach i {0 1 2} {
|
|
if { [expr abs([lindex $theValue $i] - [lindex $theExpected $i])] > $theTolerance } {
|
|
puts "Error: $theName, ($theValue) is not equal to expected ($theExpected)"
|
|
return
|
|
}
|
|
}
|
|
puts "Check of $theName OK: value = ($theValue), expected = ($theExpected)"
|
|
return
|
|
}
|
|
|
|
help checkfreebounds {
|
|
Compare number of free edges with ref_value
|
|
|
|
Use: checkfreebounds shape ref_value [options...]
|
|
Allowed options are:
|
|
-tol N: used tolerance (default -0.01)
|
|
-type N: used type, possible values are "closed" and "opened" (default "closed")
|
|
}
|
|
proc checkfreebounds {shape ref_value args} {
|
|
puts "checkfreebounds ${shape} ${ref_value} ${args}"
|
|
upvar ${shape} ${shape}
|
|
|
|
set tol -0.01
|
|
set type "closed"
|
|
|
|
for {set narg 0} {$narg < [llength $args]} {incr narg} {
|
|
set arg [lindex $args $narg]
|
|
if {[_check_arg "-tol" tol 1] ||
|
|
[_check_arg "-type" type 1]
|
|
} {
|
|
continue
|
|
}
|
|
# unsupported option
|
|
if { [regexp {^-} $arg] } {
|
|
error "Error: unsupported option \"$arg\""
|
|
}
|
|
error "Error: cannot interpret argument $narg ($arg)"
|
|
}
|
|
|
|
if {"$type" != "closed" && "$type" != "opened"} {
|
|
error "Error : wrong -type key \"${type}\""
|
|
}
|
|
|
|
freebounds ${shape} ${tol}
|
|
set free_edges [llength [explode ${shape}_[string range $type 0 0] e]]
|
|
|
|
if { ${ref_value} == -1 } {
|
|
puts "Error : Number of free edges is UNSTABLE"
|
|
return
|
|
}
|
|
|
|
if { ${free_edges} != ${ref_value} } {
|
|
puts "Error : Number of free edges is not equal to reference data"
|
|
} else {
|
|
puts "OK : Number of free edges is ${free_edges}"
|
|
}
|
|
}
|
|
|
|
help checkmaxtol {
|
|
Returns max tolerance of the shape and prints error message if specified
|
|
criteria are not satisfied.
|
|
|
|
Use: checkmaxtol shape [options...]
|
|
|
|
Options specify criteria for checking the maximal tolerance value:
|
|
-ref <value>: check it to be equal to reference value.
|
|
-min_tol <value>: check it to be not greater than specified value.
|
|
-source <list of shapes>: check it to be not greater than
|
|
maximal tolerance of specified shape(s)
|
|
-multi_tol <value>: additional multiplier for value specified by -min_tol
|
|
or -shapes options.
|
|
}
|
|
|
|
proc checkmaxtol {shape args} {
|
|
puts "checkmaxtol ${shape} ${args}"
|
|
upvar ${shape} ${shape}
|
|
|
|
set ref_value ""
|
|
set source_shapes {}
|
|
set min_tol 0
|
|
set tol_multiplier 0
|
|
|
|
# check arguments
|
|
for {set narg 0} {$narg < [llength $args]} {incr narg} {
|
|
set arg [lindex $args $narg]
|
|
if {[_check_arg "-min_tol" min_tol 1] ||
|
|
[_check_arg "-multi_tol" tol_multiplier 1] ||
|
|
[_check_arg "-source" source_shapes 1] ||
|
|
[_check_arg "-ref" ref_value 1]
|
|
} {
|
|
continue
|
|
}
|
|
# unsupported option
|
|
if { [regexp {^-} $arg] } {
|
|
error "Error: unsupported option \"$arg\""
|
|
}
|
|
error "Error: cannot interpret argument $narg ($arg)"
|
|
}
|
|
|
|
# get max tol of shape
|
|
set max_tol 0
|
|
if {[regexp "Tolerance MAX=(\[-0-9.+eE\]+)" [tolerance ${shape}] full maxtol_temp]} {
|
|
set max_tol ${maxtol_temp}
|
|
} else {
|
|
error "Error: cannot get tolerances of shape \"${shape}\""
|
|
}
|
|
|
|
# find max tol of source shapes
|
|
foreach source_shape ${source_shapes} {
|
|
upvar ${source_shape} ${source_shape}
|
|
set _src_max_tol [checkmaxtol ${source_shape}]
|
|
if { [expr ${_src_max_tol} > ${min_tol} ] } {
|
|
set min_tol ${_src_max_tol}
|
|
}
|
|
}
|
|
# apply -multi_tol option
|
|
if {${tol_multiplier}} {
|
|
set min_tol [expr ${tol_multiplier} * ${_src_max_tol}]
|
|
}
|
|
# compare max tol of source shapes with checking tolerance
|
|
if { ${min_tol} && [expr ${max_tol} > ${min_tol}] } {
|
|
puts "Error: tolerance of \"${shape}\" (${max_tol}) is greater than checking tolerance (${min_tol})"
|
|
}
|
|
if { ${ref_value} != "" } {
|
|
checkreal "Max tolerance" ${max_tol} ${ref_value} 0.0001 0.01
|
|
}
|
|
return ${max_tol}
|
|
}
|
|
|
|
help checkfaults {
|
|
Compare faults number of given shapes.
|
|
|
|
Use: checkfaults shape source_shape [ref_value=0]
|
|
}
|
|
proc checkfaults {shape source_shape {ref_value 0}} {
|
|
puts "checkfaults ${shape} ${source_shape} ${ref_value}"
|
|
upvar $shape $shape
|
|
upvar $source_shape $source_shape
|
|
set cs_a [checkshape $source_shape]
|
|
set nb_a 0
|
|
if {[regexp {Faulty shapes in variables faulty_([0-9]*) to faulty_([0-9]*)} $cs_a full nb_a_begin nb_a_end]} {
|
|
set nb_a [expr $nb_a_end - $nb_a_begin +1]
|
|
}
|
|
set cs_r [checkshape $shape]
|
|
set nb_r 0
|
|
if {[regexp {Faulty shapes in variables faulty_([0-9]*) to faulty_([0-9]*)} $cs_r full nb_r_begin nb_r_end]} {
|
|
set nb_r [expr $nb_r_end - $nb_r_begin +1]
|
|
}
|
|
puts "Number of faults for the initial shape is $nb_a."
|
|
puts "Number of faults for the resulting shape is $nb_r."
|
|
|
|
if { ${ref_value} == -1 } {
|
|
puts "Error : Number of faults is UNSTABLE"
|
|
return
|
|
}
|
|
|
|
if { $nb_r > $nb_a } {
|
|
puts "Error : Number of faults is $nb_r"
|
|
}
|
|
}
|
|
|
|
# auxiliary: check all arguments
|
|
proc _check_args { args {options {}} {command_name ""}} {
|
|
# check arguments
|
|
for {set narg 0} {${narg} < [llength ${args}]} {incr narg} {
|
|
set arg [lindex ${args} ${narg}]
|
|
set toContinue 0
|
|
foreach option ${options} {
|
|
set option_name [lindex ${option} 0]
|
|
set variable_to_save_value [lindex ${option} 1]
|
|
set get_value [lindex ${option} 2]
|
|
set local_value ""
|
|
if { [_check_arg ${option_name} local_value ${get_value}] } {
|
|
upvar 1 ${variable_to_save_value} ${variable_to_save_value}
|
|
set ${variable_to_save_value} ${local_value}
|
|
set toContinue 1
|
|
}
|
|
}
|
|
if {${toContinue}} { continue }
|
|
# unsupported option
|
|
if { [regexp {^-} ${arg}] } {
|
|
error "Error: unsupported option \"${arg}\""
|
|
}
|
|
error "Error: cannot interpret argument ${narg} (${arg})"
|
|
}
|
|
foreach option ${options} {
|
|
set option_name [lindex ${option} 0]
|
|
set variable_to_save_value [lindex ${option} 1]
|
|
set should_exist [lindex ${option} 3]
|
|
if {![info exists ${variable_to_save_value}] && ${should_exist} == 1} {
|
|
error "Error: wrong using of command '${command_name}', '${option_name}' option is required"
|
|
}
|
|
}
|
|
}
|
|
|
|
help checkprops {
|
|
Procedure includes commands to compute length, area and volume of input shape.
|
|
|
|
Use: checkprops shapename [options...]
|
|
Allowed options are:
|
|
-l LENGTH: command lprops, computes the mass properties of all edges in the shape with a linear density of 1
|
|
-s AREA: command sprops, computes the mass properties of all faces with a surface density of 1
|
|
-v VOLUME: command vprops, computes the mass properties of all solids with a density of 1
|
|
-eps EPSILON: the epsilon defines relative precision of computation
|
|
-deps DEPSILON: the epsilon defines relative precision to compare corresponding values
|
|
-equal SHAPE: compare area\volume\length of input shapes. Puts error if its are not equal
|
|
-notequal SHAPE: compare area\volume\length of input shapes. Puts error if its are equal
|
|
-skip: count shared shapes only once, skipping repeatitions
|
|
Options -l, -s and -v are independent and can be used in any order. Tolerance epsilon is the same for all options.
|
|
}
|
|
|
|
proc checkprops {shape args} {
|
|
puts "checkprops ${shape} ${args}"
|
|
upvar ${shape} ${shape}
|
|
|
|
if {![isdraw ${shape}] || [regexp "${shape} is a \n" [whatis ${shape}]]} {
|
|
puts "Error: The command cannot be built"
|
|
return
|
|
}
|
|
|
|
set length -1
|
|
set area -1
|
|
set volume -1
|
|
set epsilon 1.0e-4
|
|
set compared_equal_shape -1
|
|
set compared_notequal_shape -1
|
|
set equal_check 0
|
|
set skip 0
|
|
set depsilon 1e-2
|
|
|
|
set options {{"-eps" epsilon 1}
|
|
{"-equal" compared_equal_shape 1}
|
|
{"-notequal" compared_notequal_shape 1}
|
|
{"-skip" skip 0}
|
|
{"-deps" depsilon 1}}
|
|
|
|
if { [regexp {\-[not]*equal} $args] } {
|
|
lappend options {"-s" area 0}
|
|
lappend options {"-l" length 0}
|
|
lappend options {"-v" volume 0}
|
|
set equal_check 1
|
|
} else {
|
|
lappend options {"-s" area 1}
|
|
lappend options {"-l" length 1}
|
|
lappend options {"-v" volume 1}
|
|
}
|
|
_check_args ${args} ${options} "checkprops"
|
|
|
|
if { ${length} != -1 || ${equal_check} == 1 } {
|
|
lappend CommandNames {lprops}
|
|
set equal_check 0
|
|
}
|
|
if { ${area} != -1 || ${equal_check} == 1 } {
|
|
lappend CommandNames {sprops}
|
|
set equal_check 0
|
|
}
|
|
if { ${volume} != -1 || ${equal_check} == 1 } {
|
|
lappend CommandNames {vprops}
|
|
set equal_check 0
|
|
}
|
|
|
|
set skip_option ""
|
|
if { $skip } {
|
|
set skip_option "-skip"
|
|
}
|
|
|
|
foreach CommandName ${CommandNames} {
|
|
switch $CommandName {
|
|
"lprops" { set mass ${length}; set prop "length" }
|
|
"sprops" { set mass ${area}; set prop "area" }
|
|
"vprops" { set mass ${volume}; set prop "volume" }
|
|
}
|
|
regexp {Mass +: +([-0-9.+eE]+)} [eval ${CommandName} ${shape} ${epsilon} $skip_option] full m
|
|
|
|
if { ${compared_equal_shape} != -1 } {
|
|
upvar ${compared_equal_shape} ${compared_equal_shape}
|
|
regexp {Mass +: +([-0-9.+eE]+)} [eval ${CommandName} ${compared_equal_shape} ${epsilon} $skip_option] full compared_m
|
|
if { $compared_m != $m } {
|
|
puts "Error: Shape ${compared_equal_shape} is not equal to shape ${shape}"
|
|
}
|
|
}
|
|
|
|
if { ${compared_notequal_shape} != -1 } {
|
|
upvar ${compared_notequal_shape} ${compared_notequal_shape}
|
|
regexp {Mass +: +([-0-9.+eE]+)} [eval ${CommandName} ${compared_notequal_shape} ${epsilon} $skip_option] full compared_m
|
|
if { $compared_m == $m } {
|
|
puts "Error: Shape ${compared_notequal_shape} is equal shape to ${shape}"
|
|
}
|
|
}
|
|
|
|
if { ${compared_equal_shape} == -1 && ${compared_notequal_shape} == -1 } {
|
|
if { [string compare "$mass" "empty"] != 0 } {
|
|
if { $m == 0 } {
|
|
puts "Error : The command is not valid. The $prop is 0."
|
|
}
|
|
# check of change of area is < 1%
|
|
if { ($mass != 0 && abs (($mass - $m) / double($mass)) > $depsilon) ||
|
|
($mass == 0 && $m != 0) } {
|
|
puts "Error : The $prop of result shape is $m, expected $mass"
|
|
}
|
|
} else {
|
|
if { $m != 0 } {
|
|
puts "Error : The command is not valid. The $prop is $m"
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
help checkdump {
|
|
Procedure includes command to parse output dump and compare it with reference values.
|
|
|
|
Use: checkdump shapename [options...]
|
|
Allowed options are:
|
|
-name NAME: list of parsing parameters (e.g. Center, Axis, etc)
|
|
-ref VALUE: list of reference values for each parameter in NAME
|
|
-eps EPSILON: the epsilon defines relative precision of computation
|
|
}
|
|
|
|
proc checkdump {shape args} {
|
|
puts "checkdump ${shape} ${args}"
|
|
upvar ${shape} ${shape}
|
|
|
|
set ddump -1
|
|
set epsilon -1
|
|
set options {{"-name" params 1}
|
|
{"-ref" ref 1}
|
|
{"-eps" epsilon 1}
|
|
{"-dump" ddump 1}}
|
|
|
|
if { ${ddump} == -1 } {
|
|
set ddump [dump ${shape}]
|
|
}
|
|
_check_args ${args} ${options} "checkdump"
|
|
|
|
set index 0
|
|
foreach param ${params} {
|
|
set pattern "${param}\\s*:\\s*"
|
|
set number_pattern "(\[-0-9.+eE\]+)\\s*"
|
|
set ref_values ""
|
|
set local_ref ${ref}
|
|
if { [llength ${params}] > 1 } {
|
|
set local_ref [lindex ${ref} ${index}]
|
|
}
|
|
foreach item ${local_ref} {
|
|
if { ![regexp "$pattern$number_pattern" $ddump full res] } {
|
|
puts "Error: checked parameter ${param} is not listed in dump"
|
|
break
|
|
}
|
|
lappend ref_values $res
|
|
set pattern "${pattern}${res},\\s*"
|
|
## without precision
|
|
if { ${epsilon} == -1 } {
|
|
if { ${item} != ${res} } {
|
|
puts "Error: parameter ${param} - current value (${res}) is not equal to reference value (${item})"
|
|
} else {
|
|
puts "OK: parameter ${param} - current value (${res}) is equal to reference value (${item})"
|
|
}
|
|
## with precision
|
|
} else {
|
|
set precision 0.0000001
|
|
if { ( abs($res) > $precision ) || ( abs($item) > $precision ) } {
|
|
if { ($item != 0 && [expr 1.*abs($item - $res)/$item] > $epsilon) || ($item == 0 && $res != 0) } {
|
|
puts "Error: The $param of the resulting shape is $res and the expected $param is $item"
|
|
} else {
|
|
puts "OK: parameter ${param} - current value (${res}) is equal to reference value (${item})"
|
|
}
|
|
}
|
|
}
|
|
}
|
|
incr index
|
|
}
|
|
}
|
|
|
|
help checklength {
|
|
Procedure includes commands to compute length of input curve.
|
|
|
|
Use: checklength curvename [options...]
|
|
Allowed options are:
|
|
-l LENGTH: command length, computes the length of input curve with precision of computation
|
|
-eps EPSILON: the epsilon defines relative precision of computation
|
|
-equal CURVE: compare length of input curves. Puts error if its are not equal
|
|
-notequal CURVE: compare length of input curves. Puts error if its are equal
|
|
}
|
|
|
|
proc checklength {shape args} {
|
|
puts "checklength ${shape} ${args}"
|
|
upvar ${shape} ${shape}
|
|
|
|
if {![isdraw ${shape}] || [regexp "${shape} is a \n" [whatis ${shape}]]} {
|
|
puts "Error: The command cannot be built"
|
|
return
|
|
}
|
|
|
|
set length -1
|
|
set epsilon 1.0e-4
|
|
set compared_equal_shape -1
|
|
set compared_notequal_shape -1
|
|
set equal_check 0
|
|
|
|
set options {{"-eps" epsilon 1}
|
|
{"-equal" compared_equal_shape 1}
|
|
{"-notequal" compared_notequal_shape 1}}
|
|
|
|
if { [regexp {\-[not]*equal} $args] } {
|
|
lappend options {"-l" length 0}
|
|
set equal_check 1
|
|
} else {
|
|
lappend options {"-l" length 1}
|
|
}
|
|
_check_args ${args} ${options} "checkprops"
|
|
|
|
if { ${length} != -1 || ${equal_check} == 1 } {
|
|
set CommandName length
|
|
set mass $length
|
|
set prop "length"
|
|
set equal_check 0
|
|
}
|
|
|
|
regexp "The +length+ ${shape} +is +(\[-0-9.+eE\]+)" [${CommandName} ${shape} ${epsilon}] full m
|
|
|
|
if { ${compared_equal_shape} != -1 } {
|
|
upvar ${compared_equal_shape} ${compared_equal_shape}
|
|
regexp "The +length+ ${compared_equal_shape} +is +(\[-0-9.+eE\]+)" [${CommandName} ${compared_equal_shape} ${epsilon}] full compared_m
|
|
if { $compared_m != $m } {
|
|
puts "Error: length of shape ${compared_equal_shape} is not equal to shape ${shape}"
|
|
}
|
|
}
|
|
|
|
if { ${compared_notequal_shape} != -1 } {
|
|
upvar ${compared_notequal_shape} ${compared_notequal_shape}
|
|
regexp "The +length+ ${compared_notequal_shape} +is +(\[-0-9.+eE\]+)" [${CommandName} ${compared_notequal_shape} ${epsilon}] full compared_m
|
|
if { $compared_m == $m } {
|
|
puts "Error: length of shape ${compared_notequal_shape} is equal shape to ${shape}"
|
|
}
|
|
}
|
|
|
|
if { ${compared_equal_shape} == -1 && ${compared_notequal_shape} == -1 } {
|
|
if { [string compare "$mass" "empty"] != 0 } {
|
|
if { $m == 0 } {
|
|
puts "Error : The command is not valid. The $prop is 0."
|
|
}
|
|
if { $mass > 0 } {
|
|
puts "The expected $prop is $mass"
|
|
}
|
|
#check of change of area is < 1%
|
|
if { ($mass != 0 && [expr 1.*abs($mass - $m)/$mass] > 0.01) || ($mass == 0 && $m != 0) } {
|
|
puts "Error : The $prop of result shape is $m"
|
|
}
|
|
} else {
|
|
if { $m != 0 } {
|
|
puts "Error : The command is not valid. The $prop is $m"
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
help checkview {
|
|
Display shape in selected viewer.
|
|
|
|
Use: checkview [options...]
|
|
Allowed options are:
|
|
-display shapename: display shape with name 'shapename'
|
|
-3d: display shape in 3d viewer
|
|
-2d [ v2d / smallview ]: display shape in 2d viewer (default viewer is a 'smallview')
|
|
-vdispmode N: it is possible to set vdispmode for 3d viewer (default value is 1)
|
|
-screenshot: procedure will try to make screenshot of already created viewer
|
|
-path <path>: location of saved screenshot of viewer
|
|
|
|
Procedure can check some property of shape (length, area or volume) and compare it with some value N:
|
|
-l [N]
|
|
-s [N]
|
|
-v [N]
|
|
If current property is equal to value N, shape is marked as valid in procedure.
|
|
If value N is not given procedure will mark shape as valid if current property is non-zero.
|
|
-with {a b c}: display shapes 'a' 'b' 'c' together with 'shape' (if shape is valid)
|
|
-otherwise {d e f}: display shapes 'd' 'e' 'f' instead of 'shape' (if shape is NOT valid)
|
|
Note that one of two options -2d/-3d is required.
|
|
}
|
|
|
|
proc checkview {args} {
|
|
puts "checkview ${args}"
|
|
|
|
set 3dviewer 0
|
|
set 2dviewer false
|
|
set shape ""
|
|
set PathToSave ""
|
|
set dispmode 1
|
|
set isScreenshot 0
|
|
set check_length false
|
|
set check_area false
|
|
set check_volume false
|
|
set otherwise {}
|
|
set with {}
|
|
|
|
set options {{"-3d" 3dviewer 0}
|
|
{"-2d" 2dviewer ?}
|
|
{"-display" shape 1}
|
|
{"-path" PathToSave 1}
|
|
{"-vdispmode" dispmode 1}
|
|
{"-screenshot" isScreenshot 0}
|
|
{"-otherwise" otherwise 1}
|
|
{"-with" with 1}
|
|
{"-l" check_length ?}
|
|
{"-s" check_area ?}
|
|
{"-v" check_volume ?}}
|
|
|
|
# check arguments
|
|
_check_args ${args} ${options} "checkview"
|
|
|
|
if { ${PathToSave} == "" } {
|
|
set PathToSave "./photo.png"
|
|
}
|
|
|
|
if { ${3dviewer} == 0 && ${2dviewer} == false } {
|
|
error "Error: wrong using of command 'checkview', please use -2d or -3d option"
|
|
}
|
|
|
|
if { ${isScreenshot} } {
|
|
if { ${3dviewer} } {
|
|
vdump ${PathToSave}
|
|
} else {
|
|
xwd ${PathToSave}
|
|
}
|
|
return
|
|
}
|
|
|
|
set mass 0
|
|
set isBAD 0
|
|
upvar ${shape} ${shape}
|
|
if {[isdraw ${shape}]} {
|
|
# check area
|
|
if { [string is boolean ${check_area}] } {
|
|
if { ${check_area} } {
|
|
regexp {Mass +: +([-0-9.+eE]+)} [sprops ${shape}] full mass
|
|
}
|
|
} else {
|
|
set mass ${check_area}
|
|
}
|
|
# check length
|
|
if { [string is boolean ${check_length}] } {
|
|
if { ${check_length} } {
|
|
regexp {Mass +: +([-0-9.+eE]+)} [lprops ${shape}] full mass
|
|
}
|
|
} else {
|
|
set mass ${check_length}
|
|
}
|
|
# check volume
|
|
if { [string is boolean ${check_volume}] } {
|
|
if { ${check_volume} } {
|
|
regexp {Mass +: +([-0-9.+eE]+)} [vprops ${shape}] full mass
|
|
}
|
|
} else {
|
|
set mass ${check_volume}
|
|
}
|
|
} else {
|
|
set isBAD 1
|
|
}
|
|
if { ${3dviewer} } {
|
|
vinit
|
|
vclear
|
|
} elseif { ([string is boolean ${2dviewer}] && ${2dviewer}) || ${2dviewer} == "smallview"} {
|
|
smallview
|
|
clear
|
|
} elseif { ${2dviewer} == "v2d"} {
|
|
v2d
|
|
2dclear
|
|
}
|
|
if {[isdraw ${shape}]} {
|
|
if { ( ${check_area} == false && ${check_length} == false && ${check_volume} == false ) || ( ${mass} != 0 ) } {
|
|
foreach s ${with} {
|
|
upvar ${s} ${s}
|
|
}
|
|
lappend with ${shape}
|
|
if { ${3dviewer} } {
|
|
vdisplay {*}${with}
|
|
} else {
|
|
donly {*}${with}
|
|
}
|
|
} else {
|
|
set isBAD 1
|
|
}
|
|
} else {
|
|
set isBAD 1
|
|
}
|
|
|
|
if { ${isBAD} && [llength ${otherwise}] } {
|
|
foreach s ${otherwise} {
|
|
upvar ${s} ${s}
|
|
}
|
|
if { ${3dviewer} } {
|
|
vdisplay {*}${otherwise}
|
|
} else {
|
|
donly {*}${otherwise}
|
|
}
|
|
}
|
|
|
|
if { ${3dviewer} } {
|
|
vsetdispmode ${dispmode}
|
|
vfit
|
|
vdump ${PathToSave}
|
|
} else {
|
|
if { ([string is boolean ${2dviewer}] && ${2dviewer}) || ${2dviewer} == "smallview"} {
|
|
fit
|
|
} elseif { ${2dviewer} == "v2d"} {
|
|
2dfit
|
|
}
|
|
xwd ${PathToSave}
|
|
}
|
|
|
|
}
|
|
|
|
help checktrinfo {
|
|
Compare maximum deflection, number of nodes and triangles in "shape" mesh with given reference data
|
|
|
|
Use: checktrinfo shapename [options...]
|
|
Allowed options are:
|
|
-face [N]: compare current number of faces in "shapename" mesh with given reference data.
|
|
If reference value N is not given and current number of faces is equal to 0
|
|
procedure checktrinfo will print an error.
|
|
-empty[N]: compare current number of empty faces in "shapename" mesh with given reference data.
|
|
If reference value N is not given and current number of empty faces is greater that 0
|
|
procedure checktrinfo will print an error.
|
|
-tri [N]: compare current number of triangles in "shapename" mesh with given reference data.
|
|
If reference value N is not given and current number of triangles is equal to 0
|
|
procedure checktrinfo will print an error.
|
|
-nod [N]: compare current number of nodes in "shapename" mesh with given reference data.
|
|
If reference value N is not givenand current number of nodes is equal to 0
|
|
procedure checktrinfo will print an error.
|
|
-defl [N]: compare current value of maximum deflection in "shapename" mesh with given reference data
|
|
If reference value N is not given and current maximum deflection is equal to 0
|
|
procedure checktrinfo will print an error.
|
|
-max_defl N: compare current value of maximum deflection in "shapename" mesh with max possible value
|
|
-tol_abs_tri N: absolute tolerance for comparison of number of triangles (default value 0)
|
|
-tol_rel_tri N: relative tolerance for comparison of number of triangles (default value 0)
|
|
-tol_abs_nod N: absolute tolerance for comparison of number of nodes (default value 0)
|
|
-tol_rel_nod N: relative tolerance for comparison of number of nodes (default value 0)
|
|
-tol_abs_defl N: absolute tolerance for deflection comparison (default value 0)
|
|
-tol_rel_defl N: relative tolerance for deflection comparison (default value 0)
|
|
-ref [trinfo a]: compare deflection, number of triangles and nodes in "shapename" and in "a"
|
|
}
|
|
proc checktrinfo {shape args} {
|
|
puts "checktrinfo ${shape} ${args}"
|
|
upvar ${shape} ${shape}
|
|
|
|
if {![isdraw ${shape}] || [regexp "${shape} is a \n" [whatis ${shape}]]} {
|
|
puts "Error: The command cannot be built"
|
|
return
|
|
}
|
|
|
|
set ref_nb_faces false
|
|
set ref_nb_empty_faces true
|
|
set ref_nb_triangles false
|
|
set ref_nb_nodes false
|
|
set ref_deflection false
|
|
set tol_abs_defl 0
|
|
set tol_rel_defl 0
|
|
set tol_abs_tri 0
|
|
set tol_rel_tri 0
|
|
set tol_abs_nod 0
|
|
set tol_rel_nod 0
|
|
set max_defl -1
|
|
set ref_info ""
|
|
|
|
set options {{"-face" ref_nb_faces ?}
|
|
{"-empty" ref_nb_empty_faces ?}
|
|
{"-tri" ref_nb_triangles ?}
|
|
{"-nod" ref_nb_nodes ?}
|
|
{"-defl" ref_deflection ?}
|
|
{"-tol_abs_defl" tol_abs_defl 1}
|
|
{"-tol_rel_defl" tol_rel_defl 1}
|
|
{"-tol_abs_tri" tol_abs_tri 1}
|
|
{"-tol_rel_tri" tol_rel_tri 1}
|
|
{"-tol_abs_nod" tol_abs_nod 1}
|
|
{"-tol_rel_nod" tol_rel_nod 1}
|
|
{"-max_defl" max_defl 1}
|
|
{"-ref" ref_info 1}}
|
|
|
|
_check_args ${args} ${options} "checktrinfo"
|
|
|
|
# get current number of faces, triangles and nodes, value of max deflection
|
|
set tri_info [trinfo ${shape}]
|
|
set triinfo_pattern "(\[0-9\]+) +faces(.*\[^0-9]\(\[0-9\]+) +empty faces)?.*\[^0-9]\(\[0-9\]+) +triangles.*\[^0-9]\(\[0-9\]+) +nodes.*deflection +(\[-0-9.+eE\]+)"
|
|
if {![regexp "${triinfo_pattern}" ${tri_info} dump cur_nb_faces tmp cur_nb_empty_faces cur_nb_triangles cur_nb_nodes cur_deflection]} {
|
|
puts "Error: command trinfo prints empty info"
|
|
}
|
|
if { ${cur_nb_empty_faces} == "" } {
|
|
set cur_nb_empty_faces 0
|
|
}
|
|
|
|
# get reference values from -ref option
|
|
if { "${ref_info}" != ""} {
|
|
if {![regexp "${triinfo_pattern}" ${ref_info} dump ref_nb_faces tmp ref_nb_empty_faces ref_nb_triangles ref_nb_nodes ref_deflection]} {
|
|
puts "Error: reference information given by -ref option is wrong"
|
|
}
|
|
}
|
|
|
|
# check number of faces
|
|
if { [string is boolean ${ref_nb_faces}] } {
|
|
if { ${cur_nb_faces} <= 0 && ${ref_nb_faces} } {
|
|
puts "Error: Number of faces is equal to 0"
|
|
}
|
|
} else {
|
|
if {[regexp {!([-0-9.+eE]+)} $ref_nb_faces full ref_nb_faces_value]} {
|
|
if {${ref_nb_faces_value} == ${cur_nb_faces} } {
|
|
puts "Error: Number of faces is equal to ${ref_nb_faces_value} but it should not"
|
|
}
|
|
} else {
|
|
checkreal "Number of faces" ${cur_nb_faces} ${ref_nb_faces} ${tol_abs_tri} ${tol_rel_tri}
|
|
}
|
|
}
|
|
# check number of empty faces
|
|
if { [string is boolean ${ref_nb_empty_faces}] } {
|
|
if { ${cur_nb_empty_faces} > 0 && !${ref_nb_empty_faces} } {
|
|
puts "Error: Number of empty faces is greater that 0"
|
|
}
|
|
} else {
|
|
if {[regexp {!([-0-9.+eE]+)} $ref_nb_empty_faces full ref_nb_empty_faces_value]} {
|
|
if {${ref_nb_empty_faces_value} == ${cur_nb_empty_faces} } {
|
|
puts "Error: Number of empty faces is equal to ${ref_nb_empty_faces_value} but it should not"
|
|
}
|
|
} else {
|
|
checkreal "Number of empty faces" ${cur_nb_empty_faces} ${ref_nb_empty_faces} ${tol_abs_tri} ${tol_rel_tri}
|
|
}
|
|
}
|
|
|
|
# check number of triangles
|
|
if { [string is boolean ${ref_nb_triangles}] } {
|
|
if { ${cur_nb_triangles} <= 0 && ${ref_nb_triangles} } {
|
|
puts "Error: Number of triangles is equal to 0"
|
|
}
|
|
} else {
|
|
if {[regexp {!([-0-9.+eE]+)} $ref_nb_triangles full ref_nb_triangles_value]} {
|
|
if {${ref_nb_triangles_value} == ${cur_nb_triangles} } {
|
|
puts "Error: Number of triangles is equal to ${ref_nb_triangles_value} but it should not"
|
|
}
|
|
} else {
|
|
checkreal "Number of triangles" ${cur_nb_triangles} ${ref_nb_triangles} ${tol_abs_tri} ${tol_rel_tri}
|
|
}
|
|
}
|
|
|
|
# check number of nodes
|
|
if { [string is boolean ${ref_nb_nodes}] } {
|
|
if { ${cur_nb_nodes} <= 0 && ${ref_nb_nodes} } {
|
|
puts "Error: Number of nodes is equal to 0"
|
|
}
|
|
} else {
|
|
if {[regexp {!([-0-9.+eE]+)} $ref_nb_nodes full ref_nb_nodes_value]} {
|
|
if {${ref_nb_nodes_value} == ${cur_nb_nodes} } {
|
|
puts "Error: Number of nodes is equal to ${ref_nb_nodes_value} but it should not"
|
|
}
|
|
} else {
|
|
checkreal "Number of nodes" ${cur_nb_nodes} ${ref_nb_nodes} ${tol_abs_nod} ${tol_rel_nod}
|
|
}
|
|
}
|
|
|
|
# check deflection
|
|
if { [string is boolean ${ref_deflection}] } {
|
|
if { ${cur_deflection} <= 0 && ${ref_deflection} } {
|
|
puts "Error: Maximal deflection is equal to 0"
|
|
}
|
|
} else {
|
|
checkreal "Maximal deflection" ${cur_deflection} ${ref_deflection} ${tol_abs_defl} ${tol_rel_defl}
|
|
}
|
|
|
|
if { ${max_defl} != -1 && ${cur_deflection} > ${max_defl} } {
|
|
puts "Error: Maximal deflection is too big"
|
|
}
|
|
}
|
|
|
|
help checkplatform {
|
|
Return name of current platform if no options are given.
|
|
|
|
Use: checkplatform [options...]
|
|
Allowed options are:
|
|
-windows : return 1 if current platform is 'Windows', otherwise return 0
|
|
-linux : return 1 if current platform is 'Linux', otherwise return 0
|
|
-osx : return 1 if current platform is 'MacOS X', otherwise return 0
|
|
|
|
Only one option can be used at once.
|
|
If no option is given, procedure will return the name of current platform.
|
|
}
|
|
proc checkplatform {args} {
|
|
set check_for_windows false
|
|
set check_for_linux false
|
|
set check_for_macosx false
|
|
|
|
set options {{"-windows" check_for_windows 0}
|
|
{"-linux" check_for_linux 0}
|
|
{"-osx" check_for_macosx 0}}
|
|
|
|
_check_args ${args} ${options} "checkplatform"
|
|
|
|
if { [regexp "indows" $::tcl_platform(os)] } {
|
|
set current_platform Windows
|
|
} elseif { $::tcl_platform(os) == "Linux" } {
|
|
set current_platform Linux
|
|
} elseif { $::tcl_platform(os) == "Darwin" } {
|
|
set current_platform MacOS
|
|
}
|
|
|
|
# no args are given
|
|
if { !${check_for_windows} && !${check_for_linux} && !${check_for_macosx}} {
|
|
return ${current_platform}
|
|
}
|
|
|
|
# check usage of proc checkplatform
|
|
if { [expr [string is true ${check_for_windows}] + [string is true ${check_for_linux}] + [string is true ${check_for_macosx}] ] > 1} {
|
|
error "Error: wrong usage of command checkplatform, only single option can be used at once"
|
|
}
|
|
|
|
# checking for Windows platform
|
|
if { ${check_for_windows} && ${current_platform} == "Windows" } {
|
|
return 1
|
|
}
|
|
|
|
# checking for Mac OS X platforms
|
|
if { ${check_for_linux} && ${current_platform} == "Linux" } {
|
|
return 1
|
|
}
|
|
|
|
# checking for Mac OS X platforms
|
|
if { ${check_for_macosx} && ${current_platform} == "MacOS" } {
|
|
return 1
|
|
}
|
|
|
|
# current platform is not equal to given as argument platform, return false
|
|
return 0
|
|
}
|
|
|
|
help checkgravitycenter {
|
|
Compare Center Of Gravity with given reference data
|
|
|
|
Use: checkgravitycenter shape prop_type x y z tol
|
|
}
|
|
proc checkgravitycenter {shape prop_type x y z tol} {
|
|
puts "checkgravitycenter ${shape} $prop_type $x $y $z $tol"
|
|
upvar ${shape} ${shape}
|
|
|
|
if { $prop_type == "-l" } {
|
|
set outstr [lprops $shape]
|
|
} elseif { $prop_type == "-s" } {
|
|
set outstr [sprops $shape]
|
|
} elseif { $prop_type == "-v" } {
|
|
set outstr [vprops $shape]
|
|
} else {
|
|
error "Error : invalid prop_type"
|
|
}
|
|
|
|
if { ![regexp {\nX = +([-0-9.+eE]+).*\nY = +([-0-9.+eE]+).*\nZ = +([-0-9.+eE]+)} ${outstr} full comp_x comp_y comp_z] } {
|
|
error "Error : cannot evaluate properties"
|
|
}
|
|
|
|
if { [expr abs($comp_x-$x)] < $tol && [expr abs($comp_y-$y)] < $tol && [expr abs($comp_z-$z)] < $tol } {
|
|
puts "Check of center of gravity is OK: value = ($comp_x, $comp_y, $comp_z), expected = ($x, $y, $z)"
|
|
} else {
|
|
puts "Error: center of gravity ($comp_x, $comp_y, $comp_z) is not equal to expected ($x, $y, $z)"
|
|
}
|
|
}
|
|
|
|
help checkMultilineStrings {
|
|
Compares two strings.
|
|
Logically splits the strings to lines by the new line characters.
|
|
Outputs the first different lines.
|
|
|
|
Use: checkMultilineStrings <string_1> <string_2>
|
|
}
|
|
proc checkMultilineStrings {tS1 tS2} {
|
|
set aL1 [split $tS1 \n]
|
|
set aL2 [split $tS2 \n]
|
|
|
|
set aC1 [llength $aL1]
|
|
set aC2 [llength $aL2]
|
|
set aC [expr {min($aC1, $aC2)}]
|
|
|
|
for {set aI 0} {$aI < $aC} {incr aI} {
|
|
if {[lindex $aL1 $aI] != [lindex $aL2 $aI]} {
|
|
puts "Error. $aI-th lines are different:"
|
|
puts "[lindex $aL1 $aI]"
|
|
puts "[lindex $aL2 $aI]"
|
|
}
|
|
}
|
|
|
|
if {$aC1 != $aC2} {
|
|
puts "Error. Line counts are different: $aC1 != $aC2."
|
|
}
|
|
}
|