CanReport
CanReportCAN-Report is the CAN analyzing tool of port. It provides plugins for higher layer protocols CanOpen, DeviceNet and SaeJ1939. It also has an interface for user applications using the TclTk scripting language. Thus it serves as a multifunctional tool.
Receive a predefined number of messages in every supported bitrate. To switch bitrates some magic has to be present in your device. For example you could send a message with id 0x1 and the new bitrate as data content.
# application.tcl
#
# write text into main window
InsertText? {} "# application.tcl loaded #" stdout
#This procedure is called by the ResetTime? button in the user window.
proc resettime {} {
# not needed
}
#This procedure is called by the Help item in the Help menu.
proc do-help.usr {} {
InsertText? .usr "# No help available." stderr
}
#
# application --
#
# called everytime a message is received
#
# Arguments:
# msg - string from horch server
#
# Result:
#
proc application { msg } {
# get id
set id [get_can_id? $msg]
# data length code
set dlc [get_dlc? $msg]
# get data
set data [get_data? $msg]
if {$id == $::data(rx,id)} {
# count number of received messages
incr ::data($::data(curBitrate),msgCnt)
# all messages received ?
if {$::data($::data(curBitrate),msgCnt) == $::data(rx,maxMsg) } {
# write text in user window
InsertText? .usr "Test complete"
set ::data(testState) "Ok"
} else {
# do whatever is needed
}
}
}
#
# digi.init --
#
# initialize internal variables
#
# Arguments:
#
# Result:
#
#
proc digi.init {} {
foreach bitrate [list 10 20 50 100 125 250 500 800 1000] {
set ::data($bitrate,msgCnt) 0
}
set ::data(rx,id) 0x100
set ::data(rx,maxMsg) 1000
set ::data(tx,id) 0x101
set ::data(tx,maxMsg) 1000
set ::data(timeout) 5000
}
#
# digi.startTest
#
# run tests
#
# Arguments:
#
# Result:
#
#
proc digi.startTest {} {
digi.init
foreach bitrate [list 10 20 50 100 125 250 500 800 1000] {
# set new bitrate and reset CAN
horch "b$bitrate"
horch "thR"
set ::data(curBitrate) $bitrate
set ::data(testState) ""
InsertText? .usr "Start test at bitrate $::data(curBitrate) KBit/s" stdout
# insert code to tell the device
# to send its test sequence
# in case not all messages are received
# stop test after 5 seconds
after $::data(timeout) {set ::data(testState) "timeout"}
# wait for messages or timeout
tkwait variable ::data(testState)
if { $::data(testState) ne "Ok" } {
InsertText? .usr "Failed." stderr
} else {
InsertText? .usr "Success." stdout
}
# some magic to switch to a new bitrate
set b0 [expr {$bitrate >> 8}]
set b1 [expr {$bitrate && 0xff}]
wr 0x1 $b0 $b1
}
InsertText? .usr "Test finished" stdout
}
digi.startTest
# set of values
set values {
0 0 2 0 0 5 1 0 10 1 0 14 2 0 20 2 0 25 3 0 50 3 0 70 4 0 80
5 0 90 9 0 100 10 0 130 11 0 160 15 0 200 16 0 220 20 1 0 25 1 200
30 2 0 45 5 0 30 0 200 20 0 200 20 1 0 20 1 0 20 1 0 10 0 0 0 0 0
}
# number of values
set max [llength $values]
set stop 0
set cnt 0
while { $stop == 0 } {
# 3 values are sent in one CAN message with the id 0x183
wr 0x183 [lindex $values $cnt]\
[lindex $values [expr $cnt + 1]]\
[lindex $values [expr $cnt + 2]]
incr cnt 3
# the following 3 lines are a non-blocking wait
# for 500 ms
set waitvar 0
after 500 [list set ::waitvar 1]
vwait ::waitvar
# start again at the beginning of the list
if { $cnt >= $max } {
set cnt 0
}
}
proc listPdoCobIds {{start 0} {end 512}} {
# read RPDO Cob-ID
for { set i $start } { $i < $end } { incr i } {
set index [expr 0x1400 + $i]
puts "COB-ID RPDO $i: [format 0x%x [r $index 1 u32]]"
}
puts ""
# read TPDO Cob-ID
for { set i $start } { $i < $end } { incr i } {
set index [expr 0x1800 + $i]
puts "COB-ID TPDO $i: [format 0x%x [r $index 1 u32]]"
}
}
proc listPdoMapping {{start 0} {end 512}} {
# read RPDO mapping
for { set i $start } { $i < $end } { incr i } {
set index [expr 0x1600 + $i]
set pdoMapCnt [r $index 0 u8]
puts "RPDO $i"
for {set j 1} { $j <= $pdoMapCnt } { incr j } {
puts " Mapping $j: [format 0x%x [r $index $j u32]]"
}
}
puts ""
# read TPDO mapping
for { set i $start } { $i < $end } { incr i } {
set index [expr 0x1A00 + $i]
set pdoMapCnt [r $index 0 u8]
puts "TPDO $i"
for {set j 1} { $j <= $pdoMapCnt } { incr j } {
puts " Mapping $j: [format 0x%x [r $index $j u32]]"
}
}
}
proc setNodeguarding { guardtime lifetime } {
w 0x100c 0 u16 $guardtime
w 0x100d 0 u8 $lifetime
}
proc setHeartbeat { hbttime } {
w 0x1017 0 u16 $hbttime
}
Works with CAN-REport 3.3 and later.
This example uses the on message command from the embbeded scripting language. Whenever a message with the given id is received the script is executed. Within the script there is the array this which contains the elements id, data and type.
A global variable co_state? is used to store the current NMT state of the device. This variable has to be set before any guarding message was received.
for {set i 1} { $i <127} { incr i } {
set ::co_state?($i) 5
}
on message 0x721 {
set nid [expr $this(id) & 0x7f]
set ::co_state?($nid) [expr $::co_state?($nid) ^ 0x80]
wr $this(id) $::co_state?($nid)
Tested with CAN-REport 3.4.
This example makes use of the "User Plugin" of the CAN-REport.
# application.tcl
#
#
# InsertText? {} "# application.tcl loaded #" stdout
#This procedure is called by the ResetTime? button in the user window.
proc resettime {} {
InsertText? .usr "# this function is not implemented yet" stderr
;#reset internal time
}
#This procedure is called by the Help item in the Help menu.
proc do-help.usr {} {
InsertText? .usr "# No help available." stderr
}
variable _colors
set _colors(nmtstate,bootup) blue
set _colors(nmtstate,preop) orange
set _colors(nmtstate,op) green
set _colors(nmtstate,stopped) red
set _colors(nmtcmd,resetappl) ""
set _colors(nmtcmd,resetcomm) ""
set _colors(nmtcmd,Bootup) ""
set _colors(nmtcmd,Op) green4
set _colors(nmtcmd,Preop) orange3
set _colors(nmtcmd,Stopped) red4
set _colors(nmtcmd,resetappl) white
set _colors(nmtcmd,resetcomm) yellow
variable _nodes
for {set i 1} {$i < 128} {incr i} {
set _nodes($i,nmtstate) 0xff
}
proc application { msg } {
variable _widgets
variable _colors
variable _nodes
# get id
set id [get_can_id? $msg]
# data length code
set dlc [get_dlc? $msg]
# get data
set data [get_data? $msg]
if { ($id == 0) } {
set cmd [lindex $data 0]
set node [format %d "0x[lindex $data 1]"]
set tag node$node
switch $cmd {
"80" {
set color $_colors(nmtcmd,Preop)
}
"01" {
set color $_colors(nmtcmd,Op)
}
"81" {
set color $_colors(nmtcmd,resetappl)
set _nodes($node,nmtstate) $cmd
}
"82" {
set color $_colors(nmtcmd,resetcomm)
InsertText? .usr $msg stdout
set _nodes($node,nmtstate) $cmd
}
default {
set color $_colors(nmtcmd,Stopped)
}
}
set bbox [$_widgets(canvas) bbox $tag]
$_widgets(canvas) create rect $bbox -fill $color -tag state$node
$_widgets(canvas) raise $tag
return
}
# puts $id
# EMCY monitoring
if { ($id == 0xff) } {
set errCode "0x[lindex $data 1][lindex $data 0]"
set node [format %d "0x[lindex $data 3]"]
switch $errCode {
"0xff80" {
set index "0x[lindex $data 5][lindex $data 4]sub[lindex $data 6]"
set ::emcyText "Configuration write failed for node $node: $index"
}
"0xff81" {
set index "0x[lindex $data 5][lindex $data 4]sub[lindex $data 6]"
set ::emcyText "Configuration check failed for node $node: $index"
}
"0xff82" {
set ::emcyText "Configuration finished for node $node"
}
}
return
}
# heartbeat monitoring
if { ($id > 0x700) && ($id < 0x780)} {
set node [expr {$id & 0xff}]
set tag node$node
set state [lindex $data 0]
switch -- $state {
"00" {
set color $_colors(nmtstate,bootup)
}
"7f" {
set color $_colors(nmtstate,preop)
}
"05" {
set color $_colors(nmtstate,op)
}
default {
set color $_colors(nmtstate,stopped)
}
}
# update only on state change
if { $_nodes($node,nmtstate) ne $state } {
set _nodes($node,nmtstate) $state
set bbox [$_widgets(canvas) bbox $tag]
$_widgets(canvas) create rect $bbox -fill $color -tag state$node
$_widgets(canvas) raise $tag
}
return
}
}
proc initUI {} {
variable _widgets
variable _colors
set w .desy
toplevel $w
set lf [labelframe $w.f -text " NMT States "]
set c $lf.c
canvas $c -bg [$w cget -bg] -width 380 -height 410
set column 0
set columnMax 12
set x 0
set y 0
set dx 30
set dy 30
for {set nodes 1} {$nodes < 128} {incr nodes} {
if { $column % $columnMax == 0 } {
incr y $dy
set x 0
}
incr column
set x [incr x $dx]
$c create text $x $y \
-text [format %3d $nodes] -tag node$nodes
}
set x $dx
set x [expr $dx +80]
set dy 20
set letterWidth 3
set bheight 10
set bwidth 10
incr y $dy
set column 0
$c create text $dx [expr {$y + $bheight -4}] -text State
foreach nmtColor [lsort [array names _colors nmtstate,*]] {
set descr [string totitle [lindex [split $nmtColor ,] 1]]
set xlen [expr {[string length $descr] * $letterWidth + 55}]
if { $_colors($nmtColor) ne "" } {
set bbox [list $x $y [expr {$x + $bwidth}] [expr {$y + $bheight}]]
$c create rect $bbox -fill $_colors($nmtColor)
$c create text [expr {$x + $bwidth + 30}] [expr {$y + $bheight -4}] -text $descr
}
set x [expr {$x + $xlen}]
incr column
}
set x [expr $dx +80]
incr y $dy
set column 0
$c create text $dx [expr {$y + $bheight -4}] -text Command
foreach nmtColor [lsort [array names _colors nmtcmd,*]] {
set descr [string totitle [lindex [split $nmtColor ,] 1]]
set xlen [expr {[string length $descr] * $letterWidth + 55}]
if { $_colors($nmtColor) ne "" } {
set bbox [list $x $y [expr {$x + $bwidth}] [expr {$y + $bheight}]]
$c create rect $bbox -fill $_colors($nmtColor)
$c create text [expr {$x + $bwidth + 30}] [expr {$y + $bheight -4}] -text $descr
}
set x [expr {$x + $xlen}]
incr column
if {$column % 4 == 0 } {
incr y $dy
set x [expr $dx +80]
}
}
pack $c -expand 1 -fill both -padx 5 -pady 5
pack [button $lf.b -text "Reset" -command [list resetHbtState $c]]
pack $lf -padx 5 -pady 5 -expand 1 -fill both
set ::emcyText " "
set lf [labelframe $w.f2 -text " EMCY CANopen Manager "]
set _widgets(emcy) [label $lf.l -textvariable ::emcyText -width 50]
pack $_widgets(emcy) -padx 5 -pady 5 -expand 1 -fill x -anchor w
pack $lf -padx 5 -pady 5 -expand 1 -fill x
set _widgets(win) $w
set _widgets(canvas) $c
return
}
proc resetHbtState { c } {
variable _nodes
for {set i 1} { $i < 128 } { incr i } {
set _nodes($i,nmtstate) x
$c delete state$i
}
}
proc reload {} {
variable _widgets
destroy $_widgets(win)
source application.tcl
}
# initialize UI
initUI
Tested with CAN-REport 4.0
This example makes use of the "User Plugin" of the CAN-REport.
proc application { msg } {
set time [get_time? $msg]
# get id
set id [get_can_id? $msg]
# data length code
set dlc [get_dlc? $msg]
# get data
set data [get_data? $msg]
set bdata [binary format H* [string map {{ } {}} $data]]
# The CAN message contains data in form of:
# 1 Byte
# 3 Unsigned 16 Bits values in Big Endian byte order
# The variables temp1, temp2, temp3 contain the values
binary scan $bdata cSSS channel temp1 temp2 temp3
}
Sometimes the Data in a CAN Frame contains bit encoded data. Displaying the data would need several lines. For a better overview it is desirable to only show some important bits in a single line and provide a detailed view on request, ie. the detailed analysis is shown on a button press. The following code shows how to do it.
image create photo uparrow -data R0lGODlhDAAMAJEAAP///9TQyAAAAAAAACwAAAAADAAMAAACEIyPqcudAqNQcq7orNu8qwIAOw==
image create photo downarrow -data R0lGODlhDAAMAJEAAP///9TQyAAAAAAAACwAAAAADAAMAAACEoyPqcsobcRrcq5qU6VZdQgmBQA7
#
#
#
##
proc gk::InsertTextEx? {msg {detail {}}} {
variable id
upvar ::widgets(.usr,text) t
$t insert end $msg\n stdout1
if { $detail ne "" } {
lassign [split [$t index end] "."] L C
set startIdx $L
incr L -2
set C [$t count -displaychars $L.0 $startIdx.0]
set tag b[incr id]
$t tag configure $tag -background #fafbf0 -lmargin1 50 -lmargin2 60 -font {Consolas 8}
set b $t.$tag
button $b -text "+" -command [list ElideToggle? $t $tag] \
-image downarrow -cursor hand2 \
-borderwidth 0 -relief flat \
-pady 0
$t window create $L.$C -window $b
$t insert end ${detail}\n $tag
set endIdx [$t index end]
$t tag config $tag -elide 1
}
}
#
#
#
##
proc ElideToggle? {w tag} {
set b $w.$tag
if {[$b cget -text] eq "-"} {
$b config -text + -image downarrow
$w tag config $tag -elide 1
} else {
$b config -text - -image uparrow
$w tag config $tag -elide 0
}
}
more lines within the main window (CR 4.0.3)
set ::ST(line_limit?) 100000