1 # amxtest.tcl --
2 #
3 # For debugging, allows you to send arbitrary commands to amx
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 global g_app
32
33 Import enable
34
35 import Application DpClient
36
37 Class AmxTestApp -superclass Application
38
39 AmxTestApp instproc init {argv} {
40 $self instvar amx_
41
42 $self next $argv
43 $self initUI
44 # $self initAmx garfield.cs.berkeley.edu 6901
45 $self initAmx htsr.bmrc.berkeley.edu 6901
46 }
47
48 #
49 # GUI stuff
50 #
51
52 AmxTestApp instproc initUI {} {
53 $self instvar comText_ devText_ chanText_ strText_ cmd_ dev_ chan_ str_
54
55 wm title . "AmxTest"
56 wm minsize . 150 0
57
58 frame .entry
59 pack .entry -side top -pady 10
60
61 label .entry.commandLabel -text "command"
62 pack .entry.commandLabel -side left
63 set comText_ [text .entry.commandText -width 4 -height 1]
64 pack .entry.commandText -side left
65 $comText_ insert 0.0 "4"
66
67 label .entry.deviceLabel -text "device"
68 pack .entry.deviceLabel -side left
69 set devText_ [text .entry.deviceText -width 4 -height 1]
70 pack .entry.deviceText -side left
71 $devText_ insert 0.0 "5"
72
73 label .entry.channelLabel -text "channel"
74 pack .entry.channelLabel -side left
75 set chanText_ [text .entry.channelText -width 4 -height 1]
76 pack .entry.channelText -side left
77 $chanText_ insert 0.0 "133"
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 $strText_ insert 0.0 "A"
84
85 frame .but
86 pack .but -side top -pady 10
87
88 button .but.send -text "Send AMX" -command "$self sendAmx"
89 pack .but.send -side left
90 button .but.receive -text "Receive AMX" -command "$self getAmx"
91 pack .but.receive -side left
92 button .but.spoof -text "Spoof AMX" -command "$self spoofAmx"
93 pack .but.spoof -side left
94
95 button .kill -text "Kill Server and Exit" -command "$self killServer"
96 pack .kill -side top
97
98 button .test -text "Register" -command "$self execTest"
99 pack .test -side top
100 button .test5 -text "Unregister" -command "$self execTest5"
101 pack .test5 -side top
102 button .test2 -text "Disable" -command "$self execTest2"
103 pack .test2 -side top
104 button .test3 -text "Enable" -command "$self execTest3"
105 pack .test3 -side top
106 button .test4 -text "Test" -command "$self execTest4"
107 pack .test4 -side top
108
109 button .test20 -text "Register2" -command "$self execTest20"
110 pack .test20 -side top
111 button .test25 -text "Unregister2" -command "$self execTest25"
112 pack .test25 -side top
113 button .test22 -text "Disable2" -command "$self execTest22"
114 pack .test22 -side top
115 button .test23 -text "Enable2" -command "$self execTest23"
116 pack .test23 -side top
117
118 # make exit button
119 button .exit -text "Exit" -command "$self exitApp"
120 pack .exit -side bottom
121 }
122
123 AmxTestApp instproc initAmx { {hostname htsr.bmrc.berkeley.edu} {port 6901}} {
124 $self instvar amx_
125
126 if {[catch {new DpClient $hostname $port} amx_]} {
127 puts stderr "Fatal error: could not connext to AMX server"
128 exit
129 }
130 }
131
132 AmxTestApp instproc execTest {} {
133 $self instvar amx_
134
135 set result [$amx_ do callback_register getAmx]
136 return $result
137 }
138
139 AmxTestApp instproc execTest2 {} {
140 $self instvar amx_
141
142 set result [$amx_ do callback_disable getAmx]
143 return $result
144 }
145
146 AmxTestApp instproc execTest3 {} {
147 $self instvar amx_
148
149 set result [$amx_ do callback_enable getAmx]
150
151 return $result
152 }
153
154 AmxTestApp instproc execTest4 {} {
155 $self instvar amx_
156
157 set result [$amx_ do amxd_getVersion]
158
159 puts "amxd version = $result"
160
161 if {$result == 1.0} {
162 puts stdout "compatible version"
163 } else {
164 puts stdout "incompatible version"
165 }
166
167 for {set x 1} {$x < 16} {incr x 1} {
168 set name [$amx_ do amx_deviceLookup $x]
169 puts stdout "device $x is $name"
170 }
171 for {set x 128} {$x < 130} {incr x 1} {
172 set name [$amx_ do amx_deviceLookup $x]
173 puts stdout "device $x is $name"
174 }
175
176 return $result
177 }
178
179 AmxTestApp instproc execTest5 {} {
180 $self instvar amx_
181
182 set result [$amx_ do callback_unregister getAmx]
183 return $result
184 }
185
186 AmxTestApp instproc execTest20 {} {
187 $self instvar amx_
188
189 set result [$amx_ do callback_register getAmx2]
190 return $result
191 }
192
193 AmxTestApp instproc execTest22 {} {
194 $self instvar amx_
195
196 set result [$amx_ do callback_disable getAmx2]
197 return $result
198 }
199
200 AmxTestApp instproc execTest23 {} {
201 $self instvar amx_
202
203 set result [$amx_ do callback_enable getAmx2]
204
205 return $result
206 }
207
208 AmxTestApp instproc execTest25 {} {
209 $self instvar amx_
210
211 set result [$amx_ do callback_unregister getAmx2]
212 return $result
213 }
214
215 proc gotIt {} {
216 puts stdout "I got the command!"
217 }
218
219 AmxTestApp instproc killServer {} {
220 $self instvar amx_
221
222 $amx_ doNoWait "amxd_killServer"
223 $self exitApp
224 }
225
226 AmxTestApp instproc exitApp {} {
227 $self instvar amx_
228
229 $amx_ closeRPC
230 exit
231 }
232
233 AmxTestApp public spoofAmx {} {
234 $self instvar amx_ cmd_ dev_ chan_ str_
235
236 $self get_values
237 set retval [$amx_ do spoofResponse $cmd_ $dev_ $chan_ $str_]
238 puts stdout "spoof returns: $retval"
239 }
240
241 AmxTestApp public sendAmx {} {
242 $self instvar amx_ dev_ chan_ cmd_ str_
243 $self get_values
244
245 switch -exact $cmd_ {
246 1 -
247 2 -
248 3 -
249 6 -
250 7 -
251 9 -
252 10 -
253 15 {
254 set retval [$amx_ do send-AMX-command $cmd_ $dev_ $chan_]
255 }
256 4 -
257 5 {
258 set retval [$amx_ do send-AMX-command $cmd_ $dev_ $str_]
259 }
260 8 -
261 11 {
262 set retval [$amx_ do send-AMX-command $cmd_ $dev_]
263 }
264 default {
265 # I just put this here for testing
266 catch {$amx_ do send-AMX-command $cmd_ $dev_ $chan_} retval
267 }
268 }
269 }
270
271 AmxTestApp private get_values {} {
272 $self instvar comText_ devText_ chanText_ strText_ cmd_ dev_ chan_ str_
273
274 set cmd_ 0
275 set dev_ 0
276 set chan_ 0
277 set str_ ""
278
279 set comStr [$comText_ get 1.0 1.end]
280 scan $comStr "%d" cmd_
281 set devStr [$devText_ get 1.0 1.end]
282 scan $devStr "%d" dev_
283 set chanStr [$chanText_ get 1.0 1.end]
284 scan $chanStr "%d" chan_
285 set str_ [$strText_ get 1.0 1.end]
286 # puts stdout "str_ is $str_, length of it is [string length $str_]"
287 set char [string index $str_ [expr [string length $str_] - 1]]
288 # puts stdout "the last char is $char, it's asciival is [charToInt $char]"
289 }
290
291 proc getAmx { retList } {
292 global g_app
293
294 # puts stdout "getamx got $retList"
295 puts stdout "getamx called:"
296
297 $g_app processAmx $retList
298 }
299
300 proc getAmx2 { retList } {
301 global g_app
302
303 # puts stdout "getamx2 got $retList"
304 puts stdout "getamx2 called:"
305
306 $g_app processAmx $retList
307 }
308
309 AmxTestApp public processAmx { retList } {
310 global g_app
311
312 if {[llength $retList] != 0} {
313 set eventInfo [lindex $retList 0]
314 set type [lindex $eventInfo 0]
315 set eventData [lindex $retList 1]
316 set cmd [lindex $eventData 0]
317 set dev [lindex $eventData 1]
318 set chan_str [lindex $eventData 2]
319 puts stdout "processAmx: received type=$type, cmd=$cmd, dev=$dev, chan_str=$chan_str"
320 } else {
321 puts stdout "processAmx: nothing received"
322 }
323 flush stdout
324 }
325
326
327 #
328 # driver engine
329 #
330
331 set g_app [new AmxTestApp $argv]
332
333 # next line is very important!!!
334 vwait forever
335
336
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.