view gpf/BIN/xpanel.tcl @ 157:a7f7b52692e2

l1_trace.c: l1_trace_message(): low-hanging fruit
author Mychaela Falconia <falcon@freecalypso.org>
date Sun, 05 Jun 2016 18:06:28 +0000
parents 509db1a7b7b8
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
  }
}
#------------------------------------------