--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gpf/BIN/xpanel.tcl	Mon Jun 01 03:24:05 2015 +0000
@@ -0,0 +1,772 @@
+#----------------------------------------------------------------------------- 
+#  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
+  }
+}
+#------------------------------------------
+