FreeCalypso > hg > tcs211-l1-reconst
view gpf/BIN/xpanel.tcl @ 0:509db1a7b7b8
initial import: leo2moko-r1
author | Space Falcon <falcon@ivan.Harhan.ORG> |
---|---|
date | Mon, 01 Jun 2015 03:24:05 +0000 |
parents | |
children |
line wrap: on
line source
#----------------------------------------------------------------------------- # Project : XPAN # Modul : xpanel.tcl #----------------------------------------------------------------------------- # Copyright 2002 Texas Instruments Berlin, AG # All rights reserved. # # This file is confidential and a trade secret of Texas # Instruments Berlin, AG # The receipt of or possession of this file does not convey # any rights to reproduce or disclose its contents or to # manufacture, use, or sell anything it may describe, in # whole, or in part, without the specific written consent of # Texas Instruments Berlin, AG. #----------------------------------------------------------------------------- #| Purpose : This modul provides the framework of the xPanel frontend and # its main entry point. #----------------------------------------------------------------------------- #*==== CONSTANTS ===================================================*# set TEXT_DSPL_UPDATE 50 set GRAPH_DSPL_UPDATE 50 #*==== VARIABLES ===================================================*# # initial screen image set m_initscreen_img "initscreen.ppm" set m_screen_img "screen.ppm" set m_displ_type D set m_displtext " " set m_displwidth [expr 21*8] #*==== EXPORTS =====================================================*# # function for use in the c-backend: # proc set_initparams {x y w h wtitle} # .. send init-params which will be set by TCL (curr. initial size and window title) # proc displ_update {} # .. updates display # proc load_prim {fname} # .. load primitives form a given file named -fname-, # if fname="" a file dialog will be provided # proc set_comm_mode {mode} # .. set communication mode varibale for dialog # proc set_comport {port} # .. sets comport varibale for dialog #*==== IMPLEMENTATION ==============================================*# #foreach i [winfo child .] { # catch {destroy $i} #} #------------------------------------------ # create the frontend #------------------------------------------ # ... the menu menu .menubar . config -menu .menubar foreach m {File Config Display Cmd} { set $m [menu .menubar.m$m] .menubar add cascade -label $m -menu .menubar.m$m } $File add command -label "Load Layout ..." -command {load_layout ""} $File add separator $File add command -label Exit -command {destroy .} $Config add checkbutton -variable m_setcomm \ -label "Configure test interface" -command {enable_setcomm $m_setcomm} set m_comm_menu1 [$Config add command -label "Change communication mode ..." -command {dlg_comm_mode}] set m_comm_menu2 [$Config add command -label "Reset test interface" -command {c_reset}] $Display add radio -variable m_displ_type -value T \ -label Text -command {c_setdispl T} $Display add radio -variable m_displ_type -value G \ -label Graphical -command {c_setdispl G} $Display add radio -variable m_displ_type -value D \ -label "\[Disabled\]" -command {c_setdispl D} $Display add separator $Display add command -label "Zoom in" -command {c_zoom 1} $Display add command -label "Zoom out" -command {c_zoom 0} $Cmd add command -label "Input system primitive ..." -command input_prim $Cmd add command -label "Load system primitives ..." -command {load_prim ""} $Cmd add separator $Cmd add command -label "Input AT command ..." -command input_at $Cmd add command -label "Load AT commands ..." -command load_at # ... the frame frame .frame -relief flat pack .frame -side top -fill y -anchor center catch {file copy -force $m_initscreen_img $m_screen_img} catch {file attributes $m_screen_img -readonly 0} # set tcl_traceExec 3 #image create bitmap main_icon -file "xpan.bmp" #wm iconbitmap . main_icon #------------------------------------------ # define tcl functions #------------------------------------------ ############################################################ # GUI RELATED FUNCTIONS ############################################################ ############################################ # load_layout # ############################################ # PURPOSE : called to load a new layout # # PARAM: lo_fname ... name of layout file # # RETURNS: ############################################ proc load_layout {lo_fname} { global m_initscreen_img global m_displtext if {$lo_fname == ""} { set lo_fname [tk_getOpenFile -filetypes {{{"Layout-Files"} {*lo.tcl}}} \ -title "Please choose an Layout-File:"] } if {$lo_fname != ""} { c_set_lofile $lo_fname puts [format "loading layout from %s ..." $lo_fname] # special layout if {[winfo exists .keys]} { foreach i [winfo child .keys] { catch {destroy $i} } catch {destroy .keys} } source $lo_fname # the "screen" catch {image delete screen} catch {destroy .frame.screen} catch {image create photo screen -file $m_initscreen_img} if { [catch {label .frame.screen -image screen -font systemfixed \ -background $DISPL_BG -foreground $DISPL_FG }] } { label .frame.screen -text $m_displtext -font systemfixed \ -background $DISPL_BG -foreground $DISPL_FG } pack .frame.screen -side top -anchor w } } #------------------------------------------ ############################################ # load_at # ############################################ # PURPOSE : called to open a file containing # AT-Command strings and execute # them # # PARAMS: # # RETURNS: ############################################ proc load_at {} { set fname [tk_getOpenFile -filetypes {{{"At-Command-Files"} {.atc}}} \ -title "Please choose an AT-Command-File:"] if {$fname != ""} { set file [open $fname r] while {![eof $file]} { c_exec_at [gets $file] 0 } close $file } } #------------------------------------------ ############################################ # set_usart_config # ############################################ # PURPOSE : called to set the usart # configuration shown in the GUI # # PARAMS: port .. com port used # baudrate ... # flowctrl ... N,R,... # # RETURNS: ############################################ proc set_usart_config {port baudrate flowctrl} { global modeinput_dlg set modeinput_dlg(port) $port set modeinput_dlg(baudrate) $baudrate set modeinput_dlg(flowctrl) $flowctrl } #------------------------------------------ ############################################ # set_hostname # ############################################ # PURPOSE : called to set the hostname # shown in the GUI # # PARAMS: hostname ... host string # # RETURNS: ############################################ proc set_host {hostname} { global modeinput_dlg set modeinput_dlg(host) $hostname } #------------------------------------------ ############################################ # enable_setcomm # ############################################ # PURPOSE : called to enable/disable setting # of tst communication # # PARAMS: enable ... 0 or 1 # # RETURNS: ############################################ proc enable_setcomm {enable} { global m_setcomm set m_setcomm $enable c_enable_setcom $enable if {$enable == 1} { .menubar.mConfig entryconfigure 2 -state normal .menubar.mConfig entryconfigure 3 -state normal c_reset } else { .menubar.mConfig entryconfigure 2 -state disabled .menubar.mConfig entryconfigure 3 -state disabled } } #------------------------------------------ ############################################ # set_comm_mode # ############################################ # PURPOSE : called to set the communication # mode shown in the GUI # # PARAMS: mode ... SOCKET, REAL, SIM # # RETURNS: ############################################ proc set_comm_mode {mode} { global modeinput_dlg set modeinput_dlg(mode) $mode } #------------------------------------------ ############################################ # dlg_comm_mode # ############################################ # PURPOSE : called to show a dialog # for communication settings # # PARAMS: # # RETURNS: ############################################ proc dlg_comm_mode {} { global modeinput_dlg set f .modeinput_dlg if [Dialog_Create $f "Communication mode choice" -borderwidth 10] { message $f.msg -text "Please select the mode to use:" -aspect 1000 set m [frame $f.modes] radiobutton $m.radioSOCKET -text "Sockets " -variable modeinput_dlg(mode) \ -value SOCKET radiobutton $m.radioREAL -text "USART (COM-port) " -variable modeinput_dlg(mode) \ -value REAL radiobutton $m.radioSIM -text "USART (simulation)" -variable modeinput_dlg(mode) \ -value SIM pack $m.radioSOCKET $m.radioREAL $m.radioSIM -side left -anchor n set b [frame $f.buttons -borderwidth 5] set s [frame $f.settings -relief sunken] set x [frame $f.xtras] checkbutton $x.check_pcon -text "Use PCON" -variable modeinput_dlg(pcon) checkbutton $x.old_tstheader -text "Use old TST-Header" -variable modeinput_dlg(oldtst) pack $x.check_pcon $x.old_tstheader -side left -anchor n pack $f.msg -side top pack $f.modes -side top pack $f.settings -side top pack $f.xtras -side top pack $f.buttons -side bottom -anchor w button $b.ok -text Ok -command {set modeinput_dlg(ok) 1} -default active button $b.cancel -text Cancel \ -command {set modeinput_dlg(ok) 0} pack $b.ok -side left pack $b.cancel -side right foreach i [winfo child $f] { foreach j [winfo child $i] { bind $j <Return> {set modeinput_dlg(ok) 1} bind $j <Escape> {set modeinput_dlg(ok) 0} } bind $i <Return> {set modeinput_dlg(ok) 1} bind $i <Escape> {set modeinput_dlg(ok) 0} } bind $f <Return> {set modeinput_dlg(ok) 1} bind $f <Escape> {set modeinput_dlg(ok) 0} } # save old settings set mode $modeinput_dlg(mode) catch {set hostname $modeinput_dlg(host)} catch { set port $modeinput_dlg(port) set baudrate $modeinput_dlg(baudrate) set flowctrl $modeinput_dlg(flowctrl) } set s $f.settings set modeinput_dlg(ok) -1 focus $f catch {tkwait visibility $top} catch {grab $f} set oldmode {} while {$modeinput_dlg(ok)==-1 && [winfo exists $f]} { after 10 update if {$modeinput_dlg(mode) != $oldmode} { foreach i [winfo child $s] { catch {destroy $i} } switch $modeinput_dlg(mode) { SOCKET { message $s.msg -text "Hostname:" -aspect 1000 entry $s.host -width 30 -textvariable modeinput_dlg(host) pack $s.msg $s.host -side left -anchor w message $s.msg2 -text "Port:" -aspect 1000 entry $s.socket_port -width 5 -textvariable modeinput_dlg(socket_port) pack $s.msg2 $s.socket_port -side left -anchor w } REAL { message $s.msg -text "COM-Port:" -aspect 1000 entry $s.comport -width 2 -textvariable modeinput_dlg(port) pack $s.msg $s.comport -side left -anchor w message $s.msg2 -text "Baudrate:" -aspect 1000 entry $s.baudrate -width 8 -textvariable modeinput_dlg(baudrate) pack $s.msg2 $s.baudrate -side left -anchor w message $s.msg3 -text "Flowcontrol:" -aspect 1000 entry $s.flowctrl -width 2 -textvariable modeinput_dlg(flowctrl) pack $s.msg3 $s.flowctrl -side left -anchor w } SIM { checkbutton $s.checkSTX -text "STX" -variable modeinput_dlg(stx) pack $s.checkSTX -side left -anchor w } } foreach j [winfo child $s] { bind $j <Return> {set modeinput_dlg(ok) 1} bind $j <Escape> {set modeinput_dlg(ok) 0} } set oldmode $modeinput_dlg(mode) } } if {![winfo exists $f]} { set modeinput_dlg(ok) 0 } catch {grab release $f} Dialog_Dismiss $f if {$modeinput_dlg(ok)==0} { # restore old settings set modeinput_dlg(mode) $mode catch {set modeinput_dlg(host) $hostname} catch { set modeinput_dlg(port) $port set modeinput_dlg(baudrate) $baudrate set modeinput_dlg(flowctrl) $flowctrl } return } c_set_comm_mode $modeinput_dlg(mode) $modeinput_dlg(stx) switch $modeinput_dlg(mode) { SOCKET { c_config_socket $modeinput_dlg(host) $modeinput_dlg(socket_port) } REAL { c_config_usart $modeinput_dlg(port) $modeinput_dlg(baudrate) $modeinput_dlg(flowctrl) } SIM { c_config_usart $modeinput_dlg(port) $modeinput_dlg(baudrate) $modeinput_dlg(flowctrl) } } c_setpcon $modeinput_dlg(pcon) c_setoldtst $modeinput_dlg(oldtst) } #------------------------------------------ ############################################ # input_at # ############################################ # PURPOSE : called to show a dialog # for input of at-command strings # # PARAMS: # # RETURNS: ############################################ proc input_at {} { global atinput_dlg set f .atinput_dlg if [Dialog_Create $f "AT commands" -borderwidth 10] { message $f.msg -text "Please input an AT command:" -aspect 1000 entry $f.entry -textvariable atinput_dlg(result) set b [frame $f.buttons] pack $f.msg $f.entry $f.buttons -side top -fill x pack $f.entry -pady 5 checkbutton $f.check_raw -text "Use raw mode" -variable atinput_dlg(raw) pack $f.check_raw -side left -anchor w button $b.ok -text SEND -command {set atinput_dlg(ok) 1} button $b.cancel -text Cancel \ -command {set atinput_dlg(ok) 0} pack $b.ok -side left pack $b.cancel -side right bind $f.entry <Return> {set atinput_dlg(ok) 1 ; break} bind $f.entry <Escape> {set atinput_dlg(ok) 0 ; break} } set atinput_dlg(ok) 0 Dialog_Wait $f atinput_dlg(ok) $f.entry Dialog_Dismiss $f if {$atinput_dlg(ok)} { c_exec_at $atinput_dlg(result) $atinput_dlg(raw) } } #------------------------------------------ ############################################ # load_prim # ############################################ # PURPOSE : called to open a file containing # ATsystem primitives and execute # them # # PARAMS: fname .. name of primitive file, # if empty -> dialog will # be shown # # RETURNS: ############################################ proc load_prim {fname} { if {$fname == ""} { set fname [tk_getOpenFile -filetypes {{{"Primitive-Files"} {.pri}}} \ -title "Please choose an Primitive-File:"] } if {$fname != ""} { set file [open $fname r] if {![eof $file]} { puts [format "executing primitives from %s ..." $fname] } while {![eof $file]} { set receiver [gets $file] set slist [split $receiver] puts $slist puts [lindex $slist 0] if {[lindex $slist 0]=="sleep"} { after [lindex $slist 1] } else { c_send_prim $receiver [gets $file] } } close $file } } #------------------------------------------ ############################################ # input_prim # ############################################ # PURPOSE : called to show a dialog # for input of system primitives # # PARAMS: # # RETURNS: ############################################ proc input_prim {} { global priminput_dlg set f .priminput_dlg if [Dialog_Create $f "Primitives" -borderwidth 10] { message $f.msg -text "Please input a receiver:" -aspect 1000 entry $f.entry -width 5 -textvariable priminput_dlg(receiver) $f.entry insert 0 MMI message $f.msg2 -text "Please input a primitive:" -aspect 1000 entry $f.entry2 -width 0 -textvariable priminput_dlg(prim) $f.entry2 insert 0 "TRACECLASS FF" set b [frame $f.buttons] pack $f.msg $f.entry -side top pack $f.msg2 $f.entry2 $f.buttons -side top -fill x pack $f.entry -pady 5 pack $f.entry2 -pady 7 button $b.ok -text SEND -command {set priminput_dlg(ok) 1} button $b.cancel -text Cancel \ -command {set priminput_dlg(ok) 0} pack $b.ok -side left pack $b.cancel -side right bind $f.entry <Return> {set priminput_dlg(ok) 1 ; break} bind $f.entry <Escape> {set priminput_dlg(ok) 0 ; break} } set priminput_dlg(ok) 0 Dialog_Wait $f priminput_dlg(ok) $f.entry Dialog_Dismiss $f if {$priminput_dlg(ok)} { c_send_prim $priminput_dlg(receiver) $priminput_dlg(prim) } } #------------------------------------------ ############################################ # set_windim # ############################################ # PURPOSE : set dimension of GUI-Window # # PARAMS: # # RETURNS: ############################################ proc set_windim {x y w h} { wm geometry . [format "%ix%i+%i+%i" $w $h $x $y] #wm geometry . [format "+%i+%i" $x $y] } #------------------------------------------ ############################################ # set_initparams # ############################################ # PURPOSE : called from c-backend to # send init-params which will be set by TCL # (curr. initial size and window title) # # PARAMS: # # RETURNS: ############################################ proc set_initparams {x y w h wtitle} { after 500 set_windim $x $y $w $h after 500 wm title . $wtitle after 500 wm deiconify . } #------------------------------------------ ############################################ # send_windim # ############################################ # PURPOSE : called to send # dimension of GUI-Window to # c-backend # # PARAMS: # # RETURNS: ############################################ proc send_windim {} { set geo [wm geometry .] c_windim $geo } bind .menubar.mFile <Destroy> {send_windim} #------------------------------------------ ############################################################ # DISPLAY RELATED FUNCTIONS ############################################################ ############################################ # displ_text # ############################################ # PURPOSE : asks c-backend for current # content of text display and # shows it # # PARAMS: # # RETURNS: ############################################ proc displ_text {} { global m_displ_type global m_displtext global m_displwidth set m_displtext [c_get_displtext] catch [.frame.screen configure -image "" -text $m_displtext] } #------------------------------------------ ############################################ # displ_img # ############################################ # PURPOSE : asks c-backend for current # display image to be used and # shows it # # PARAMS: # # RETURNS: ############################################ proc displ_img {} { catch [.frame.screen configure -image screen] } #------------------------------------------ ############################################ # displ_update # ############################################ # PURPOSE : periodically called to update # the display screen depending # on set display mode (m_displ_type) # # PARAMS: # # RETURNS: ############################################ proc displ_update {} { global m_displ_type global m_displtext global m_displwidth global GRAPH_DSPL_UPDATE global TEXT_DSPL_UPDATE switch $m_displ_type { "T" { displ_text after $TEXT_DSPL_UPDATE displ_update } "D" { displ_text # after $TEXT_DSPL_UPDATE displ_update } "G" { displ_img after $GRAPH_DSPL_UPDATE displ_update } } } #------------------------------------------ ############################################################ # INTERNAL FUNCTIONS ############################################################ ############################################ # Dialog_Create # ############################################ # PURPOSE : internal function for # creating a dialog window # # PARAMS: top ... variable for dialog window # title ... dialog title # args ... argument to dialog # # RETURNS: ############################################ proc Dialog_Create {top title args} { global dialog if [winfo exists $top] { switch -- [wm state $top] { normal { # Raise a buried window raise $top } withdrawn - iconified { # Open and restore geometry wm deiconify $top catch {wm geometry $top $dialog(geo,$top)} } } return 0 } else { eval {toplevel $top} $args wm title $top $title set g [wm geometry .] set pos [string first + $g] set g2 [string range $g $pos [string length $g]] catch {wm geometry $top $g2} return 1 } } #------------------------------------------ ############################################ # Dialog_Wait # ############################################ # PURPOSE : internal function for # waiting for state of a varibale # of a modal dialog # # PARAMS: top ... variable of dialog window # varName ... variable to be checked # focus ... sub window to get focus # # RETURNS: ############################################ proc Dialog_Wait {top varName {focus {}}} { upvar $varName var # Poke the variable if the user nukes the window bind $top <Destroy> [list set $varName $var] # Grab focus for the dialog if {[string length $focus] == 0} { set focus $top } set old [focus -displayof $top] focus $focus catch {tkwait visibility $top} catch {grab $top} # Wait for the dialog to complete tkwait variable $varName catch {grab release $top} focus $old } #------------------------------------------ ############################################ # Dialog_Dismiss # ############################################ # PURPOSE : internal function for # closing a dialog window # # PARAMS: top ... variable of dialog window # # RETURNS: ############################################ proc Dialog_Dismiss {top} { global dialog # Save current size and position catch { # window may have been deleted set dialog(geo,$top) [wm geometry $top] wm withdraw $top } } #------------------------------------------