FreeCalypso > hg > leo2moko-debug

comparison gpf/BIN/xpanel.tcl @ 0:509db1a7b7b8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
initial import: leo2moko-r1
author Space Falcon <falcon@ivan.Harhan.ORG>
date Mon, 01 Jun 2015 03:24:05 +0000
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:509db1a7b7b8
1 #-----------------------------------------------------------------------------
2 # Project : XPAN
3 # Modul : xpanel.tcl
4 #-----------------------------------------------------------------------------
5 # Copyright 2002 Texas Instruments Berlin, AG
6 # All rights reserved.
7 #
8 # This file is confidential and a trade secret of Texas
9 # Instruments Berlin, AG
10 # The receipt of or possession of this file does not convey
11 # any rights to reproduce or disclose its contents or to
12 # manufacture, use, or sell anything it may describe, in
13 # whole, or in part, without the specific written consent of
14 # Texas Instruments Berlin, AG.
15 #-----------------------------------------------------------------------------
16 #| Purpose : This modul provides the framework of the xPanel frontend and
17 # its main entry point.
18 #-----------------------------------------------------------------------------
19
20
21 #*==== CONSTANTS ===================================================*#
22 set TEXT_DSPL_UPDATE 50
23 set GRAPH_DSPL_UPDATE 50
24
25 #*==== VARIABLES ===================================================*#
26 # initial screen image
27 set m_initscreen_img "initscreen.ppm"
28 set m_screen_img "screen.ppm"
29 set m_displ_type D
30 set m_displtext " "
31 set m_displwidth [expr 21*8]
32
33 #*==== EXPORTS =====================================================*#
34 # function for use in the c-backend:
35
36 # proc set_initparams {x y w h wtitle}
37 # .. send init-params which will be set by TCL (curr. initial size and window title)
38 # proc displ_update {}
39 # .. updates display
40 # proc load_prim {fname}
41 # .. load primitives form a given file named -fname-,
42 # if fname="" a file dialog will be provided
43 # proc set_comm_mode {mode}
44 # .. set communication mode varibale for dialog
45 # proc set_comport {port}
46 # .. sets comport varibale for dialog
47 #*==== IMPLEMENTATION ==============================================*#
48
49 #foreach i [winfo child .] {
50 # catch {destroy $i}
51 #}
52
53 #------------------------------------------
54 # create the frontend
55 #------------------------------------------
56
57 # ... the menu
58 menu .menubar
59 . config -menu .menubar
60 foreach m {File Config Display Cmd} {
61 set $m [menu .menubar.m$m]
62 .menubar add cascade -label $m -menu .menubar.m$m
63 }
64 $File add command -label "Load Layout ..." -command {load_layout ""}
65 $File add separator
66 $File add command -label Exit -command {destroy .}
67 $Config add checkbutton -variable m_setcomm \
68 -label "Configure test interface" -command {enable_setcomm $m_setcomm}
69 set m_comm_menu1 [$Config add command -label "Change communication mode ..." -command {dlg_comm_mode}]
70 set m_comm_menu2 [$Config add command -label "Reset test interface" -command {c_reset}]
71 $Display add radio -variable m_displ_type -value T \
72 -label Text -command {c_setdispl T}
73 $Display add radio -variable m_displ_type -value G \
74 -label Graphical -command {c_setdispl G}
75 $Display add radio -variable m_displ_type -value D \
76 -label "\[Disabled\]" -command {c_setdispl D}
77 $Display add separator
78 $Display add command -label "Zoom in" -command {c_zoom 1}
79 $Display add command -label "Zoom out" -command {c_zoom 0}
80 $Cmd add command -label "Input system primitive ..." -command input_prim
81 $Cmd add command -label "Load system primitives ..." -command {load_prim ""}
82 $Cmd add separator
83 $Cmd add command -label "Input AT command ..." -command input_at
84 $Cmd add command -label "Load AT commands ..." -command load_at
85
86 # ... the frame
87 frame .frame -relief flat
88 pack .frame -side top -fill y -anchor center
89
90 catch {file copy -force $m_initscreen_img $m_screen_img}
91 catch {file attributes $m_screen_img -readonly 0}
92
93 # set tcl_traceExec 3
94
95 #image create bitmap main_icon -file "xpan.bmp"
96 #wm iconbitmap . main_icon
97
98
99
100 #------------------------------------------
101 # define tcl functions
102 #------------------------------------------
103
104 ############################################################
105 # GUI RELATED FUNCTIONS
106 ############################################################
107
108
109 ############################################
110 # load_layout #
111 ############################################
112 # PURPOSE : called to load a new layout
113 #
114 # PARAM: lo_fname ... name of layout file
115 #
116 # RETURNS:
117 ############################################
118 proc load_layout {lo_fname} {
119 global m_initscreen_img
120 global m_displtext
121
122 if {$lo_fname == ""} {
123 set lo_fname [tk_getOpenFile -filetypes {{{"Layout-Files"} {*lo.tcl}}} \
124 -title "Please choose an Layout-File:"]
125 }
126
127 if {$lo_fname != ""} {
128 c_set_lofile $lo_fname
129
130 puts [format "loading layout from %s ..." $lo_fname]
131
132 # special layout
133 if {[winfo exists .keys]} {
134 foreach i [winfo child .keys] {
135 catch {destroy $i}
136 }
137 catch {destroy .keys}
138 }
139 source $lo_fname
140
141 # the "screen"
142 catch {image delete screen}
143 catch {destroy .frame.screen}
144 catch {image create photo screen -file $m_initscreen_img}
145 if { [catch {label .frame.screen -image screen -font systemfixed \
146 -background $DISPL_BG -foreground $DISPL_FG }] } {
147 label .frame.screen -text $m_displtext -font systemfixed \
148 -background $DISPL_BG -foreground $DISPL_FG
149 }
150 pack .frame.screen -side top -anchor w
151 }
152 }
153 #------------------------------------------
154
155
156 ############################################
157 # load_at #
158 ############################################
159 # PURPOSE : called to open a file containing
160 # AT-Command strings and execute
161 # them
162 #
163 # PARAMS:
164 #
165 # RETURNS:
166 ############################################
167 proc load_at {} {
168 set fname [tk_getOpenFile -filetypes {{{"At-Command-Files"} {.atc}}} \
169 -title "Please choose an AT-Command-File:"]
170
171 if {$fname != ""} {
172 set file [open $fname r]
173 while {![eof $file]} {
174 c_exec_at [gets $file] 0
175 }
176 close $file
177 }
178 }
179 #------------------------------------------
180
181
182 ############################################
183 # set_usart_config #
184 ############################################
185 # PURPOSE : called to set the usart
186 # configuration shown in the GUI
187 #
188 # PARAMS: port .. com port used
189 # baudrate ...
190 # flowctrl ... N,R,...
191 #
192 # RETURNS:
193 ############################################
194 proc set_usart_config {port baudrate flowctrl} {
195 global modeinput_dlg
196 set modeinput_dlg(port) $port
197 set modeinput_dlg(baudrate) $baudrate
198 set modeinput_dlg(flowctrl) $flowctrl
199 }
200 #------------------------------------------
201
202
203 ############################################
204 # set_hostname #
205 ############################################
206 # PURPOSE : called to set the hostname
207 # shown in the GUI
208 #
209 # PARAMS: hostname ... host string
210 #
211 # RETURNS:
212 ############################################
213 proc set_host {hostname} {
214 global modeinput_dlg
215 set modeinput_dlg(host) $hostname
216 }
217 #------------------------------------------
218
219
220 ############################################
221 # enable_setcomm #
222 ############################################
223 # PURPOSE : called to enable/disable setting
224 # of tst communication
225 #
226 # PARAMS: enable ... 0 or 1
227 #
228 # RETURNS:
229 ############################################
230 proc enable_setcomm {enable} {
231 global m_setcomm
232
233 set m_setcomm $enable
234
235 c_enable_setcom $enable
236 if {$enable == 1} {
237 .menubar.mConfig entryconfigure 2 -state normal
238 .menubar.mConfig entryconfigure 3 -state normal
239 c_reset
240 } else {
241 .menubar.mConfig entryconfigure 2 -state disabled
242 .menubar.mConfig entryconfigure 3 -state disabled
243 }
244 }
245 #------------------------------------------
246
247
248
249 ############################################
250 # set_comm_mode #
251 ############################################
252 # PURPOSE : called to set the communication
253 # mode shown in the GUI
254 #
255 # PARAMS: mode ... SOCKET, REAL, SIM
256 #
257 # RETURNS:
258 ############################################
259 proc set_comm_mode {mode} {
260 global modeinput_dlg
261 set modeinput_dlg(mode) $mode
262 }
263 #------------------------------------------
264
265
266 ############################################
267 # dlg_comm_mode #
268 ############################################
269 # PURPOSE : called to show a dialog
270 # for communication settings
271 #
272 # PARAMS:
273 #
274 # RETURNS:
275 ############################################
276 proc dlg_comm_mode {} {
277 global modeinput_dlg
278 set f .modeinput_dlg
279 if [Dialog_Create $f "Communication mode choice" -borderwidth 10] {
280 message $f.msg -text "Please select the mode to use:" -aspect 1000
281 set m [frame $f.modes]
282 radiobutton $m.radioSOCKET -text "Sockets " -variable modeinput_dlg(mode) \
283 -value SOCKET
284 radiobutton $m.radioREAL -text "USART (COM-port) " -variable modeinput_dlg(mode) \
285 -value REAL
286 radiobutton $m.radioSIM -text "USART (simulation)" -variable modeinput_dlg(mode) \
287 -value SIM
288 pack $m.radioSOCKET $m.radioREAL $m.radioSIM -side left -anchor n
289 set b [frame $f.buttons -borderwidth 5]
290 set s [frame $f.settings -relief sunken]
291 set x [frame $f.xtras]
292 checkbutton $x.check_pcon -text "Use PCON" -variable modeinput_dlg(pcon)
293 checkbutton $x.old_tstheader -text "Use old TST-Header" -variable modeinput_dlg(oldtst)
294 pack $x.check_pcon $x.old_tstheader -side left -anchor n
295
296 pack $f.msg -side top
297 pack $f.modes -side top
298 pack $f.settings -side top
299 pack $f.xtras -side top
300 pack $f.buttons -side bottom -anchor w
301
302 button $b.ok -text Ok -command {set modeinput_dlg(ok) 1} -default active
303 button $b.cancel -text Cancel \
304 -command {set modeinput_dlg(ok) 0}
305 pack $b.ok -side left
306 pack $b.cancel -side right
307
308 foreach i [winfo child $f] {
309 foreach j [winfo child $i] {
310 bind $j <Return> {set modeinput_dlg(ok) 1}
311 bind $j <Escape> {set modeinput_dlg(ok) 0}
312 }
313 bind $i <Return> {set modeinput_dlg(ok) 1}
314 bind $i <Escape> {set modeinput_dlg(ok) 0}
315 }
316 bind $f <Return> {set modeinput_dlg(ok) 1}
317 bind $f <Escape> {set modeinput_dlg(ok) 0}
318 }
319 # save old settings
320 set mode $modeinput_dlg(mode)
321 catch {set hostname $modeinput_dlg(host)}
322 catch {
323 set port $modeinput_dlg(port)
324 set baudrate $modeinput_dlg(baudrate)
325 set flowctrl $modeinput_dlg(flowctrl)
326 }
327
328 set s $f.settings
329 set modeinput_dlg(ok) -1
330
331 focus $f
332 catch {tkwait visibility $top}
333 catch {grab $f}
334 set oldmode {}
335 while {$modeinput_dlg(ok)==-1 && [winfo exists $f]} {
336 after 10
337 update
338
339 if {$modeinput_dlg(mode) != $oldmode} {
340 foreach i [winfo child $s] {
341 catch {destroy $i}
342 }
343
344 switch $modeinput_dlg(mode) {
345 SOCKET {
346 message $s.msg -text "Hostname:" -aspect 1000
347 entry $s.host -width 30 -textvariable modeinput_dlg(host)
348 pack $s.msg $s.host -side left -anchor w
349 message $s.msg2 -text "Port:" -aspect 1000
350 entry $s.socket_port -width 5 -textvariable modeinput_dlg(socket_port)
351 pack $s.msg2 $s.socket_port -side left -anchor w
352 }
353 REAL {
354 message $s.msg -text "COM-Port:" -aspect 1000
355 entry $s.comport -width 2 -textvariable modeinput_dlg(port)
356 pack $s.msg $s.comport -side left -anchor w
357 message $s.msg2 -text "Baudrate:" -aspect 1000
358 entry $s.baudrate -width 8 -textvariable modeinput_dlg(baudrate)
359 pack $s.msg2 $s.baudrate -side left -anchor w
360 message $s.msg3 -text "Flowcontrol:" -aspect 1000
361 entry $s.flowctrl -width 2 -textvariable modeinput_dlg(flowctrl)
362 pack $s.msg3 $s.flowctrl -side left -anchor w
363 }
364 SIM {
365 checkbutton $s.checkSTX -text "STX" -variable modeinput_dlg(stx)
366 pack $s.checkSTX -side left -anchor w
367 }
368 }
369 foreach j [winfo child $s] {
370 bind $j <Return> {set modeinput_dlg(ok) 1}
371 bind $j <Escape> {set modeinput_dlg(ok) 0}
372 }
373 set oldmode $modeinput_dlg(mode)
374 }
375 }
376 if {![winfo exists $f]} {
377 set modeinput_dlg(ok) 0
378 }
379 catch {grab release $f}
380
381 Dialog_Dismiss $f
382 if {$modeinput_dlg(ok)==0} {
383 # restore old settings
384 set modeinput_dlg(mode) $mode
385 catch {set modeinput_dlg(host) $hostname}
386 catch {
387 set modeinput_dlg(port) $port
388 set modeinput_dlg(baudrate) $baudrate
389 set modeinput_dlg(flowctrl) $flowctrl
390 }
391 return
392 }
393 c_set_comm_mode $modeinput_dlg(mode) $modeinput_dlg(stx)
394 switch $modeinput_dlg(mode) {
395 SOCKET { c_config_socket $modeinput_dlg(host) $modeinput_dlg(socket_port) }
396 REAL { c_config_usart $modeinput_dlg(port) $modeinput_dlg(baudrate) $modeinput_dlg(flowctrl) }
397 SIM { c_config_usart $modeinput_dlg(port) $modeinput_dlg(baudrate) $modeinput_dlg(flowctrl) }
398 }
399 c_setpcon $modeinput_dlg(pcon)
400 c_setoldtst $modeinput_dlg(oldtst)
401 }
402 #------------------------------------------
403
404
405 ############################################
406 # input_at #
407 ############################################
408 # PURPOSE : called to show a dialog
409 # for input of at-command strings
410 #
411 # PARAMS:
412 #
413 # RETURNS:
414 ############################################
415 proc input_at {} {
416 global atinput_dlg
417 set f .atinput_dlg
418 if [Dialog_Create $f "AT commands" -borderwidth 10] {
419 message $f.msg -text "Please input an AT command:" -aspect 1000
420 entry $f.entry -textvariable atinput_dlg(result)
421 set b [frame $f.buttons]
422 pack $f.msg $f.entry $f.buttons -side top -fill x
423 pack $f.entry -pady 5
424
425 checkbutton $f.check_raw -text "Use raw mode" -variable atinput_dlg(raw)
426 pack $f.check_raw -side left -anchor w
427
428 button $b.ok -text SEND -command {set atinput_dlg(ok) 1}
429 button $b.cancel -text Cancel \
430 -command {set atinput_dlg(ok) 0}
431 pack $b.ok -side left
432 pack $b.cancel -side right
433 bind $f.entry <Return> {set atinput_dlg(ok) 1 ; break}
434 bind $f.entry <Escape> {set atinput_dlg(ok) 0 ; break}
435 }
436 set atinput_dlg(ok) 0
437 Dialog_Wait $f atinput_dlg(ok) $f.entry
438 Dialog_Dismiss $f
439 if {$atinput_dlg(ok)} {
440 c_exec_at $atinput_dlg(result) $atinput_dlg(raw)
441 }
442 }
443 #------------------------------------------
444
445
446 ############################################
447 # load_prim #
448 ############################################
449 # PURPOSE : called to open a file containing
450 # ATsystem primitives and execute
451 # them
452 #
453 # PARAMS: fname .. name of primitive file,
454 # if empty -> dialog will
455 # be shown
456 #
457 # RETURNS:
458 ############################################
459 proc load_prim {fname} {
460 if {$fname == ""} {
461 set fname [tk_getOpenFile -filetypes {{{"Primitive-Files"} {.pri}}} \
462 -title "Please choose an Primitive-File:"]
463 }
464
465 if {$fname != ""} {
466 set file [open $fname r]
467 if {![eof $file]} {
468 puts [format "executing primitives from %s ..." $fname]
469 }
470 while {![eof $file]} {
471 set receiver [gets $file]
472 set slist [split $receiver]
473 puts $slist
474 puts [lindex $slist 0]
475 if {[lindex $slist 0]=="sleep"} {
476 after [lindex $slist 1]
477 } else {
478 c_send_prim $receiver [gets $file]
479 }
480 }
481 close $file
482 }
483 }
484 #------------------------------------------
485
486
487 ############################################
488 # input_prim #
489 ############################################
490 # PURPOSE : called to show a dialog
491 # for input of system primitives
492 #
493 # PARAMS:
494 #
495 # RETURNS:
496 ############################################
497 proc input_prim {} {
498 global priminput_dlg
499 set f .priminput_dlg
500 if [Dialog_Create $f "Primitives" -borderwidth 10] {
501 message $f.msg -text "Please input a receiver:" -aspect 1000
502 entry $f.entry -width 5 -textvariable priminput_dlg(receiver)
503 $f.entry insert 0 MMI
504 message $f.msg2 -text "Please input a primitive:" -aspect 1000
505 entry $f.entry2 -width 0 -textvariable priminput_dlg(prim)
506 $f.entry2 insert 0 "TRACECLASS FF"
507 set b [frame $f.buttons]
508 pack $f.msg $f.entry -side top
509 pack $f.msg2 $f.entry2 $f.buttons -side top -fill x
510 pack $f.entry -pady 5
511 pack $f.entry2 -pady 7
512 button $b.ok -text SEND -command {set priminput_dlg(ok) 1}
513 button $b.cancel -text Cancel \
514 -command {set priminput_dlg(ok) 0}
515 pack $b.ok -side left
516 pack $b.cancel -side right
517 bind $f.entry <Return> {set priminput_dlg(ok) 1 ; break}
518 bind $f.entry <Escape> {set priminput_dlg(ok) 0 ; break}
519 }
520 set priminput_dlg(ok) 0
521 Dialog_Wait $f priminput_dlg(ok) $f.entry
522 Dialog_Dismiss $f
523 if {$priminput_dlg(ok)} {
524 c_send_prim $priminput_dlg(receiver) $priminput_dlg(prim)
525 }
526 }
527 #------------------------------------------
528
529
530 ############################################
531 # set_windim #
532 ############################################
533 # PURPOSE : set dimension of GUI-Window
534 #
535 # PARAMS:
536 #
537 # RETURNS:
538 ############################################
539 proc set_windim {x y w h} {
540 wm geometry . [format "%ix%i+%i+%i" $w $h $x $y]
541 #wm geometry . [format "+%i+%i" $x $y]
542 }
543 #------------------------------------------
544
545 ############################################
546 # set_initparams #
547 ############################################
548 # PURPOSE : called from c-backend to
549 # send init-params which will be set by TCL
550 # (curr. initial size and window title)
551 #
552 # PARAMS:
553 #
554 # RETURNS:
555 ############################################
556 proc set_initparams {x y w h wtitle} {
557 after 500 set_windim $x $y $w $h
558 after 500 wm title . $wtitle
559 after 500 wm deiconify .
560 }
561 #------------------------------------------
562
563 ############################################
564 # send_windim #
565 ############################################
566 # PURPOSE : called to send
567 # dimension of GUI-Window to
568 # c-backend
569 #
570 # PARAMS:
571 #
572 # RETURNS:
573 ############################################
574 proc send_windim {} {
575 set geo [wm geometry .]
576 c_windim $geo
577 }
578 bind .menubar.mFile <Destroy> {send_windim}
579 #------------------------------------------
580
581
582
583
584
585 ############################################################
586 # DISPLAY RELATED FUNCTIONS
587 ############################################################
588
589
590 ############################################
591 # displ_text #
592 ############################################
593 # PURPOSE : asks c-backend for current
594 # content of text display and
595 # shows it
596 #
597 # PARAMS:
598 #
599 # RETURNS:
600 ############################################
601 proc displ_text {} {
602 global m_displ_type
603 global m_displtext
604 global m_displwidth
605
606 set m_displtext [c_get_displtext]
607 catch [.frame.screen configure -image "" -text $m_displtext]
608 }
609 #------------------------------------------
610
611
612 ############################################
613 # displ_img #
614 ############################################
615 # PURPOSE : asks c-backend for current
616 # display image to be used and
617 # shows it
618 #
619 # PARAMS:
620 #
621 # RETURNS:
622 ############################################
623 proc displ_img {} {
624 catch [.frame.screen configure -image screen]
625 }
626 #------------------------------------------
627
628
629 ############################################
630 # displ_update #
631 ############################################
632 # PURPOSE : periodically called to update
633 # the display screen depending
634 # on set display mode (m_displ_type)
635 #
636 # PARAMS:
637 #
638 # RETURNS:
639 ############################################
640 proc displ_update {} {
641 global m_displ_type
642 global m_displtext
643 global m_displwidth
644 global GRAPH_DSPL_UPDATE
645 global TEXT_DSPL_UPDATE
646
647 switch $m_displ_type {
648 "T" {
649 displ_text
650 after $TEXT_DSPL_UPDATE displ_update
651 }
652 "D" {
653 displ_text
654 # after $TEXT_DSPL_UPDATE displ_update
655 }
656 "G" {
657 displ_img
658 after $GRAPH_DSPL_UPDATE displ_update
659 }
660 }
661 }
662 #------------------------------------------
663
664
665
666
667
668
669 ############################################################
670 # INTERNAL FUNCTIONS
671 ############################################################
672
673
674 ############################################
675 # Dialog_Create #
676 ############################################
677 # PURPOSE : internal function for
678 # creating a dialog window
679 #
680 # PARAMS: top ... variable for dialog window
681 # title ... dialog title
682 # args ... argument to dialog
683 #
684 # RETURNS:
685 ############################################
686 proc Dialog_Create {top title args} {
687 global dialog
688 if [winfo exists $top] {
689 switch -- [wm state $top] {
690 normal {
691 # Raise a buried window
692 raise $top
693 }
694 withdrawn -
695 iconified {
696 # Open and restore geometry
697 wm deiconify $top
698 catch {wm geometry $top $dialog(geo,$top)}
699 }
700 }
701 return 0
702 } else {
703 eval {toplevel $top} $args
704 wm title $top $title
705 set g [wm geometry .]
706 set pos [string first + $g]
707 set g2 [string range $g $pos [string length $g]]
708
709 catch {wm geometry $top $g2}
710 return 1
711 }
712 }
713 #------------------------------------------
714
715
716 ############################################
717 # Dialog_Wait #
718 ############################################
719 # PURPOSE : internal function for
720 # waiting for state of a varibale
721 # of a modal dialog
722 #
723 # PARAMS: top ... variable of dialog window
724 # varName ... variable to be checked
725 # focus ... sub window to get focus
726 #
727 # RETURNS:
728 ############################################
729 proc Dialog_Wait {top varName {focus {}}} {
730 upvar $varName var
731
732 # Poke the variable if the user nukes the window
733 bind $top <Destroy> [list set $varName $var]
734
735 # Grab focus for the dialog
736 if {[string length $focus] == 0} {
737 set focus $top
738 }
739 set old [focus -displayof $top]
740 focus $focus
741 catch {tkwait visibility $top}
742 catch {grab $top}
743
744 # Wait for the dialog to complete
745 tkwait variable $varName
746 catch {grab release $top}
747 focus $old
748 }
749 #------------------------------------------
750
751
752 ############################################
753 # Dialog_Dismiss #
754 ############################################
755 # PURPOSE : internal function for
756 # closing a dialog window
757 #
758 # PARAMS: top ... variable of dialog window
759 #
760 # RETURNS:
761 ############################################
762 proc Dialog_Dismiss {top} {
763 global dialog
764 # Save current size and position
765 catch {
766 # window may have been deleted
767 set dialog(geo,$top) [wm geometry $top]
768 wm withdraw $top
769 }
770 }
771 #------------------------------------------
772