1# File : begin
2if { [array get Draw_Groups "TOPOLOGY Check commands"] == "" } {
3    pload TOPTEST
4    pload VISUALIZATION
5}
6pload XDE
7pload QAcommands
8
9if { [info exists imagedir] == 0 } {
10   set imagedir .
11}
12if { [info exists test_image] == 0 } {
13   set test_image photo
14}
15
16set scriptdir [file dirname [info script]]
17
18set mistake 0
19
20#################### procedure GetDigit returns digit (cut) from string ####################
21proc GetDigit {s} {
22  set res ""
23  for {set a 0} {$a < [string length $s]} {incr a} {
24    if {[string index $s $a]>="0" && [string index $s $a]<="9"} {
25        set res [set res][string index $s $a]
26    } else {
27      if {[string index $s $a]=="e" || [string index $s $a]=="-"} {
28        set res [set res][string index $s $a]
29      } else {return $res}
30    } else {return $res}
31  }
32  return $res
33}
34
35#################### procedure ShapeCenter returns (three coords string) center of given shape
36proc ShapeCenter {s} {
37puts $s
38  global $s
39  return [CenterOfShape $s]
40#  set ss [explode $s V]
41#  if {[llength $ss] == 0} {set ss $s}
42#  set x 0
43#  set y 0
44#  set z 0
45#  for {set a 0} {[lindex $ss $a] != ""} {incr a} {
46#    set dmp [dump [lindex $ss $a]]
47#    set fromindex [lsearch $dmp Elementary]
48#    if {$fromindex != -1} {
49#      set x [expr $x+[GetDigit [lindex $dmp [expr $fromindex+6]]]]
50#      set y [expr $y+[GetDigit [lindex $dmp [expr $fromindex+12]]]]
51#      set z [expr $z+[GetDigit [lindex $dmp [expr $fromindex+18]]]]
52#    }
53#    set fromindex [lsearch $dmp "3D"]
54#    set x [expr $x+[GetDigit [lindex $dmp [expr $fromindex+2]]]]
55#    set y [expr $y+[GetDigit [lindex $dmp [expr $fromindex+3]]]]
56#    set z [expr $z+[GetDigit [lindex $dmp [expr $fromindex+4]]]]
57#  }
58#  set x [expr $x/[llength $ss]]
59#  set y [expr $y/[llength $ss]]
60#  set z [expr $z/[llength $ss]]
61#  return "$x $y $z"
62}
63
64#################### procedure IsSame returns true, if given shapes has same TShapes ####################
65proc IsSame {s1 s2} {
66  global $s1 $s2
67puts "$s1 $s2"
68  if {[IsSameShapes $s1 $s2] == 1} {return 1}
69  return 0
70#
71#  set d1 [dump $s1]
72#  set d2 [dump $s1]
73#  if {[llength $d1]<10 || [llength $d2]<10} {
74#	return 0
75#  }
76#
77#  if {[lindex [dump $s1] 28] == [lindex [dump $s2] 28]} {
78#    if {[lindex [dump $s1] 29] == [lindex [dump $s2] 29]} {return 1}
79#  }
80#  return 0
81}
82
83#################### procedure NextLabel set lab as next label of lab at this level ####################
84proc NextLabel {lab} {
85  upvar 1 $lab l
86  set i [string last ":" "[set l]"]
87  if {$i == -1} {set l [expr [set l]+1]} else {
88    set l [string range [set l] 0 $i][expr 1+[string range [set l] [expr $i+1] [string length [set l]]]]
89  }
90}
91
92#################### checking the naming at myLab label ( tests at myNameLab label ) ####################
93#################### show errors, increments working labels                          ####################
94proc Checking {Name} {
95  global D IsDone TestError
96  upvar 1 myLab l1 myNameLab l2
97
98  set bad ""
99  if {[catch {set bad [CheckNaming D $l2 1 Label $l1 1 1 1]}]} {
100	set IsDone 0
101	set TestError "$TestError # $Name naming failed at label $l2 with exception"
102  } else {
103    if {[llength $bad] > 0} {
104	set IsDone 0
105  	set TestError "$TestError # $Name naming failed at label $l2 sublabels $bad"
106    }
107  }
108  NextLabel l1
109  NextLabel l2
110}
111