0026833: Create command checkview containing all viewer types
[occt.git] / src / DrawResources / CheckCommands.tcl
CommitLineData
5ae01c85 1# Copyright (c) 2013-2014 OPEN CASCADE SAS
2#
3# This file is part of Open CASCADE Technology software library.
4#
5# This library is free software; you can redistribute it and/or modify it under
6# the terms of the GNU Lesser General Public License version 2.1 as published
7# by the Free Software Foundation, with special exception defined in the file
8# OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT
9# distribution for complete text of the license and disclaimer of any warranty.
10#
11# Alternatively, this file may be used under the terms of Open CASCADE
12# commercial license or contractual agreement.
13
14############################################################################
15# This file defines scripts for verification of OCCT tests.
16# It provides top-level commands starting with 'check'.
17# Type 'help check*' to get their synopsys.
18# See OCCT Tests User Guide for description of the test system.
19#
20# Note: procedures with names starting with underscore are for internal use
21# inside the test system.
22############################################################################
23
24help checkcolor {
25 Check pixel color.
26 Use: checkcolor x y red green blue
27 x y - pixel coordinates
28 red green blue - expected pixel color (values from 0 to 1)
29 Function check color with tolerance (5x5 area)
30}
31# Procedure to check color using command vreadpixel with tolerance
32proc checkcolor { coord_x coord_y rd_get gr_get bl_get } {
33 puts "Coordinate x = $coord_x"
34 puts "Coordinate y = $coord_y"
35 puts "RED color of RGB is $rd_get"
36 puts "GREEN color of RGB is $gr_get"
37 puts "BLUE color of RGB is $bl_get"
38
39 if { $coord_x <= 1 || $coord_y <= 1 } {
40 puts "Error : minimal coordinate is x = 2, y = 2. But we have x = $coord_x y = $coord_y"
41 return -1
42 }
43
44 set color ""
45 catch { [set color "[vreadpixel ${coord_x} ${coord_y} rgb]"] }
46 if {"$color" == ""} {
47 puts "Error : Pixel coordinates (${position_x}; ${position_y}) are out of view"
48 }
49 set rd [lindex $color 0]
50 set gr [lindex $color 1]
51 set bl [lindex $color 2]
52 set rd_int [expr int($rd * 1.e+05)]
53 set gr_int [expr int($gr * 1.e+05)]
54 set bl_int [expr int($bl * 1.e+05)]
55 set rd_ch [expr int($rd_get * 1.e+05)]
56 set gr_ch [expr int($gr_get * 1.e+05)]
57 set bl_ch [expr int($bl_get * 1.e+05)]
58
59 if { $rd_ch != 0 } {
60 set tol_rd [expr abs($rd_ch - $rd_int)/$rd_ch]
61 } else {
62 set tol_rd $rd_int
63 }
64 if { $gr_ch != 0 } {
65 set tol_gr [expr abs($gr_ch - $gr_int)/$gr_ch]
66 } else {
67 set tol_gr $gr_int
68 }
69 if { $bl_ch != 0 } {
70 set tol_bl [expr abs($bl_ch - $bl_int)/$bl_ch]
71 } else {
72 set tol_bl $bl_int
73 }
74
75 set status 0
76 if { $tol_rd > 0.2 } {
77 puts "Warning : RED light of additive color model RGB is invalid"
78 set status 1
79 }
80 if { $tol_gr > 0.2 } {
81 puts "Warning : GREEN light of additive color model RGB is invalid"
82 set status 1
83 }
84 if { $tol_bl > 0.2 } {
85 puts "Warning : BLUE light of additive color model RGB is invalid"
86 set status 1
87 }
88
89 if { $status != 0 } {
90 puts "Warning : Colors of default coordinate are not equal"
91 }
92
93 global stat
94 if { $tol_rd > 0.2 || $tol_gr > 0.2 || $tol_bl > 0.2 } {
95 set info [_checkpoint $coord_x $coord_y $rd_ch $gr_ch $bl_ch]
96 set stat [lindex $info end]
97 if { ${stat} != 1 } {
98 puts "Error : Colors are not equal in default coordinate and in the near coordinates too"
99 return $stat
100 } else {
101 puts "Point with valid color was found"
102 return $stat
103 }
104 } else {
105 set stat 1
106 }
107}
108
109# Procedure to check color in the point near default coordinate
110proc _checkpoint {coord_x coord_y rd_ch gr_ch bl_ch} {
111 set x_start [expr ${coord_x} - 2]
112 set y_start [expr ${coord_y} - 2]
113 set mistake 0
114 set i 0
115 while { $mistake != 1 && $i <= 5 } {
116 set j 0
117 while { $mistake != 1 && $j <= 5 } {
118 set position_x [expr ${x_start} + $j]
119 set position_y [expr ${y_start} + $i]
120 puts $position_x
121 puts $position_y
122
123 set color ""
124 catch { [set color "[vreadpixel ${position_x} ${position_y} rgb]"] }
125 if {"$color" == ""} {
126 puts "Warning : Pixel coordinates (${position_x}; ${position_y}) are out of view"
127 incr j
128 continue
129 }
130 set rd [lindex $color 0]
131 set gr [lindex $color 1]
132 set bl [lindex $color 2]
133 set rd_int [expr int($rd * 1.e+05)]
134 set gr_int [expr int($gr * 1.e+05)]
135 set bl_int [expr int($bl * 1.e+05)]
136
137 if { $rd_ch != 0 } {
138 set tol_rd [expr abs($rd_ch - $rd_int)/$rd_ch]
139 } else {
140 set tol_rd $rd_int
141 }
142 if { $gr_ch != 0 } {
143 set tol_gr [expr abs($gr_ch - $gr_int)/$gr_ch]
144 } else {
145 set tol_gr $gr_int
146 }
147 if { $bl_ch != 0 } {
148 set tol_bl [expr abs($bl_ch - $bl_int)/$bl_ch]
149 } else {
150 set tol_bl $bl_int
151 }
152
153 if { $tol_rd > 0.2 || $tol_gr > 0.2 || $tol_bl > 0.2 } {
154 puts "Warning : Point with true color was not found near default coordinates"
155 set mistake 0
156 } else {
157 set mistake 1
158 }
159 incr j
160 }
161 incr i
162 }
163 return $mistake
164}
165
166# auxiliary: check argument
167proc _check_arg {check_name check_result {get_value 0}} {
168 upvar ${check_result} ${check_result}
169 upvar arg arg
170 upvar narg narg
171 upvar args args
172 if { $arg == ${check_name} } {
5747059b 173 if { ${get_value} == "?" } {
174 set next_arg_index [expr $narg + 1]
175 if { $next_arg_index < [llength $args] && ! [regexp {^-[^0-9]} [lindex $args $next_arg_index]] } {
176 set ${check_result} "[lindex $args $next_arg_index]"
177 set narg ${next_arg_index}
178 } else {
179 set ${check_result} "true"
180 }
181 } elseif {${get_value}} {
5ae01c85 182 incr narg
58cf74e0 183 if { $narg < [llength $args] && ! [regexp {^-[^0-9]} [lindex $args $narg]] } {
5ae01c85 184 set ${check_result} "[lindex $args $narg]"
185 } else {
186 error "Option ${check_result} requires argument"
187 }
188 } else {
5747059b 189 set ${check_result} "true"
5ae01c85 190 }
191 return 1
192 }
193 return 0
194}
195
196help checknbshapes {
197 Compare number of sub-shapes in "shape" with given reference data
198
199 Use: checknbshapes shape [options...]
200 Allowed options are:
201 -vertex N
202 -edge N
203 -wire N
204 -face N
205 -shell N
206 -solid N
207 -compsolid N
208 -compound N
209 -shape N
210 -t: compare the number of sub-shapes in "shape" counting
211 the same sub-shapes with different location as different sub-shapes.
212 -m msg: print "msg" in case of error
213 -ref [nbshapes a]: compare the number of sub-shapes in "shape" and in "a".
214 -vertex N, -edge N and other options are stil working.
215}
216proc checknbshapes {shape args} {
217 puts "checknbshapes ${shape} ${args}"
218 upvar ${shape} ${shape}
219
220 set nbVERTEX -1
221 set nbEDGE -1
222 set nbWIRE -1
223 set nbFACE -1
224 set nbSHELL -1
225 set nbSOLID -1
226 set nbCOMPSOLID -1
227 set nbCOMPOUND -1
228 set nbSHAPE -1
229
230 set message ""
231 set count_locations 0
232 set ref_info ""
233
234 for {set narg 0} {$narg < [llength $args]} {incr narg} {
235 set arg [lindex $args $narg]
236 if {[_check_arg "-vertex" nbVERTEX 1] ||
237 [_check_arg "-edge" nbEDGE 1] ||
238 [_check_arg "-wire" nbWIRE 1] ||
239 [_check_arg "-face" nbFACE 1] ||
240 [_check_arg "-shell" nbSHELL 1] ||
241 [_check_arg "-solid" nbSOLID 1] ||
242 [_check_arg "-compsolid" nbCOMPSOLID 1] ||
243 [_check_arg "-compound" nbCOMPOUND 1] ||
244 [_check_arg "-shape" nbSHAPE 1] ||
245 [_check_arg "-t" count_locations] ||
246 [_check_arg "-m" message 1] ||
247 [_check_arg "-ref" ref_info 1]
248 } {
249 continue
250 }
251 # unsupported option
252 if { [regexp {^-} $arg] } {
253 error "Error: unsupported option \"$arg\""
254 }
255 error "Error: cannot interpret argument $narg ($arg)"
256 }
257
258 if { ${count_locations} == 0 } {
259 set nb_info [nbshapes ${shape}]
260 } else {
261 set nb_info [nbshapes ${shape} -t]
262 }
263
264 set EntityList {VERTEX EDGE WIRE FACE SHELL SOLID COMPSOLID COMPOUND SHAPE}
265
266 foreach Entity ${EntityList} {
267 set expr_string "${Entity} +: +(\[-0-9.+eE\]+)"
268 set to_compare {}
269 # get number of elements from ${shape}
270 if { [regexp "${expr_string}" ${nb_info} full nb_entity2] } {
271 lappend to_compare ${nb_entity2}
272 } else {
273 error "Error : command \"nbshapes ${shape}\" gives an empty result"
274 }
275 # get number of elements from options -vertex -edge and so on
276 set nb_entity1 [set nb${Entity}]
277 if { ${nb_entity1} != -1 } {
278 lappend to_compare ${nb_entity1}
279 }
280 # get number of elements from option -ref
281 if { [regexp "${expr_string}" ${ref_info} full nb_entity_ref] } {
282 lappend to_compare ${nb_entity_ref}
283 }
284 # skip comparing if no reference data was given
285 if {[llength $to_compare] == 1} {
286 continue
287 }
288 # compare all values, if they are equal, length of sorted list "to_compare"
289 # (with key -unique) should be equal to 1
290 set to_compare [lsort -dictionary -unique $to_compare]
291 if { [llength $to_compare] != 1 } {
292 puts "Error : ${message} is WRONG because number of ${Entity} entities in shape \"${shape}\" is ${nb_entity2}"
293 } else {
294 puts "OK : ${message} is GOOD because number of ${Entity} entities is equal to number of expected ${Entity} entities"
295 }
296 }
297}
298
299# Procedure to check equality of two reals with tolerance (relative and absolute)
300help checkreal {
301 Compare value with expected
302 Use: checkreal name value expected tol_abs tol_rel
303}
304proc checkreal {name value expected tol_abs tol_rel} {
305 if { abs ($value - $expected) > $tol_abs + $tol_rel * abs ($expected) } {
306 puts "Error: $name = $value is not equal to expected $expected"
307 } else {
308 puts "Check of $name OK: value = $value, expected = $expected"
309 }
310 return
311}
312
313help checkfreebounds {
314 Compare number of free edges with ref_value
315
316 Use: checkfreebounds shape ref_value [options...]
317 Allowed options are:
318 -tol N: used tolerance (default -0.01)
319 -type N: used type, possible values are "closed" and "opened" (default "closed")
320}
321proc checkfreebounds {shape ref_value args} {
322 puts "checkfreebounds ${shape} ${ref_value} ${args}"
323 upvar ${shape} ${shape}
324
325 set tol -0.01
326 set type "closed"
327
328 for {set narg 0} {$narg < [llength $args]} {incr narg} {
329 set arg [lindex $args $narg]
330 if {[_check_arg "-tol" tol 1] ||
331 [_check_arg "-type" type 1]
332 } {
333 continue
334 }
335 # unsupported option
336 if { [regexp {^-} $arg] } {
337 error "Error: unsupported option \"$arg\""
338 }
339 error "Error: cannot interpret argument $narg ($arg)"
340 }
341
342 if {"$type" != "closed" && "$type" != "opened"} {
343 error "Error : wrong -type key \"${type}\""
344 }
345
346 freebounds ${shape} ${tol}
347 set free_edges [llength [explode ${shape}_[string range $type 0 0] e]]
348
349 if { ${ref_value} == -1 } {
350 puts "Error : Number of free edges is UNSTABLE"
351 return
352 }
353
354 if { ${free_edges} != ${ref_value} } {
355 puts "Error : Number of free edges is not equal to reference data"
356 } else {
357 puts "OK : Number of free edges is ${free_edges}"
358 }
359}
360
361help checkmaxtol {
fb60057d 362 Compare max tolerance of shape with reference value.
363 Command returns max tolerance of the shape.
5ae01c85 364
fb60057d 365 Use: checkmaxtol shape [options...]
5ae01c85 366 Allowed options are:
fb60057d 367 -ref: reference value of maximum tolerance.
368 -source: list of shapes to compare with, e.g.: -source {shape1 shape2 shape3}
369 -min_tol: minimum tolerance for comparison.
370 -multi_tol: tolerance multiplier.
5ae01c85 371}
fb60057d 372
373proc checkmaxtol {shape args} {
374 puts "checkmaxtol ${shape} ${args}"
5ae01c85 375 upvar ${shape} ${shape}
376
fb60057d 377 set ref_value ""
378 set source_shapes {}
5ae01c85 379 set min_tol 0
380 set tol_multiplier 0
381
fb60057d 382 # check arguments
5ae01c85 383 for {set narg 0} {$narg < [llength $args]} {incr narg} {
384 set arg [lindex $args $narg]
385 if {[_check_arg "-min_tol" min_tol 1] ||
fb60057d 386 [_check_arg "-multi_tol" tol_multiplier 1] ||
387 [_check_arg "-source" source_shapes 1] ||
388 [_check_arg "-ref" ref_value 1]
5ae01c85 389 } {
390 continue
391 }
392 # unsupported option
393 if { [regexp {^-} $arg] } {
394 error "Error: unsupported option \"$arg\""
395 }
396 error "Error: cannot interpret argument $narg ($arg)"
397 }
398
399 # get max tol of shape
fb60057d 400 set max_tol 0
401 if {[regexp "Tolerance MAX=(\[-0-9.+eE\]+)" [tolerance ${shape}] full maxtol_temp]} {
402 set max_tol ${maxtol_temp}
403 } else {
404 error "Error: cannot get tolerances of shape \"${shape}\""
405 }
406
407 # find max tol of source shapes
408 foreach source_shape ${source_shapes} {
409 upvar ${source_shape} ${source_shape}
410 set _src_max_tol [checkmaxtol ${source_shape}]
411 if { [expr ${_src_max_tol} > ${min_tol} ] } {
412 set min_tol ${_src_max_tol}
5ae01c85 413 }
414 }
fb60057d 415 # apply -multi_tol option
416 if {${tol_multiplier}} {
417 set min_tol [expr ${tol_multiplier} * ${_src_max_tol}]
418 }
419 # compare max tol of source shapes with checking tolerance
420 if { ${min_tol} && [expr ${max_tol} > ${min_tol}] } {
421 puts "Error: tolerance of \"${shape}\" (${max_tol}) is greater than checking tolerance (${min_tol})"
422 }
423 if { ${ref_value} != "" } {
424 checkreal "Max tolerance" ${max_tol} ${ref_value} 0.0001 0.01
425 }
426 return ${max_tol}
5ae01c85 427}
428
429help checkfaults {
430 Compare faults number of given shapes.
431
432 Use: checkfaults shape source_shape [ref_value=0]
433}
434proc checkfaults {shape source_shape {ref_value 0}} {
435 puts "checkfaults ${shape} ${source_shape} ${ref_value}"
436 upvar $shape $shape
437 upvar $source_shape $source_shape
438 set cs_a [checkshape $source_shape]
439 set nb_a 0
440 if {[regexp {Faulty shapes in variables faulty_([0-9]*) to faulty_([0-9]*)} $cs_a full nb_a_begin nb_a_end]} {
441 set nb_a [expr $nb_a_end - $nb_a_begin +1]
442 }
443 set cs_r [checkshape $shape]
444 set nb_r 0
445 if {[regexp {Faulty shapes in variables faulty_([0-9]*) to faulty_([0-9]*)} $cs_r full nb_r_begin nb_r_end]} {
446 set nb_r [expr $nb_r_end - $nb_r_begin +1]
447 }
448 puts "Number of faults for the initial shape is $nb_a."
449 puts "Number of faults for the resulting shape is $nb_r."
450
451 if { ${ref_value} == -1 } {
452 puts "Error : Number of faults is UNSTABLE"
453 return
454 }
455
456 if { $nb_r > $nb_a } {
457 puts "Error : Number of faults is $nb_r"
458 }
459}
58cf74e0 460
461# auxiliary: check all arguments
462proc _check_args { args {options {}} {command_name ""}} {
463 # check arguments
464 for {set narg 0} {${narg} < [llength ${args}]} {incr narg} {
465 set arg [lindex ${args} ${narg}]
466 set toContinue 0
467 foreach option ${options} {
468 set option_name [lindex ${option} 0]
469 set variable_to_save_value [lindex ${option} 1]
470 set get_value [lindex ${option} 2]
471 set local_value ""
472 if { [_check_arg ${option_name} local_value ${get_value}] } {
473 upvar ${variable_to_save_value} ${variable_to_save_value}
474 set ${variable_to_save_value} ${local_value}
475 set toContinue 1
476 }
477 }
478 if {${toContinue}} { continue }
479 # unsupported option
480 if { [regexp {^-} ${arg}] } {
481 error "Error: unsupported option \"${arg}\""
482 }
483 error "Error: cannot interpret argument ${narg} (${arg})"
484 }
485 foreach option ${options} {
486 set option_name [lindex ${option} 0]
487 set variable_to_save_value [lindex ${option} 1]
488 set should_exist [lindex ${option} 3]
489 if {![info exists ${variable_to_save_value}] && ${should_exist} == 1} {
490 error "Error: wrong using of command '${command_name}', '${option_name}' option is required"
491 }
492 }
493}
494
495help checkprops {
496 Procedure includes commands to compute length, area and volume of input shape.
497
498 Use: checkprops shapename [options...]
499 Allowed options are:
500 -l LENGTH: command lprops, computes the mass properties of all edges in the shape with a linear density of 1
501 -s AREA: command sprops, computes the mass properties of all faces with a surface density of 1
502 -v VOLUME: command vprops, computes the mass properties of all solids with a density of 1
503 -eps EPSILON: the epsilon defines relative precision of computation
504 -equal SHAPE: compare area\volume\length of input shapes. Puts error if its are not equal
505 -notequal SHAPE: compare area\volume\length of input shapes. Puts error if its are equal
506 Options -l, -s and -v are independent and can be used in any order. Tolerance epsilon is the same for all options.
507}
508
509proc checkprops {shape args} {
510 puts "checkprops ${shape} ${args}"
511 upvar ${shape} ${shape}
512
513 if {![isdraw ${shape}] || [regexp "${shape} is a \n" [whatis ${shape}]]} {
514 puts "Error: The command cannot be built"
515 return
516 }
517
518 set length -1
519 set area -1
520 set volume -1
521 set epsilon 1.0e-4
522 set compared_equal_shape -1
523 set compared_notequal_shape -1
524 set equal_check 0
525
526 set options {{"-eps" epsilon 1}
527 {"-equal" compared_equal_shape 1}
528 {"-notequal" compared_notequal_shape 1}}
529
530 if { [regexp {\-[not]*equal} $args] } {
531 lappend options {"-s" area 0}
532 lappend options {"-l" length 0}
533 lappend options {"-v" volume 0}
534 set equal_check 1
535 } else {
536 lappend options {"-s" area 1}
537 lappend options {"-l" length 1}
538 lappend options {"-v" volume 1}
539 }
540 _check_args ${args} ${options} "checkprops"
541
542 if { ${length} != -1 || ${equal_check} == 1 } {
543 set CommandName lprops
544 set mass $length
545 set prop "length"
546 set equal_check 0
547 }
548 if { ${area} != -1 || ${equal_check} == 1 } {
549 set CommandName sprops
550 set mass $area
551 set prop "area"
552 set equal_check 0
553 }
554 if { ${volume} != -1 || ${equal_check} == 1 } {
555 set CommandName vprops
556 set mass $volume
557 set prop "volume"
558 set equal_check 0
559 }
560
561 regexp {Mass +: +([-0-9.+eE]+)} [${CommandName} ${shape} ${epsilon}] full m
562
563 if { ${compared_equal_shape} != -1 } {
564 upvar ${compared_equal_shape} ${compared_equal_shape}
565 regexp {Mass +: +([-0-9.+eE]+)} [${CommandName} ${compared_equal_shape} ${epsilon}] full compared_m
566 if { $compared_m != $m } {
567 puts "Error: Shape ${compared_equal_shape} is not equal to shape ${shape}"
568 }
569 }
570
571 if { ${compared_notequal_shape} != -1 } {
572 upvar ${compared_notequal_shape} ${compared_notequal_shape}
573 regexp {Mass +: +([-0-9.+eE]+)} [${CommandName} ${compared_notequal_shape} ${epsilon}] full compared_m
574 if { $compared_m == $m } {
575 puts "Error: Shape ${compared_notequal_shape} is equal shape to ${shape}"
576 }
577 }
578
579 if { ${compared_equal_shape} == -1 && ${compared_notequal_shape} == -1 } {
580 if { [string compare "$mass" "empty"] != 0 } {
581 if { $m == 0 } {
582 puts "Error : The command is not valid. The $prop is 0."
583 }
584 if { $mass > 0 } {
585 puts "The expected $prop is $mass"
586 }
587 #check of change of area is < 1%
588 if { ($mass != 0 && [expr 1.*abs($mass - $m)/$mass] > 0.01) || ($mass == 0 && $m != 0) } {
589 puts "Error : The $prop of result shape is $m"
590 }
591 } else {
592 if { $m != 0 } {
593 puts "Error : The command is not valid. The $prop is $m"
594 }
595 }
596 }
3ad6d001 597}
598
599help checkdump {
600 Procedure includes command to parse output dump and compare it with reference values.
601
602 Use: checkdump shapename [options...]
603 Allowed options are:
604 -name NAME: list of parsing parameters (e.g. Center, Axis, etc)
605 -ref VALUE: list of reference values for each parameter in NAME
606 -eps EPSILON: the epsilon defines relative precision of computation
607}
608
609proc checkdump {shape args} {
610 puts "checkdump ${shape} ${args}"
611 upvar ${shape} ${shape}
612
613 set ddump -1
614 set epsilon -1
615 set options {{"-name" params 1}
616 {"-ref" ref 1}
617 {"-eps" epsilon 1}
618 {"-dump" ddump 1}}
619
620 if { ${ddump} == -1 } {
621 set ddump [dump ${shape}]
622 }
623 _check_args ${args} ${options} "checkdump"
624
625 set index 0
626 foreach param ${params} {
627 set pattern "${param}\\s*:\\s*"
628 set number_pattern "(\[-0-9.+eE\]+)\\s*"
629 set ref_values ""
630 set local_ref ${ref}
631 if { [llength ${params}] > 1 } {
632 set local_ref [lindex ${ref} ${index}]
633 }
634 foreach item ${local_ref} {
635 if { ![regexp "$pattern$number_pattern" $ddump full res] } {
636 puts "Error: cheked parameter ${param} is not listed in dump"
637 break
638 }
639 lappend ref_values $res
640 set pattern "${pattern}${res},\\s*"
641 ## without precision
642 if { ${epsilon} == -1 } {
643 if { ${item} != ${res} } {
644 puts "Error: parameter ${param} - current value (${res}) is not equal to reference value (${item})"
645 } else {
646 puts "OK: parameter ${param} - current value (${res}) is equal to reference value (${item})"
647 }
648 ## with precision
649 } else {
650 set precision 0.0000001
651 if { ( abs($res) > $precision ) || ( abs($item) > $precision ) } {
652 if { ($item != 0 && [expr 1.*abs($item - $res)/$item] > $epsilon) || ($item == 0 && $res != 0) } {
653 puts "Error: The $param of the resulting shape is $res and the expected $param is $item"
654 } else {
655 puts "OK: parameter ${param} - current value (${res}) is equal to reference value (${item})"
656 }
657 }
658 }
659 }
660 incr index
661 }
662}
663
664help checklength {
665 Procedure includes commands to compute length of input shape.
666
667 Use: checklength shapename [options...]
668 Allowed options are:
669 -l LENGTH: command length, computes the length of input curve with precision of computation
670 -eps EPSILON: the epsilon defines relative precision of computation
671 -equal SHAPE: compare length of input shapes. Puts error if its are not equal
672 -notequal SHAPE: compare length of input shapes. Puts error if its are equal
673}
674
675proc checklength {shape args} {
676 puts "checklength ${shape} ${args}"
677 upvar ${shape} ${shape}
678
679 if {![isdraw ${shape}] || [regexp "${shape} is a \n" [whatis ${shape}]]} {
680 puts "Error: The command cannot be built"
681 return
682 }
683
684 set length -1
685 set epsilon 1.0e-4
686 set compared_equal_shape -1
687 set compared_notequal_shape -1
688 set equal_check 0
689
690 set options {{"-eps" epsilon 1}
691 {"-equal" compared_equal_shape 1}
692 {"-notequal" compared_notequal_shape 1}}
693
694 if { [regexp {\-[not]*equal} $args] } {
695 lappend options {"-l" length 0}
696 set equal_check 1
697 } else {
698 lappend options {"-l" length 1}
699 }
700 _check_args ${args} ${options} "checkprops"
701
702 if { ${length} != -1 || ${equal_check} == 1 } {
703 set CommandName length
704 set mass $length
705 set prop "length"
706 set equal_check 0
707 }
708
709 regexp "The +length+ ${shape} +is +(\[-0-9.+eE\]+)" [${CommandName} ${shape} ${epsilon}] full m
710
711 if { ${compared_equal_shape} != -1 } {
712 upvar ${compared_equal_shape} ${compared_equal_shape}
713 regexp "The +length+ ${compared_equal_shape} +is +(\[-0-9.+eE\]+)" [${CommandName} ${compared_equal_shape} ${epsilon}] full compared_m
714 if { $compared_m != $m } {
715 puts "Error: length of shape ${compared_equal_shape} is not equal to shape ${shape}"
716 }
717 }
718
719 if { ${compared_notequal_shape} != -1 } {
720 upvar ${compared_notequal_shape} ${compared_notequal_shape}
6cc6fc04 721 regexp "The +length+ ${compared_notequal_shape} +is +(\[-0-9.+eE\]+)" [${CommandName} ${compared_notequal_shape} ${epsilon}] full compared_m
3ad6d001 722 if { $compared_m == $m } {
723 puts "Error: length of shape ${compared_notequal_shape} is equal shape to ${shape}"
724 }
725 }
726
727 if { ${compared_equal_shape} == -1 && ${compared_notequal_shape} == -1 } {
728 if { [string compare "$mass" "empty"] != 0 } {
729 if { $m == 0 } {
730 puts "Error : The command is not valid. The $prop is 0."
731 }
732 if { $mass > 0 } {
733 puts "The expected $prop is $mass"
734 }
735 #check of change of area is < 1%
736 if { ($mass != 0 && [expr 1.*abs($mass - $m)/$mass] > 0.01) || ($mass == 0 && $m != 0) } {
737 puts "Error : The $prop of result shape is $m"
738 }
739 } else {
740 if { $m != 0 } {
741 puts "Error : The command is not valid. The $prop is $m"
742 }
743 }
744 }
5747059b 745}
746
747help checkview {
748 Display shape in selected viewer.
749
750 Use: checkview [options...]
751 Allowed options are:
752 -display shapename: display shape with name 'shapename'
753 -3d: display shape in 3d viewer
754 -2d [ v2d / smallview ]: display shape in 2d viewer (default viewer is a 'smallview')
755 -path PATH: location of saved screenshot of viewer
756 -vdispmode N: it is possible to set vdispmode for 3d viewer (default value is 1)
757 -screenshot: procedure will try to make screenshot of already created viewer
758 Procedure can check some property of shape (length, area or volume) and compare it with some value N:
759 -l [N]
760 -s [N]
761 -v [N]
762 If current property is equal to value N, shape is marked as valid in procedure.
763 If value N is not given procedure will mark shape as valid if current property is non-zero.
764 -with {a b c}: display shapes 'a' 'b' 'c' together with 'shape' (if shape is valid)
765 -otherwise {d e f}: display shapes 'd' 'e' 'f' instead of 'shape' (if shape is NOT valid)
766 Note that one of two options -2d/-3d is required.
767}
768
769proc checkview {args} {
770 puts "checkview ${args}"
771
772 set 3dviewer 0
773 set 2dviewer false
774 set shape ""
775 set PathToSave ""
776 set dispmode 1
777 set isScreenshot 0
778 set check_length false
779 set check_area false
780 set check_volume false
781 set otherwise {}
782 set with {}
783
784 set options {{"-3d" 3dviewer 0}
785 {"-2d" 2dviewer ?}
786 {"-display" shape 1}
787 {"-path" PathToSave 1}
788 {"-vdispmode" dispmode 1}
789 {"-screenshot" isScreenshot 0}
790 {"-otherwise" otherwise 1}
791 {"-with" with 1}
792 {"-l" check_length ?}
793 {"-s" check_area ?}
794 {"-v" check_volume ?}}
795
796 # check arguments
797 _check_args ${args} ${options} "checkview"
798
799 if { ${PathToSave} == "" } {
800 set PathToSave "./photo.png"
801 }
802
803 if { ${3dviewer} == 0 && ${2dviewer} == false } {
804 error "Error: wrong using of command 'checkview', please use -2d or -3d option"
805 }
806
807 if { ${isScreenshot} } {
808 if { ${3dviewer} } {
809 vdump ${PathToSave}
810 } else {
811 xwd ${PathToSave}
812 }
813 return
814 }
815
816 set mass 0
817 set isBAD 0
818 upvar ${shape} ${shape}
819 if {[isdraw ${shape}]} {
820 # check area
821 if { [string is boolean ${check_area}] } {
822 if { ${check_area} } {
823 regexp {Mass +: +([-0-9.+eE]+)} [sprops ${shape}] full mass
824 }
825 } else {
826 set mass ${check_area}
827 }
828 # check length
829 if { [string is boolean ${check_length}] } {
830 if { ${check_length} } {
831 regexp {Mass +: +([-0-9.+eE]+)} [lprops ${shape}] full mass
832 }
833 } else {
834 set mass ${check_length}
835 }
836 # check volume
837 if { [string is boolean ${check_volume}] } {
838 if { ${check_volume} } {
839 regexp {Mass +: +([-0-9.+eE]+)} [vprops ${shape}] full mass
840 }
841 } else {
842 set mass ${check_volume}
843 }
844 } else {
845 set isBAD 1
846 }
847 if { ${3dviewer} } {
848 vinit
849 vclear
850 } elseif { ([string is boolean ${2dviewer}] && ${2dviewer}) || ${2dviewer} == "smallview"} {
851 smallview
852 clear
853 } elseif { ${2dviewer} == "v2d"} {
854 v2d
855 2dclear
856 }
857 if {[isdraw ${shape}]} {
858 if { ( ${check_area} == false && ${check_length} == false && ${check_volume} == false ) || ( ${mass} != 0 ) } {
859 foreach s ${with} {
860 upvar ${s} ${s}
861 }
862 lappend with ${shape}
863 if { ${3dviewer} } {
864 vdisplay {*}${with}
865 } else {
866 donly {*}${with}
867 }
868 } else {
869 set isBAD 1
870 }
871 } else {
872 set isBAD 1
873 }
874
875 if { ${isBAD} && [llength ${otherwise}] } {
876 foreach s ${otherwise} {
877 upvar ${s} ${s}
878 }
879 if { ${3dviewer} } {
880 vdisplay {*}${otherwise}
881 } else {
882 donly {*}${otherwise}
883 }
884 }
885
886 if { ${3dviewer} } {
887 vsetdispmode ${dispmode}
888 vfit
889 vdump ${PathToSave}
890 } else {
891 if { ([string is boolean ${2dviewer}] && ${2dviewer}) || ${2dviewer} == "smallview"} {
892 fit
893 } elseif { ${2dviewer} == "v2d"} {
894 2dfit
895 }
896 xwd ${PathToSave}
897 }
58cf74e0 898}