hal-histogram
1 #!/usr/bin/wish 2 3 # For usage: hal-histogram --help 4 5 #----------------------------------------------------------------------- 6 # Copyright: 2015 7 # Author: Dewey Garrett <dgarrett@panix.com> 8 # 9 # This program is free software; you can redistribute it and/or modify 10 # it under the terms of the GNU General Public License as published by 11 # the Free Software Foundation; either version 2 of the License, or 12 # (at your option) any later version. 13 # 14 # This program is distributed in the hope that it will be useful, 15 # but WITHOUT ANY WARRANTY; without even the implied warranty of 16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 # GNU General Public License for more details. 18 # 19 # You should have received a copy of the GNU General Public License 20 # along with this program; if not, write to the Free Software 21 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 22 #----------------------------------------------------------------------- 23 24 # library procs: 25 # Note: use linuxcnc_var script since this program can be 26 # started without using the linuxcnc script and 27 # ::env(HALLIB_DIR) will not exist. 28 source [file join [exec linuxcnc_var HALLIB_DIR] hal_procs_lib.tcl] 29 30 proc threadname_for_pin {pinname} { 31 thread_info tmp 32 if { [llength $tmp(threadnames)] == 1 } { 33 return $tmp(threadnames) 34 } 35 # assume common form for functions and pinnames 36 set idx [string last . $pinname] 37 set funcname [string range $pinname 0 [expr $idx -1]] 38 set tname [array names tmp *,$funcname] 39 if {[llength $tname] == 1} { 40 set idx [string first , $tname] 41 set tname [string range $tname 0 [expr $idx - 1]] 42 return "$tname" 43 } else { 44 # not all pins have a thread associated with a function 45 # e.g., axis.N.* pins, motion pins 46 set period 0; set tname "" 47 foreach thd $tmp(threadnames) { 48 if {$tmp($thd,period) > $period} { 49 set tname $thd 50 set period $tmp($thd,period) 51 } 52 } 53 puts "threadname_for_pin: <$pinname>: using longest period thread:$tname" 54 return "$tname" 55 } 56 } ;# threadname_for_pin 57 58 proc next_available_component_instance { functionname } { 59 # find component with users==0 for functionname (wildcard) 60 set ans [hal show funct $functionname] 61 set lines [split $ans \n] 62 set header_len 2 63 set lines [lreplace $lines 0 [expr $header_len -1]] 64 set lines [lreplace $lines end end] 65 set remainder "" 66 foreach line $lines { 67 set howmany [scan $line \ 68 "%s %s %s %s %s %s" \ 69 owner codeaddr arg fp users name] 70 if {$howmany && "$users" == 0} { 71 if $::HH(opt,verbose) { 72 puts "$::HH(prog):next_available_component_instance:$name" 73 } 74 return $name 75 } 76 } 77 return "" 78 } ;# next_available_component_instance 79 80 proc round_number {x} { 81 # example; 12345.678 => 10000 82 if {$x == 0} {return 0} 83 set sign [expr $x < 0 ? -1 : 1] 84 set exp [expr int(log10(abs($x + .00001)))] 85 set first [lindex [split [expr abs($x)] ""] 0] 86 return [expr int($sign*$first * pow(10,$exp))] 87 } ;# round_number 88 89 proc set_defaults {} { 90 wm withdraw . 91 wm protocol . WM_DELETE_WINDOW finish 92 93 # defaults for items which have cmdline options: 94 set ::HH(opt,verbose) 0 95 set ::HH(opt,show) 0 96 set ::HH(note,txt) "" 97 set ::HH(y,logscale) 1 98 set ::HH(nbins) 50 99 set ::HH(minvalue) 0 100 set ::HH(binsize) 100 101 set ::HH(maxvalue) 0 102 set ::HH(pinname) motion-command-handler.time 103 104 # defaults for items with no cmdline opts: 105 set ::HH(color) seagreen 106 set ::HH(signame,prefix,float) hhf 107 set ::HH(signame,prefix,s32) hhs 108 set ::HH(signame,prefix,u32) hhu 109 set ::HH(signame,prefix,bit) hhb 110 set ::HH(max_histos) 5 111 set ::HH(guess,ct) 100 112 set ::HH(guess,factor) 10 113 set ::HH(dly,ms) 10 ;# initial delay for reading by index 114 # 1 mS is minimum interval for after cmd 115 # for 100bins *10mS = 1 sec update interval 116 117 # housekeeping 118 set ::HH(compname) histobins 119 set ::HH(instancename,prefix) histo 120 set ::HH(nsamples) 0 121 set ::HH(info) "" 122 set ::HH(warning_active) 0 123 set ::HH(reread,ct) 0 124 set ::HH(bump,ct) 0 125 set ::HH(after,repeat) "" 126 set ::HH(after,monitor) "" 127 set ::HH(p,more) 0 128 set ::HH(n,more) 0 129 130 set ::HH(start) [clock seconds] 131 set ::HH(date) [clock format [clock seconds] -format "%d%b%Y"] 132 set ::HH(prog,short) [file tail $::argv0] 133 set ::HH(prog) $::argv0 134 set ::HH(title) $::HH(prog) 135 136 set ::HH(dir,screenshot) /tmp/$::HH(prog,short) 137 if [catch {file mkdir $::HH(dir,screenshot)} msg] { 138 set ::HH(dir,screenshot) ~ 139 } 140 } ;# set_defaults 141 142 proc config {} { 143 while {[llength $::argv] >0} { 144 # beware wish handling of reserved cmdline arguments 145 # lreplace shifts argv for no. of items for each iteration 146 # to use -h: use -- -h 147 set currentarg [lindex $::argv 0] 148 switch -- $currentarg { 149 --help - 150 -? - 151 -h {usage;exit 0} 152 --logscale {set t [lindex $::argv 1] 153 set ::HH(y,logscale) $t 154 set ::argv [lreplace $::argv 0 0] 155 } 156 --pinname {set t [lindex $::argv 1] 157 set ::HH(pinname) $t 158 set ::argv [lreplace $::argv 0 0] 159 } 160 --minvalue {set t [lindex $::argv 1] 161 set ::HH(minvalue) $t 162 set ::argv [lreplace $::argv 0 0] 163 } 164 --nbins {set t [lindex $::argv 1] 165 set ::HH(nbins) $t 166 set ::argv [lreplace $::argv 0 0] 167 } 168 --binsize {set t [lindex $::argv 1] 169 set ::HH(binsize) $t 170 set ::argv [lreplace $::argv 0 0] 171 } 172 --text {set t [lindex $::argv 1] 173 set ::HH(note,txt) $t 174 set ::argv [lreplace $::argv 0 0] 175 } 176 --show {set ::HH(opt,show) 1 } 177 --verbose {set ::HH(opt,verbose) 1 } 178 -* {usage "Unknown args:$::argv"} 179 default { if {[llength $::argv] > 1} { 180 usage "Too many pins were specified: <$::argv>" 181 } else { 182 set ::HH(pinname) $::argv 183 } 184 } 185 } 186 set ::argv [lreplace $::argv 0 0] 187 } ;# while 188 189 if ![pin_exists $::HH(pinname)] { 190 set msg "No pin named: <$::HH(pinname)>" 191 popup "$msg\n\nIs LinuxCNC (or another Hal application) active?" 192 usage $msg 193 } 194 195 set ::HH(pintype) [hal ptype $::HH(pinname)] 196 switch -exact "$::HH(pintype)" { 197 float {} 198 s32 {} 199 u32 {} 200 bit { 201 # ignore input args on startup: 202 set ::HH(minvalue) 0 203 set ::HH(binsize) 1 204 set ::HH(nbins) 2 205 } 206 default { 207 usage "Unsupported pintype <$::HH(pintype)> for pin $::HH(pinname)" 208 } 209 } 210 set ::HH(maxvalue) [compute_maxvalue] 211 212 set ::HH(pid) [pid] 213 set all_instances [exec pgrep $::HH(prog,short)] 214 if {[lsearch $all_instances $::HH(pid)] != 0} { 215 after 200 ;# guard for race in loadrt if simultaneous starts 216 } 217 } ;# config 218 219 proc load_packages {} { 220 if [catch {package require Tclx} msg] { 221 puts $msg 222 puts "To install: sudo apt-get install tclx" 223 exit 1 224 } 225 signal trap SIGINT finish ;# uses Tclx 226 if [catch {package require BLT} msg] { 227 puts $msg 228 puts "To install: sudo apt-get install blt" 229 exit 1 230 } 231 if [catch {package require Img} msg] { 232 puts $msg 233 puts "To install: sudo apt-get install libtk-img" 234 exit 1 235 } 236 237 # augment ::auto_path for special case: 238 # 1) RIP build (no install) 239 # 2) linuxcnc script called from Application menu 240 if { [info exists ::env(LINUXCNC_TCL_DIR)] 241 && ([lsearch $::auto_path $::env(LINUXCNC_TCL_DIR)] < 0) 242 } { 243 # prepend 244 set ::auto_path [lreplace $::auto_path 0 -1 $::env(LINUXCNC_TCL_DIR)] 245 } 246 if [catch {package require Hal} msg] { 247 puts $msg 248 puts "For a RIP linuxcnc build, source rip-environment in this shell" 249 exit 1 250 } 251 blt::bitmap define nbmap { 252 {8 8} 253 {0xc7,0x8f,0x1f,0x3e,0x7c, 0xf8,0xf1,0xe3} 254 } 255 blt::bitmap define pbmap { 256 {8 8} 257 {0xe3,0xf1,0xf8,0x7c, 0x3e,0x1f,0x8f,0xc7} 258 } 259 } ;# load_packages 260 261 proc make_gui { {w .} } { 262 wm title . "$::HH(title) ($::HH(instance))" 263 264 set f [frame ${w}fa] 265 pack $f -side top -fill x -expand 1 266 pack [label $f.l -anchor w -textvar ::HH(info)] -fill x -expand 1 267 268 set f [frame ${w}fb] 269 pack $f -side top -fill x -expand 1 270 pack [label $f.l -anchor w \ 271 -text "$::HH(date) \ 272 LinuxCNC: [exec linuxcnc_var LINUXCNCVERSION] \ 273 OS: $::tcl_platform(osVersion) [exec hostname]" \ 274 ] -fill x -expand 1 275 276 set f [frame ${w}fc] 277 pack $f -side top -fill x -expand 1 278 pack [label $f.l -anchor w -textvar ::HH(note,txt)] -fill x -expand 1 279 280 set fmain [frame ${w}fmain] 281 pack $fmain -side top 282 283 set f1 [frame $fmain.f1 -relief groove -bd 2] 284 pack $f1 -side left 285 286 set f [frame $f1.t] 287 pack $f -side top 288 289 set ::HH(widget) $f.graph 290 catch {destroy $::HH(widget)} 291 blt::barchart $::HH(widget) \ 292 -plotbackground honeydew1 \ 293 -cursor arrow \ 294 -title "" 295 pack $::HH(widget) -side left 296 297 xaxis 298 $::HH(widget) axis configure y -logscale $::HH(y,logscale) 299 300 set nwid 9 ;# numbers width 301 set pwid 8 ;# pos numbers width 302 #-------------------------------------------------------------------- 303 if $::HH(opt,show) { 304 set f [frame $f1.extra -relief ridge -bd 1] 305 pack $f -side top -anchor w -fill x -expand 1 306 set e [entry $f.emin -textvariable ::HH(n,more) \ 307 -state readonly -justify right -width 3] 308 pack $e -side left -anchor e 309 pack [label $f.min -text "<--off-chart neg bin ct"] \ 310 -side left -anchor e 311 set ::HH(widget,negbins) $e 312 313 set e [entry $f.emax -textvariable ::HH(p,more) \ 314 -state readonly -justify right -width 3] 315 pack $e -side right -anchor e 316 pack [label $f.max -text "off-chart pos bin ct-->"] \ 317 -side right -anchor e 318 set ::HH(widget,posbins) $e 319 } else { 320 set ::HH(widget,negbins) placeholder 321 set ::HH(widget,posbins) placeholder 322 proc placeholder {args} return 323 } 324 325 #-------------------------------------------------------------------- 326 set f [frame $f1.minmax -relief ridge -bd 1] 327 pack $f -side top -anchor w -fill x -expand 1 328 329 pack [label $f.min -width 6 -anchor e -text "Min:"] \ 330 -side left 331 set e [entry $f.emin -textvariable ::HH(input_min) \ 332 -state readonly -justify right -width $nwid] 333 pack $e -side left -anchor e 334 335 pack [label $f.mean -width 5 -anchor e -text "Mean:"] \ 336 -side left 337 set e [entry $f.emean -textvariable ::HH(mean) \ 338 -state readonly -justify right -width $nwid] 339 pack $e -side left -anchor e 340 341 pack [label $f.sdev -width 5 -anchor e -text " Sdev:"] \ 342 -side left 343 set e [entry $f.esdev -textvariable ::HH(sdev) \ 344 -state readonly -justify right -width $pwid] 345 pack $e -side left -anchor e 346 347 pack [label $f.max -width 6 -anchor e -text "Max:"] \ 348 -side left -anchor e 349 set e [entry $f.emax -textvariable ::HH(input_max) \ 350 -state readonly -justify right -width $nwid] 351 pack $e -side right -anchor e 352 353 #-------------------------------------------------------------------- 354 set f [frame $f1.nbins -relief ridge -bd 1 ] 355 pack $f -side top -anchor w -fill x -expand 1 356 set ::HH(new,nbins) $::HH(nbins) 357 set ::HH(new,minvalue) $::HH(minvalue) 358 set ::HH(new,binsize) $::HH(binsize) 359 360 pack [label $f.lmin -width 6 -anchor e -text "minval:" \ 361 ] -side left 362 pack [entry $f.emin -textvariable ::HH(new,minvalue) \ 363 -width $nwid -justify right \ 364 ] -side left -expand 0 365 366 pack [label $f.lmax -width 5 -anchor e -text "bsize:" \ 367 ] -side left 368 pack [entry $f.emax -textvariable ::HH(new,binsize) \ 369 -width $nwid -justify right \ 370 ] -side left -expand 1 371 372 pack [label $f.lbins -width 5 -anchor e -text "nbins:" \ 373 ] -side left -expand 0 374 pack [entry $f.ebins -textvariable ::HH(new,nbins) \ 375 -width $pwid -justify right \ 376 ] -side left -expand 1 377 378 pack [label $f.el -width 6 -anchor e -text " maxval:"] -side left -anchor e 379 pack [entry $f.e -textvariable ::HH(maxvalue) \ 380 -state readonly -justify right -width $nwid] \ 381 -side left -expand 1 -anchor e 382 383 384 bind $f.emin <Return> new_comp_settings 385 bind $f.emax <Return> new_comp_settings 386 bind $f.ebins <Return> new_comp_settings 387 #-------------------------------------------------------------------- 388 set f [frame ${w}bot -relief ridge -bd 1] 389 pack $f -side bottom -anchor w -fill x -expand 1 390 pack [button $f.b -padx 0 -pady 0 -text Restart \ 391 -command new_comp_settings] \ 392 -side left -anchor w 393 pack [checkbutton $f.c -anchor w -text ylogscale \ 394 -variable ::HH(y,logscale)] \ 395 -side left 396 397 pack [button $f.exit -padx 0 -pady 0 -text Exit -command finish ] \ 398 -side right 399 400 pack [entry $f.e -textvariable ::HH(elapsed) \ 401 -state readonly -justify right -width 6] \ 402 -side right -anchor e 403 pack [label $f.el -anchor e -text "Elapsed Time:"] -side right -anchor e 404 405 pack [button $f.sshot -padx 0 -pady 0 -text Screenshot \ 406 -command [list windowToFile .]] \ 407 -side right -fill x -expand 1 408 409 wm deiconify . 410 wm resizable . 0 0 411 } ;# make_gui 412 413 proc finish {} { 414 after cancel [after info] 415 progress $::HH(title)\n 416 progress "Fini" 417 catch { 418 hal delf $::HH(instance) $::HH(threadname) 419 hal unlinkp $::HH(inputpinname) 420 if $::HH(signame_is_new) { 421 hal delsig $::HH(signame) 422 } 423 } ;# avoid some msgs on close 424 exit 0 425 } ;# finish 426 427 proc repeat {} { 428 after cancel $::HH(after,repeat) 429 set ::HH(elapsed) [expr [clock seconds] - $::HH(start)] 430 scan [time { update_chart }] "%d %s" tus notused 431 set tms [expr $tus/1000] 432 set ::HH(after,repeat) [after [expr 2*$tms] repeat] ;# nohogging 433 } ;# repeat 434 435 proc reset_data {} { 436 progress "Reset data" 437 if {$::HH(nsamples) > 0} { 438 puts "Reset $::HH(pinname): min $::HH(input_min)\ 439 max:$::HH(input_max) \ 440 mean:$::HH(mean) \ 441 sdev:$::HH(sdev) \ 442 nsamples:$::HH(nsamples)" 443 } 444 hal setp $::HH(instance).reset 1 445 $::HH(widget,posbins) conf -fg black 446 $::HH(widget,negbins) conf -fg black 447 set ::HH(input_min) "" 448 set ::HH(input_max) "" 449 set ::HH(mean) "" 450 set ::HH(sdev) "" 451 set ::HH(pextra) "" 452 set ::HH(nextra) "" 453 set ::HH(p,more) "" 454 set ::HH(n,more) "" 455 after 100 456 hal setp $::HH(instance).reset 0 457 set ::HH(start) [clock seconds] 458 set ::HH(elapsed) 0 459 make_chart 460 return 461 } ;# reset_data 462 463 proc check_inputs {minvalue binsize nbins} { 464 if {$binsize <= 0} { 465 return "Requested binsize <$binsize> is <= 0" 466 } 467 if {$nbins > $::HH(availablebins)} { 468 return "Requested bins <$nbins> is greater than availablebins <$::HH(availablebins)>" 469 } 470 if {$nbins <= 0} { 471 return "Requested nbins <$nbins> not allowed" 472 } 473 474 if { ![is_int $nbins] } {return "nbins must be integer"} 475 switch -exact "$::HH(pintype)" { 476 float {} 477 s32 - 478 u32 - 479 bit { 480 if { ![is_int $minvalue]} { 481 return "minvalue must be integer <$minvalue> for type $::HH(pintype)" 482 } 483 if { ![is_int $binsize] } {return "binsize must be integer <$binsize>"} 484 } 485 } 486 return "" 487 } ;# check_inputs 488 489 proc new_comp_settings {} { 490 foreach item {minvalue binsize nbins} { 491 set tmp(restore,$item) $::HH($item) 492 } 493 set msg [check_inputs $::HH(new,minvalue) \ 494 $::HH(new,binsize) \ 495 $::HH(new,nbins)] 496 if {"" != "$msg"} { 497 popup $msg warning 498 foreach item {minvalue binsize nbins} { 499 set ::HH($item) $tmp(restore,$item) 500 set ::HH(new,$item) $tmp(restore,$item) 501 } 502 return 503 } 504 505 after cancel $::HH(after,monitor) ;# avoid duplicate checks 506 foreach item {minvalue binsize nbins} { 507 if {"$::HH(new,$item)" != ""} { 508 set ::HH($item) $::HH(new,$item) 509 hal setp $::HH(instance).$item $::HH($item) 510 set ::HH(new,$item) [format %.3g $::HH(new,$item)] 511 } 512 } 513 after 100 514 set err [hal getp $::HH(instance).input-error] 515 if {$err} { 516 popup "input-error pin set\n\nRestoring prior settings" info 517 foreach item {minvalue binsize nbins} { 518 set ::HH($item) $tmp(restore,$item) 519 set ::HH(new,$item) $tmp(restore,$item) 520 hal setp $::HH(instance).$item $::HH($item) 521 } 522 } 523 set ::HH(maxvalue) [compute_maxvalue] 524 reset_data 525 xaxis 526 monitor 527 } ;# new_comp_settings 528 529 proc setup_hal {} { 530 if {[hal list funct $::HH(instancename,prefix)] == ""} { 531 set names "" 532 for {set i 0} {$i < $::HH(max_histos)} {incr i} { 533 set names "$names,$::HH(instancename,prefix)-$i" 534 } 535 set names [string trimleft $names ,] 536 hal loadrt $::HH(compname) names=$names 537 set idx 0 ;# first one used 538 } else { 539 set ::HH(instance) \ 540 [next_available_component_instance $::HH(instancename,prefix)] 541 if {"$::HH(instance)" == ""} { 542 set msg "$::HH(prog,short):setup_hal: no instance available" 543 set msg "$msg\nExceeded number ($::HH(max_histos))" 544 popup $msg 545 exit 1 546 } 547 set idx [string range $::HH(instance) \ 548 [expr [string first - $::HH(instance)] +1] end] 549 } 550 set ::HH(instance) $::HH(instancename,prefix)-$idx 551 set ::HH(availablebins) [hal getp $::HH(instance).availablebins] 552 553 set ::HH(threadname) [threadname_for_pin $::HH(pinname)] 554 555 thread_info tinfo 556 if !$tinfo($::HH(threadname),fp) { 557 usage \ 558 "\n$::HH(pinname) must be running on a thread with floating point enabled 559 Use the loadrt motmod option: base_thread_fp=1" 560 } 561 562 if {[is_connected $::HH(pinname) signame] == "not_connected"} { 563 set ::HH(signame) $::HH(signame,prefix,$::HH(pintype))-$idx 564 set ::HH(signame_is_new) 1 565 } else { 566 set ::HH(signame) $signame 567 set ::HH(signame_is_new) 0 568 } 569 570 if [catch { 571 switch -exact "$::HH(pintype)" { 572 float { set ::HH(inputpinname) $::HH(instance).input 573 hal setp $::HH(instance).pintype 0 574 } 575 s32 { set ::HH(inputpinname) $::HH(instance).input-s32 576 hal setp $::HH(instance).pintype 1 577 } 578 u32 { set ::HH(inputpinname) $::HH(instance).input-u32 579 hal setp $::HH(instance).pintype 2 580 } 581 bit { set ::HH(inputpinname) $::HH(instance).input-bit 582 hal setp $::HH(instance).pintype 3 583 } 584 default { puts notdoneyet; exit 77 } 585 } 586 hal net $::HH(signame) $::HH(pinname) $::HH(inputpinname) 587 hal addf $::HH(instance) $::HH(threadname) 588 } emsg] { 589 wm withdraw . 590 set msg "$::HH(prog,short):setup_hal:" 591 set msg "$msg\nPin: $::HH(pinname)" 592 set msg "$msg\nInput: $::HH(inputpinname)" 593 set msg "$msg\nSig: $::HH(signame)" 594 set msg "$msg\nThread: $::HH(threadname)" 595 set msg "$msg\nInstance: $::HH(instance)" 596 set msg "$msg\n\n" 597 set msg "$msg $emsg" 598 popup $msg 599 exit 1 600 } 601 set ::HH(info) "Pin: $::HH(pinname) Sig: $::HH(signame) ($::HH(instance))" 602 } ;# setup_hal 603 604 proc start_collection {} { 605 make_chart 606 new_comp_settings 607 set ::HH(elapsed) 0 608 } ;# start_collection 609 610 proc make_chart {} { 611 set w $::HH(widget) 612 $w legend configure -hide 1 ;# too many nbins for legend 613 for {set bin 0} {$bin <= $::HH(nbins)} {incr bin} { 614 lappend pxd [expr $::HH(minvalue) +(0.5 + $bin) * $::HH(binsize)] 615 lappend pyd 0 616 } 617 # create first time, if resetting then just configure 618 if [$w element exists pdata] { 619 set op configure 620 } else { 621 set op create 622 } 623 $w element $op pmindata \ 624 -xdata $::HH(minvalue) \ 625 -ydata 0 \ 626 -fg $::HH(color) \ 627 -relief solid \ 628 -bd 0 -barwidth $::HH(binsize) \ 629 -bg lightblue 630 $w element $op pdata -xdata $pxd \ 631 -ydata $pyd \ 632 -fg $::HH(color) \ 633 -relief solid \ 634 -bd 0 -barwidth $::HH(binsize) \ 635 -bg lightblue 636 $w element $op pmaxdata \ 637 -xdata $::HH(maxvalue) \ 638 -ydata 0 \ 639 -fg $::HH(color) \ 640 -relief solid \ 641 -bd 0 -barwidth $::HH(binsize) \ 642 -bg lightblue 643 } ;# make_chart 644 645 proc xaxis {} { 646 set nbins $::HH(nbins) 647 set binsize $::HH(binsize) 648 set tick_dividers {0 5 2 1} 649 foreach v $tick_dividers { 650 if {$v == 0} { 651 lappend ticklist $::HH(minvalue) 652 } else { 653 lappend ticklist [round_number \ 654 [expr $::HH(minvalue) + $nbins/$v*$binsize]] 655 } 656 } 657 set fullscale [expr $nbins * $binsize] 658 $::HH(widget) axis configure x \ 659 -hide 0 \ 660 -logscale 0 \ 661 -showticks 1 \ 662 -min [expr -1.0*$::HH(binsize) + $::HH(minvalue)] \ 663 -max [expr +1.0*$::HH(binsize) + $::HH(maxvalue)] \ 664 -majorticks $ticklist 665 #was: -min 0 -max $fullscale 666 } ;# xaxis 667 668 proc update_chart {} { 669 set w $::HH(widget) 670 set dly $::HH(dly,ms) 671 set pmore 0 ;# not currently used 672 set nmore 0 ;# not currently used 673 for {set bin 0} {$bin < $::HH(nbins)} {incr bin} { 674 hal setp $::HH(instance).index $bin 675 set ct 0 676 while 1 { 677 after $dly 678 set chk [hal getp $::HH(instance).check] 679 if {$bin == $chk} { 680 break 681 } else { 682 # retry (probably only needed for (irrelevant) non-realtime threads) 683 incr ct 684 set retry_ct 100 685 if {$ct > $retry_ct} { 686 parrah ::HH 687 puts "$::HH(prog):update_chart: retry exceeded $retry_ct" 688 puts [hal show funct $::HH(instancename)] 689 puts "EXITHERE" 690 finish 691 } 692 incr ::HH(reread,ct) 693 if {$ct > 1} { 694 incr dly 695 incr ::HH(bump,ct) 696 } 697 } 698 } 699 set pbin [hal getp $::HH(instance).binvalue] 700 # 1.1 value makes single unit nbins show as pips when using log y scale: 701 if {$pbin == 1} {set pbin 1.1} 702 703 lappend pxd [expr $::HH(minvalue) +(0.5 + $bin) * $::HH(binsize)] 704 lappend pyd $pbin 705 } ;# for bin 706 707 set ::HH(pextra) [hal getp $::HH(instance).pextra] 708 set ::HH(nextra) [hal getp $::HH(instance).nextra] 709 710 set ::HH(input_min) [format %.3g [hal getp $::HH(instance).input-min]] 711 set ::HH(input_max) [format %.3g [hal getp $::HH(instance).input-max]] 712 713 set nsamples [format %u [hal getp $::HH(instance).nsamples]] 714 set ::HH(nsamples) $nsamples 715 716 set mean [hal getp $::HH(instance).mean] 717 set variance [hal getp $::HH(instance).variance] 718 set sdev [expr sqrt($variance)] 719 set mean [hal getp $::HH(instance).mean] 720 # puts [format "m=%10.3f %8.3f s=%8.3f %d" \ 721 # $mean $variance $sdev $nsamples] 722 set ::HH(sdev) [format %.3g $sdev] 723 set ::HH(mean) [format %.3g $mean] 724 725 set ::HH(p,more) [expr $pmore + $::HH(pextra)] 726 set ::HH(n,more) [expr $nmore + $::HH(nextra)] 727 if {$::HH(p,more) == 1} {set ::HH(p,more) 1.1} ;# show as pip 728 if {$::HH(n,more) == 1} {set ::HH(n,more) 1.1} ;# show as pip 729 730 set pcolor $::HH(color) 731 set pmaxcolor white 732 if {$::HH(pextra) > 0} { 733 set pcolor red 734 set pmaxcolor $pcolor 735 $::HH(widget,posbins) conf -fg $pcolor 736 } elseif {$::HH(p,more) > 0} { 737 $::HH(widget,posbins) conf -fg $::HH(color) 738 } else { 739 $::HH(widget,posbins) conf -fg black 740 } 741 742 set ncolor $::HH(color) 743 set nmaxcolor white 744 if {$::HH(nextra) > 0} { 745 set ncolor blue 746 set nmaxcolor $ncolor 747 $::HH(widget,negbins) conf -fg $ncolor 748 } elseif {$::HH(n,more) > 0} { 749 $::HH(widget,negbins) conf -fg $::HH(color) 750 } else { 751 $::HH(widget,negbins) conf -fg black 752 } 753 754 set pyd_max_pos $::HH(p,more) 755 set nyd_max_pos $::HH(n,more) 756 757 # display fmt 758 set ::HH(p,more) [format %.0f $::HH(p,more)] ;# clear pip 759 set ::HH(n,more) [format %.0f $::HH(n,more)] ;# clear pip 760 761 $w element configure pmindata \ 762 -xdata [expr -0.5*$::HH(binsize) + $::HH(minvalue)] \ 763 -ydata $nyd_max_pos \ 764 -stipple nbmap \ 765 -fg $::HH(color) -bg $nmaxcolor 766 $w element configure pdata -xdata $pxd -ydata $pyd 767 $w element configure pmaxdata \ 768 -xdata [expr +0.5*$::HH(binsize) + $::HH(maxvalue)]\ 769 -ydata $pyd_max_pos \ 770 -stipple pbmap \ 771 -fg $::HH(color) -bg $pmaxcolor 772 773 # a y axis configure is needed, updates may fail without it 774 $::HH(widget) axis configure y -logscale $::HH(y,logscale) 775 update 776 } ;# update_chart 777 778 proc is_int {v} { 779 set v [format %.30g $v] ;# first: expand if v is in exponential format 780 if [catch {format %d $v}] { return 0 } 781 return 1 782 } ;# is_int 783 784 proc popup {msg {icon error} } { \ 785 set title "$::HH(prog,short)" 786 if [info exists ::HH(instance)] { 787 set title "$title ($::HH(instance))" 788 } 789 set answer [tk_messageBox \ 790 -parent . \ 791 -icon $icon \ 792 -type ok \ 793 -title "$title" \ 794 -message "$msg" \ 795 ] 796 puts $msg 797 } ;# popup 798 799 proc progress {txt} { 800 if !$::HH(opt,verbose) return 801 puts stderr "$::argv0: [expr [clock seconds] - $::HH(start)]s $txt" 802 } ;# progress 803 804 proc compute_maxvalue {} { 805 # avoid auto conversions to int 806 set minvalue [format %f $::HH(minvalue)] 807 set binsize [format %f $::HH(binsize)] 808 set nbins [format %f $::HH(nbins)] 809 810 if { $binsize <= 0 \ 811 || $nbins <= 0 } { 812 set msg "$::HH(prog,short): bad inputs" 813 set msg "$msg\n\npinname=$::HH(pinname)" 814 popup $msg 815 usage $msg 816 exit 1 817 } 818 set maxvalue [expr $::HH(minvalue) + $::HH(binsize) * $::HH(nbins)] 819 return [format %.3g $maxvalue] 820 } ;# compute_maxvalue 821 822 proc monitor {} { 823 # external changes to component minvalue,binsize,nbins may 824 # cause component input-error 825 # (changes may cause other problems but only input-error 826 # is currently tested) 827 after cancel $::HH(after,monitor) 828 if [hal getp $::HH(instance).input-error] { 829 if !$::HH(warning_active) { 830 set ::HH(warning_active) 1 831 popup " 832 $::HH(prog): input-error 833 nbins=[hal getp $::HH(instance).nbins] 834 minvalue=[hal getp $::HH(instance).minvalue] 835 binsize=[hal getp $::HH(instance).binsize] 836 \nUpdate settings required 837 " warning 838 } 839 } else { 840 set ::HH(warning_active) 0 841 } 842 set ::HH(after,monitor) [after 1000 monitor] ;# reschedule 843 } ;# monitor 844 845 proc usage { {errtxt ""} } { 846 set prog $::HH(prog,short) 847 puts "" 848 puts "Usage:" 849 puts " $prog --help | -?" 850 puts "or" 851 puts " $prog \[Options\] \[pinname\]" 852 puts "" 853 puts "Options:" 854 puts " --minvalue minvalue (minimum bin, default: $::HH(minvalue))" 855 puts " --binsize binsize (binsize, default: $::HH(binsize))" 856 puts " --nbins nbins (number of bins, default: $::HH(nbins))" 857 puts "" 858 puts " --logscale 0|1 (y axis log scale, default: $::HH(y,logscale))" 859 puts " --text note (text display, default: \"$::HH(note,txt)\" )" 860 puts " --show (show count of undisplayed nbins, default off)" 861 puts " --verbose (progress and debug, default off)" 862 863 puts "" 864 puts "Notes:" 865 puts " 1) LinuxCNC (or another Hal application) must be running" 866 puts " 2) If no pinname is specified, default is: $::HH(pinname)" 867 puts " 3) This app may be opened for $::HH(max_histos) pins" 868 puts " 4) pintypes float, s32, u32, bit are supported" 869 puts " 5) The pin must be associated with a thread supporting floating point" 870 puts " For a base thread, this may require using:" 871 puts " loadrt motmod ... base_thread_fp=1" 872 873 if {"$errtxt" != ""} { 874 puts "" 875 puts "ERROR:" 876 puts "[file tail $::HH(prog)]: $errtxt" 877 exit 1 878 } 879 exit 0 880 } ;# usage 881 882 #------------------------------------------------------------------ 883 proc bltCaptureWindow { win } { 884 set image [image create photo] 885 blt::winop snap $win $image 886 return $image 887 } ;# bltCaptureWindow 888 889 proc windowToFile { win } { 890 set image [bltCaptureWindow $win] 891 set types {{"Image Files" {.png}}} 892 set ifile $::tcl_platform(user)-$::HH(date)-$::HH(elapsed).png 893 set filename [tk_getSaveFile -filetypes $types \ 894 -initialfile $ifile \ 895 -initialdir $::HH(dir,screenshot) \ 896 -defaultextension .png] 897 if {[llength $filename]} { 898 set ::HH(dir,screenshot) [file dirname $filename] 899 $image write -format png $filename 900 } 901 image delete $image 902 } ;# windowToFile 903 #------------------------------------------------------------------ 904 905 # allow re-sourcing for testing with tkcon 906 if ![info exists ::HH(start)] { 907 set_defaults 908 progress "Loading packages" 909 load_packages 910 config 911 progress "setup hal" 912 setup_hal 913 progress "Making gui" 914 make_gui 915 progress "Start_collection" 916 start_collection 917 progress "Begin repeats" 918 repeat 919 monitor 920 } else { 921 puts "$::argv0 already running" 922 }