Scid  4.6.5
validate.tcl
Go to the documentation of this file.
1 
2 
3 # ::utils::validate::Integer
4 #
5 # Used to check the size of integers in entry boxes.
6 #
7 proc ::utils::validate::Integer {maxValue allowQuestionMarks name el op} {
8  global $name ${name}_old
9  if {[string comp {} $el]} {
10  set old ${name}_old\($el\)
11  set name $name\($el\)
12  } else {
13  set old ${name}_old
14  }
15 
16  if {$allowQuestionMarks > 0} {
17  if {[regexp {^\?*$} [set $name]]} {
18  # Accept this value:
19  set $old [set $name]
20  return
21  }
22  }
23 
24  # Only non-negative integers up to maxValue are allowed, unless the
25  # value is negative:
26  set allowNegatives 0
27  if {$maxValue < 0} {
28  set allowNegatives 1
29  set maxValue [expr {0 - $maxValue}]
30  }
31 
32  if {$allowNegatives} {
33  if {![regexp {^[-+]?[0-9]*$} [set $name]]} {
34  set $name [set $old]
35  bell
36  return
37  }
38  } else {
39  if {![regexp {^[+]?[0-9]*$} [set $name]]} {
40  set $name [set $old]
41  bell
42  return
43  }
44  }
45  if {[set $name] > $maxValue} {
46  set $name [set $old]
47  bell
48  return
49  }
50  #if {[expr {0 - [set $name]}] < [expr {0 - $maxValue}]} {
51  # set $name [set $old]
52  # bell
53  # return
54  #}
55  set $old [set $name]
56 }
57 
58 
59 
60 # ::utils::validate::Date
61 #
62 # Used to check the validity of a date string as it is entered.
63 #
64 proc ::utils::validate::Date {name el op} {
65  global $name ${name}_old
66  set old ${name}_old
67  if {![sc_info validDate [set $name]]} {
68  set $name [set $old]
69  bell
70  return
71  }
72  set $old [set $name]
73 }
74 
75 # ::utils::validate::Result
76 #
77 # Used to check the validity of a result entrybox value.
78 # Result can be empty, "1", "0", "=", or "*".
79 #
80 proc ::utils::validate::Result {name el op} {
81  global $name ${name}_old
82  set old ${name}_old
83  if {![regexp {^[1|0|=|\*]?$} [set $name]]} {
84  set $name [set $old]
85  bell
86  return
87  }
88  set $old [set $name]
89 }
90 
91 # ::utils::validate::Alpha
92 #
93 # Used to check that an entrybox contains only letters.
94 #
95 proc ::utils::validate::Alpha {name el op} {
96  global $name ${name}_old
97  set old ${name}_old
98  if {![regexp {^[A-Za-z]*$} [set $name]]} {
99  set $name [set $old]
100  bell
101  return
102  }
103  set $old [set $name]
104 
105 }
106 
107 # ::utils::validate::Regexp
108 #
109 # Used to check the validity of an entrybox given a regular expression.
110 # Used to verify a file is "a-h", for example.
111 #
112 proc ::utils::validate::Regexp {expression name el op} {
113  global $name ${name}_old
114  set old ${name}_old
115  if {![regexp $expression [set $name]]} {
116  set $name [set $old]
117  bell
118  return
119  }
120  set $old [set $name]
121 }
122 
123 # ::utils::validate::roundScale
124 # will round var to the next integer which is a multiple of tickinterval
125 # given its current value
126 proc ::utils::validate::roundScale { var tickinterval value } {
127  set $var [expr int($value/$tickinterval ) * $tickinterval]
128 }
129 
130 # ::utils::validate::floatScale
131 # returns a float value with 1 decimal
132 proc ::utils::validate::floatScale { var tickinterval value } {
133  set $var [format "%.1f" [expr ($value/$tickinterval ) * $tickinterval]]
134 }