1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
# File : begin
# 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
global color2d
if { [info exists color2d] } {
set color [ QAAISGetPixelColor2d ${position_x} ${position_y} ]
} else {
set color [ QAGetPixelColor ${position_x} ${position_y} ]
}
regexp {RED +: +([-0-9.+eE]+)} $color full rd
regexp {GREEN +: +([-0-9.+eE]+)} $color full gr
regexp {BLUE +: +([-0-9.+eE]+)} $color full bl
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
}
# Procedure to check color using command QAgetPixelColor 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
}
global color2d
if { [info exists color2d] } {
set color [ QAAISGetPixelColor2d ${coord_x} ${coord_y} ]
} else {
set color [ QAGetPixelColor ${coord_x} ${coord_y} ]
}
regexp {RED +: +([-0-9.+eE]+)} $color full rd
regexp {GREEN +: +([-0-9.+eE]+)} $color full gr
regexp {BLUE +: +([-0-9.+eE]+)} $color full bl
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
}
}
|
