1 # myamx.tcl --
2 #
3 # A test script for testing amxd functionality
4 #
5 # Copyright (c) 2000-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30
31 import Application DpClient
32
33 Class TesterApp -superclass {Application}
34
35 global verbose_
36
37 TesterApp instproc init {} {
38 $self instvar amx_ devText_ chanText_ comText_ com_ dev_ chan_ str_ mon_
39
40 if {[catch {new DpClient htsr.bmrc.berkeley.edu 6901} amx_]} {
41 puts stderr "Fatal error: could not connext to AMX server"
42 }
43
44 # set amx_ [new DpClient htsr.bmrc.berkeley.edu 6901]
45
46 set com_ 0
47 set dev_ 0
48 set chan_ 0
49 set str_ ""
50
51
52 $self initUI
53 }
54
55 TesterApp instproc initUI {} {
56 global verbose_
57 $self instvar devText_ chanText_ comText_ strText_
58
59 wm title . "myAmx"
60
61 frame .entry
62 pack .entry -side top -pady 10
63
64 label .entry.commandLabel -text "command"
65 pack .entry.commandLabel -side left
66 set comText_ [text .entry.commandText -width 4 -height 1]
67 pack .entry.commandText -side left
68
69 label .entry.deviceLabel -text "device"
70 pack .entry.deviceLabel -side left
71 set devText_ [text .entry.deviceText -width 4 -height 1]
72 pack .entry.deviceText -side left
73
74 label .entry.channelLabel -text "channel"
75 pack .entry.channelLabel -side left
76 set chanText_ [text .entry.channelText -width 4 -height 1]
77 pack .entry.channelText -side left
78
79 label .entry.stringLabel -text "string"
80 pack .entry.stringLabel -side left
81 set strText_ [text .entry.strText -width 25 -height 1]
82 pack .entry.strText -side left
83
84 frame .but
85 pack .but -side top -pady 10
86
87 button .but.send -text "send" -command "$self send_amx_simple"
88 pack .but.send -side left
89 button .but.send2 -text "send tagged" -command "$self send_amx_simple_tagged"
90 pack .but.send2 -side left
91 button .but.send3 -text "send str" -command "$self send_amx_string"
92 pack .but.send3 -side left
93 button .but.send4 -text "send id" -command "$self send_amx_id"
94 pack .but.send4 -side left
95
96 button .but.send5 -text "temp" -command "$self temp_func"
97 pack .but.send5 -side left
98
99
100 button .but.get -text "get" -command "$self print_amx"
101 pack .but.get -side left
102
103 button .but.empty -text "empty" -command "$self empty_buf"
104 pack .but.empty -side left
105
106 frame .monitor
107 pack .monitor -side top -pady 10
108
109 checkbutton .monitor.verbose -text "verbose" -variable verbose_
110 set verbose_ 0
111 pack .monitor.verbose -side left
112 button .monitor.start -text "start monitor" -command "$self start_mon"
113 pack .monitor.start -side left
114 button .monitor.stop -text "stop monitor" -command "$self stop_mon"
115 pack .monitor.stop -side left
116 canvas .monitor.onOff -width 20 -height 20 -borderwidth 0 -highlightthickness 0
117 pack .monitor.onOff
118 .monitor.onOff create rect 5 5 16 16 -fill green
119
120 # exit button
121 button .exit -text "Exit" -command exit
122 pack .exit -side bottom
123 }
124
125 # mode can be "quiet" or "verbose"
126 TesterApp public start_mon { {mode quiet} } {
127 global verbose_
128 $self instvar mon_
129
130 if {$verbose_ == 1} {
131 set mode "verbose"
132 }
133
134 $self empty_buf quiet
135 set mon_ 1
136 .monitor.onOff create rect 5 5 16 16 -fill red
137
138 while {$mon_ == 1} {
139 set retval [$self get_amx]
140 if {[string compare $retval "{0}"] == 0} {
141 if {[string compare $mode "verbose"] == 0} {
142 puts stdout "receive-AMX-command returns: $retval"
143 }
144 } else {
145 puts stdout "receive-AMX-command returns: $retval"
146 }
147 $self sleep 500
148 }
149 }
150
151 # this part simulates a sleep of time equal to the after parameter
152 TesterApp public sleep { time } {
153 set x 0
154 after $time {set x 1}
155 vwait x
156 }
157
158 TesterApp public stop_mon {} {
159 $self instvar mon_
160
161 set mon_ 0
162 .monitor.onOff create rect 5 5 16 16 -fill green
163 }
164
165 TesterApp public empty_buf { {mode quiet} } {
166 global verbose_
167
168 set retval [$self get_amx]
169
170 if {$verbose_ == 1} {
171 set mode "verbose"
172 }
173
174 while {[string compare $retval "{0}"] != 0} {
175 if {[string compare $mode "verbose"] == 0} {
176 puts stdout "receive-AMX-command returns: $retval"
177 }
178 set retval [$self get_amx]
179 }
180
181 if {[string compare $mode "verbose"] == 0} {
182 puts stdout "AMX buf empty"
183 }
184 }
185
186 TesterApp public get_amx {} {
187 $self instvar amx_
188
189 set retval [$amx_ do receive-AMX-command]
190
191 return $retval
192 }
193
194 TesterApp public print_amx {} {
195 set retval [$self get_amx]
196 puts stdout "receive-AMX-command returns: $retval"
197
198 return $retval
199 }
200
201 TesterApp private get_values {} {
202 $self instvar comText_ devText_ chanText_ strText_ com_ dev_ chan_ str_
203
204 set comStr [$comText_ get 1.0 1.end]
205 scan $comStr "%d" com_
206 # puts stdout "com is $com_"
207
208 set devStr [$devText_ get 1.0 1.end]
209 scan $devStr "%d" dev_
210 # puts stdout "dev is $dev_"
211
212 set chanStr [$chanText_ get 1.0 1.end]
213 scan $chanStr "%d" chan_
214 # puts stdout "chan is $chan_"
215
216 set str_ [$strText_ get 1.0 1.end]
217 # puts stdout "str is $str_"
218 }
219
220 TesterApp public send_amx_simple {} {
221 $self instvar amx_ dev_ chan_ com_
222
223 $self get_values
224
225 set retval [$amx_ do send-AMX-command $com_ $dev_ $chan_]
226
227 puts stdout "send-AMX-command returns: $retval"
228 # after 500
229 # $self print_amx
230 }
231
232 TesterApp public send_amx_simple_tagged {} {
233 $self instvar amx_ dev_ chan_ com_
234
235 $self get_values
236
237 set retval [$amx_ do send-AMX-command-tagged $com_ $dev_ $chan_ "fire32" 5 7]
238
239 puts stdout "send-AMX-command-tagged returns: $retval"
240 # after 500
241 # $self print_amx
242 }
243
244 TesterApp public temp_func {} {
245 $self instvar amx_ dev_ chan_ com_ str_
246
247 $self get_values
248
249 set val [binary format "acccac" "&" 4 3 1 "C" 0x76]
250
251 puts stdout "val is $val"
252
253 set retval [$amx_ do send-AMX-command-tagged 4 1 $val "slurp" 5 2]
254
255 # puts stdout "send-AMX-command returns: $retval"
256 # after 500
257 # $self print_amx
258 }
259
260 TesterApp public send_amx_string {} {
261 $self instvar amx_ dev_ chan_ com_ str_
262
263 $self get_values
264
265 set retval [$amx_ do send-AMX-command-tagged $com_ $dev_ $str_ "hello" 1 9]
266
267 puts stdout "send-AMX-command returns: $retval"
268 # after 500
269 # $self print_amx
270 }
271
272 TesterApp public send_amx_id {} {
273 $self instvar amx_ dev_ com_
274
275 $self get_values
276
277 set retval [$amx_ do send-AMX-command $com_ $dev_]
278
279 puts stdout "send-AMX-command returns: $retval"
280 # after 500
281 # $self print_amx
282 }
283
284 set app [new TesterApp]
285
286 vwait forever
287
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.