sim_pin
1 #!/usr/bin/wish 2 3 if [catch {package require Hal} msg] { 4 puts "\nProblem: $msg" 5 puts "Is linuxcnc installed?" 6 puts "If using Run-In-Place build, source scripts/rip-environment first" 7 exit 1 8 } 9 10 proc usage {} { 11 puts " 12 Usage: 13 $::SP(progname) \[Options\] name1 \[name2 ...\] & 14 15 Options: 16 --help (this text) 17 --title title_string (window title, default: $::SP(progname)) 18 19 Note: LinuxCNC (or a standalone Hal application) must be running 20 A named item can specify a pin, param, or signal 21 The item must be writable, e.g.: 22 pin: IN or I/O (and not connected to a signal with a writer) 23 param: RW 24 signal: connected to a writable pin 25 26 Hal item types bit,s32,u32,float are supported 27 28 When a bit item is specifed, a pushbutton is created 29 to manage the item in one of three manners specified 30 by radio buttons: 31 toggle: Toggle value when button pressed 32 pulse: Pulse item to 1 once when button pressed 33 hold: Set to 1 while button pressed 34 The bit pushbutton mode can be specifed on the command 35 line by formatting the item name: 36 namei/mode=\[toggle | pulse | hold\] 37 If the bit item mode begins with an uppercase letter, 38 the radio buttons for selecting other modes are not shown 39 " 40 exit 1 41 } ;# usage 42 43 proc add_item_to_gui {id itemname} { 44 set l [split $itemname /] 45 set itemname [lindex $l 0] 46 set itemargs [lindex $l 1] 47 set ::SP($id,onemode) 0 48 if { [string first "mode=" "$itemargs"] == 0} { 49 set themode [lindex [split $itemargs =] 1] 50 set firstchar [string range "$themode" 0 0] 51 if {[string first "$firstchar" "PTH"] >= 0} { 52 set ::SP($id,onemode) 1 53 } 54 set ::SP($id,mode) [string tolower $themode] 55 } else { 56 set ::SP($id,mode) "default" 57 } 58 59 set ::SP($id,itemname) $itemname 60 if ![item_info $itemname $id] { 61 puts "$::SP(message)" 62 return 0 63 } else { 64 puts "$::SP(message)" 65 } 66 67 if { ![info exists ::SP(vframe)] \ 68 || ($::SP(vframe,ct) >= $::SP(vframe,vct)) } { 69 set ::SP(vframe,ct) 0 70 incr ::SP(vframe,column) 71 set ::SP(vframe) [frame .vf-$::SP(vframe,column)] 72 pack $::SP(vframe) -side left -fill both -expand 1 73 } 74 incr ::SP(vframe,ct) 75 76 set vf $::SP(vframe) 77 set f [frame ${vf}.f$id -borderwidth 3 -relief ridge] 78 pack [label $f.hdr -bg lightgray -fg blue \ 79 -borderwidth 0 -relief raised \ 80 -text "$::SP($id,itemname)"] \ 81 -fill x -expand 1 82 83 switch $::SP($id,itemtype) { 84 bit {add_bit_item_to_gui $f $id} 85 s32 - 86 u32 {add_number_item_to_gui $f $id 1} 87 float {add_number_item_to_gui $f $id 0} 88 default {return -code error \ 89 "add_item_to_gui: unexpected itemtype <$::SP($id,itemtype)>" 90 } 91 } 92 return 1 93 } ;# add_item_to_gui 94 95 proc add_bit_item_to_gui {f id} { 96 switch -nocase $::SP($id,mode) { 97 pulse - 98 hold - 99 toggle {} 100 default { 101 if {"$::SP($id,mode)" != "default"} { 102 puts "$::SP($id,itemname): unknown </mode=$::SP($id,mode)>,\ 103 using /mode=$::SP(bit,mode,default)" 104 } 105 set ::SP($id,mode) $::SP(bit,mode,default) 106 } 107 } 108 set value [get_item $id] 109 set color lightgray 110 if $value {set color magenta} 111 pack [label $f.b \ 112 -text "$::SP($::SP($id,mode),text)" \ 113 -borderwidth 4 -relief raised ] \ 114 -fill x -expand 1 115 set ::SP($id,button) $f.b 116 bind $::SP($id,button) <ButtonRelease-1> [list b_release $id] 117 bind $::SP($id,button) <ButtonPress-1> [list b_press $id] 118 119 set ::SP($id,ivalue) "$value" 120 pack [label $f.l -bg $color -fg black \ 121 -text "$::SP(iprefix)$::SP($id,ivalue) $::SP(prefix)$value"] \ 122 -fill x -expand 1 123 set ::SP($id,label) $f.l 124 125 if {!$::SP($id,onemode)} { 126 pack [radiobutton $f.p -text OnePulse \ 127 -anchor w \ 128 -value "pulse" \ 129 -command [list bit_mode $id] \ 130 -variable ::SP($id,mode)] \ 131 -fill x -expand 0 132 pack [radiobutton $f.t -text ToggleValue \ 133 -anchor w \ 134 -value "toggle" \ 135 -command [list bit_mode $id] \ 136 -variable ::SP($id,mode)] \ 137 -fill x -expand 0 138 pack [radiobutton $f.h -text "1 WhilePressed" \ 139 -anchor w \ 140 -value "hold" \ 141 -command [list bit_mode $id] \ 142 -variable ::SP($id,mode)] \ 143 -fill x -expand 0 144 } 145 pack $f -side top -fill x -expand 0 146 } ;# add_bit_item_to_gui 147 148 proc add_number_item_to_gui {f id enable_plusminus} { 149 set value [get_item $id] 150 set color lightgray 151 pack [frame $f.one] -fill x -expand 1 152 pack [button $f.one.b -bg $color -fg black \ 153 -text "Set " \ 154 -relief raised -bd 3 \ 155 -command [list b_press $id] ]\ 156 -side left -fill x -expand 1 157 158 if $enable_plusminus { 159 pack [button $f.one.m -bg $color -fg black \ 160 -text "-" \ 161 -relief raised -bd 3 \ 162 -command [list minus_number_item $id] ]\ 163 -side left -fill x -expand 1 164 165 pack [button $f.one.p -bg $color -fg black \ 166 -text "+" \ 167 -relief raised -bd 3 \ 168 -command [list plus_number_item $id] ]\ 169 -side left -fill x -expand 1 170 } 171 172 pack [button $f.one.r -bg $color -fg black \ 173 -text "Reset" \ 174 -relief raised -bd 3 \ 175 -command [list reset_number_item $id] ]\ 176 -side left -fill x -expand 1 177 set e [entry $f.e \ 178 -justify right \ 179 -textvariable ::SP($id,entry)] 180 pack $e -fill x -expand 0 181 bind $e <Return> [list b_press $id] 182 183 set ::SP($id,ivalue) "$value" 184 pack [label $f.l -bg $color -fg black \ 185 -anchor w \ 186 -text "$::SP(iprefix)$::SP($id,ivalue) $::SP(prefix)$value"] \ 187 -fill x -expand 1 188 set ::SP($id,label) $f.l 189 if {$::SP($id,itemtype) == "u32"} { 190 pack [label $f.hexl -bg $color -fg black \ 191 -anchor w \ 192 -text "$::SP(iprefix)[format %#X $::SP($id,ivalue)] \ 193 $::SP(prefix)[format %#X $value]"] \ 194 -fill x -expand 1 195 set ::SP($id,hexlabel) $f.hexl 196 } 197 pack $f -side top -fill x -expand 0 198 } ;# add_number_item_to_gui 199 200 proc exact_name {name line} { 201 set idx [string first $name $line] 202 if {$idx < 0} {return 0} 203 if {0 == [string compare $name [string range $line $idx end]]} { 204 return 1 205 } 206 return 0 207 } ;# exact_name 208 209 proc connected_to {name line} { 210 # check if an input pin is already connected to a signal 211 # since it does not necessarily have a writer 212 set idx [string first $name $line] 213 if {$idx < 0} {return ""} 214 # check if pin is an input 215 if {-1 != [string first "$name <==" [string range $line $idx end]]} { 216 set idx [string first "<==" $line] 217 set signame [string range $line [expr 4 + $idx] end] 218 return "$signame" 219 } 220 return "" 221 } ;# connected_to 222 223 proc item_info {itemname id} { 224 set fmt "sim_pin: %-30s %5s %3s %s" 225 set theitem "-----" 226 set dir "---" 227 set found 0 228 229 # try pin: 230 set answer [hal show pin "$itemname"] 231 set lines [split $answer \n] 232 set lines [lreplace $lines 0 1] ;# discard header lines 233 # look for exact match (hal show will present all matching leading part) 234 foreach line $lines { 235 if {"$line" == ""} continue 236 if [exact_name $itemname $line] { 237 set found 1 238 set theitem "PIN" 239 break 240 } 241 set signame [connected_to $itemname $line] 242 if {"" != "$signame"} { 243 puts "pin <$itemname> is already connected, trying signal:<$signame>" 244 set itemname $signame 245 set ::SP($id,itemname) $itemname 246 } 247 } 248 if !$found { 249 # try param: 250 set answer [hal show param "$itemname"] 251 set lines [split $answer \n] 252 set lines [lreplace $lines 0 1] ;# discard header lines 253 # look for exact match (hal show will present all matching leading part) 254 foreach line $lines { 255 if {"$line" == ""} continue 256 if [exact_name $itemname $line] { 257 set found 1 258 set theitem "PARAM" 259 break 260 } 261 } 262 } 263 if !$found { 264 # try signal: 265 set answer [hal show signal "$itemname"] 266 set lines [split $answer \n] 267 set lines [lreplace $lines 0 1] ;# discard header lines 268 # look for exact match (hal show will present all matching leading part) 269 foreach line $lines { 270 if {"$line" == ""} continue 271 if [exact_name $itemname $line] { 272 set found 1 273 scan $line "%s %s" sigtype other 274 switch $sigtype { 275 bit - 276 u32 - 277 s32 - 278 float {set theitem SIG} 279 default { 280 set ::SP(message) \ 281 "Unknown type for signal item <$id $::SP($id,itemname) $sigtype>" 282 return 0 283 } 284 } 285 break 286 } 287 } 288 } 289 if !$found { 290 set ::SP(message) "Unknown item: $::SP($id,itemname)" 291 return 0 292 } 293 switch $theitem { 294 PIN - 295 PARAM { 296 scan $line "%d %s %s %s %s %s %s" owner type dir value name arrows signalname 297 if { ("$dir" == "IN") || ("$dir" == "I/O") || "$dir" == "RW"} { 298 if [info exists arrows] { 299 set ::SP(message) [format $fmt \ 300 $itemname $theitem $dir "not writable (connected to signal)"] 301 return 0 302 } else { 303 #puts "OK <$dir> $line" 304 } 305 } else { 306 set ::SP(message) [format $fmt \ 307 $itemname $theitem $dir "not writable"] 308 return 0 309 } 310 } 311 SIG { 312 set sig_header_ct 0 313 foreach line $lines { 314 if { ([string first "<==" $line] < 0) \ 315 && ([string first "==>" $line] < 0) \ 316 } { 317 incr sig_header_ct 318 } 319 if {[string first "<==" $line] >= 0} { 320 set has_writer 1 321 } 322 } 323 if {$sig_header_ct > 4} { 324 # wild cards not supported: 325 set ::SP(message) "Unknown item: $::SP($id,itemname)" 326 return 0 327 } 328 if [info exists has_writer] { 329 set ::SP(message) [format $fmt \ 330 $itemname $theitem $dir "signal has writer"] 331 return 0 332 } else { 333 set theitem "SIG" 334 set is_signal 1 335 } 336 } 337 } 338 339 if [info exists is_signal] { 340 set ::SP($id,itemtype) $sigtype 341 set ::SP($id,set_cmd) sets 342 set ::SP($id,get_cmd) gets 343 } else { 344 set ::SP($id,itemtype) [hal ptype $itemname] 345 set ::SP($id,set_cmd) setp 346 set ::SP($id,get_cmd) getp 347 } 348 set ::SP(message) [format $fmt $itemname $theitem $dir ""] 349 return 1 ;# ok 350 } ;# item_info 351 352 proc bit_mode {id} { 353 switch -nocase $::SP($id,mode) { 354 pulse {$::SP($id,button) config -text Pulse} 355 hold {$::SP($id,button) config -text "1 while pressed"} 356 toggle - 357 default {$::SP($id,button) config -text Toggle} 358 } 359 } ;# bit_mode 360 361 proc item_set {id {new_value 0}} { 362 if [catch { 363 switch $::SP($id,itemtype) { 364 bit {hal $::SP($id,set_cmd) $::SP($id,itemname) 1} 365 s32 - 366 u32 - 367 float {hal $::SP($id,set_cmd) $::SP($id,itemname) $new_value} 368 } 369 } msg ] { 370 popup $msg 371 return 372 } 373 item_show $id 374 } ;# item_set 375 376 proc item_unset {id} { 377 if [catch {hal $::SP($id,set_cmd) $::SP($id,itemname) 0} msg] { 378 popup $msg 379 } 380 set value [get_item $id] 381 set color lightgray 382 if $value {set color magenta} 383 $::SP($id,label) configure -bg $color -fg black \ 384 -text "$::SP(iprefix)$::SP($id,ivalue) $::SP(prefix)$value" 385 } ;# item_unset 386 387 proc item_show {id} { 388 set value [get_item $id] 389 set color lightgray 390 if {$value != $::SP($id,ivalue)} {set color magenta} 391 switch $::SP($id,itemtype) { 392 bit { 393 $::SP($id,label) configure -bg $color \ 394 -text "$::SP(iprefix)$::SP($id,ivalue) $::SP(prefix)$value" 395 } 396 s32 - \ 397 u32 - \ 398 float {$::SP($id,label) configure -bg $color -fg black \ 399 -text "$::SP(iprefix)$::SP($id,ivalue) $::SP(prefix)$value" 400 } 401 } 402 if {$::SP($id,itemtype) == "u32"} { 403 $::SP($id,hexlabel) configure -bg $color -fg black \ 404 -text "$::SP(iprefix)[format %#X $::SP($id,ivalue)] \ 405 $::SP(prefix)[format %#X $value]" 406 } 407 } ;# item_show 408 409 proc b_press {id} { 410 set value [get_item $id] 411 switch $::SP($id,itemtype) { 412 bit {switch -nocase $::SP($id,mode) { 413 "hold" {item_set $id} 414 "toggle" { if $value { 415 item_unset $id 416 } else { 417 item_set $id 418 } 419 } 420 "pulse" {item_set $id; after $::SP(pulse,ms) [list b_release $id]} 421 } 422 } 423 s32 - \ 424 u32 - \ 425 float { 426 set e $::SP($id,entry) 427 if ![isnumber $e] { 428 if [catch {set e [expr $::SP($id,entry)]} msg] { 429 popup "Invalid Expression (<$e>)" 430 set ::SP($id,entry) "" 431 return 432 } else { 433 switch $e { 434 Inf - NaN { 435 popup "Bad expr result: <$e>" 436 set ::SP($id,entry) "" 437 return 438 } 439 } 440 } 441 } 442 443 # Note: halcmd rejects numbers formatted 'nEmm' for s32, u32 444 445 if { (($::SP($id,itemtype) == "s32") || ($::SP($id,itemtype) == "u32")) \ 446 && ![isinteger $e]} { 447 popup "Integer required for u32,s32 entry (not <$e>)" 448 return 449 } 450 if { ($::SP($id,itemtype) == "u32") \ 451 && [isnegative $e]} { 452 popup "Nonnegative Integer required for u32 entry (not <$e>)" 453 return 454 } 455 item_set $id $e 456 } 457 default {return -code error \ 458 "b_press: unknown pin type <$::SP($id,itemtype)> for $::SP($id,itemname)" 459 } 460 } 461 } ;# b_press 462 463 proc b_release {id} { 464 switch -nocase $::SP($id,mode) { 465 "hold" {item_unset $id} 466 "toggle" {} 467 "pulse" {item_unset $id} 468 } 469 } ;# b_release 470 471 proc reset_number_item {id} { 472 item_set $id $::SP($id,ivalue) 473 } ;# reset_number_item 474 475 proc plus_number_item {id} { 476 item_set $id [expr 1 + [get_item $id]] 477 } ;# plus_number_item 478 479 proc minus_number_item {id} { 480 item_set $id [expr -1 + [get_item $id]] 481 } ;# minus_number_item 482 483 proc get_item {id} { 484 set value [hal $::SP($id,get_cmd) $::SP($id,itemname)] 485 switch $::SP($id,itemtype) { 486 bit { 487 switch $value { 488 FALSE {return 0} 489 TRUE {return 1} 490 } 491 } 492 s32 - 493 u32 - 494 float {return $value} 495 default {return -code error \ 496 "get_item: unknown item type <$::SP($id,itemtype)> for $::SP($id,itemname)" 497 } 498 } 499 } ;# get_item 500 501 proc update_current_values {} { 502 for {set id 0} {$id < $::SP(id)} {incr id} { 503 item_show $id 504 } 505 after $::SP(update,ms) update_current_values 506 } ;# update_current_values 507 508 proc isinteger {v} { 509 if ![isnumber $v] {return 0} 510 if {[string first . $v] >=0} {return 0} 511 if {[string first e [string tolower $v]] >= 0} {return 0} 512 return 1 513 } ;# isinteger 514 515 proc isnumber {v} { 516 if [catch {format %f $v}] { 517 return 0 518 } else { 519 return 1 520 } 521 } ;# isnumber 522 523 proc isnegative {v} { 524 # Note:check with isnumber before this 525 if {[format %f $v] < 0} {return 1} 526 return 0 527 } ;# isnegative 528 529 proc popup msg { 530 tk_messageBox \ 531 -type ok \ 532 -title "$::SP(progname): Problem" \ 533 -message $msg 534 } ;# popup 535 536 if [catch { 537 if {[info exists ::argv0] && [info script] == $::argv0} { 538 set ::SP(progname) [file tail $::argv0] 539 set ::SP(update,ms) 300 540 if {$::argv == ""} {usage} 541 542 set ::SP(bit,mode,default) toggle 543 # button text for bit item modes: 544 set ::SP(pulse,text) "Pulse" 545 set ::SP(hold,text) "1 while Pressed" 546 set ::SP(toggle,text) "Toggle" 547 548 set ::SP(id) 0 549 set ::SP(vframe,column) 0 550 set ::SP(vframe,vct) 4 ;# howmany items in a column 551 set ::SP(iprefix) "Initial=" ;# initial value prefix 552 set ::SP(prefix) "Current=" ;# current value prefix 553 set ::SP(pulse,ms) 200 ;# pulse duration 554 set ::SP(title) $::SP(progname) 555 556 set currentarg [lindex $::argv 0] 557 while {[string first "-" $currentarg] == 0} { 558 switch -- $currentarg { 559 --help {usage} 560 --title {set ::SP(title) [lindex $::argv 1] 561 set ::argv [lreplace $::argv 0 0] 562 } 563 } 564 set ::argv [lreplace $::argv 0 0] 565 set currentarg [lindex $::argv 0] 566 } 567 568 foreach itemname $::argv { 569 if [add_item_to_gui $::SP(id) $itemname] { 570 incr ::SP(id) 571 } 572 } 573 574 wm title . $::SP(title) 575 if {$::SP(id) < 1} usage 576 update_current_values 577 } 578 } msg] { 579 puts "\nError: $msg" 580 usage 581 }