moveoff_gui
1 #!/usr/bin/tclsh 2 3 # library procs 4 # Note: use linuxcnc_var script since this program can be 5 # started without using the linuxcnc script and 6 # ::env(HALLIB_DIR) will not exist 7 set hallib_dir [exec linuxcnc_var HALLIB_DIR] 8 source [file join $hallib_dir hal_procs_lib.tcl] 9 source [file join $hallib_dir util_lib.tcl] 10 11 # A gui to demonstrate the use of the moveoff component for 12 # applying Hal-only offsets. 13 14 # For more info: 15 # $ moveoff_gui --help -- command line options 16 # $ man moveoff_gui -- additional info 17 # $ man moveoff -- about the moveoff component 18 19 #----------------------------------------------------------------------- 20 # Copyright: 2014 21 # Authors: Dewey Garrett <dgarrett@panix.com> 22 # 23 # This program is free software; you can redistribute it and/or modify 24 # it under the terms of the GNU General Public License as published by 25 # the Free Software Foundation; either version 2 of the License, or 26 # (at your option) any later version. 27 # 28 # This program is distributed in the hope that it will be useful, 29 # but WITHOUT ANY WARRANTY; without even the implied warranty of 30 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 31 # GNU General Public License for more details. 32 # 33 # You should have received a copy of the GNU General Public License 34 # along with this program; if not, write to the Free Software 35 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 36 #----------------------------------------------------------------------- 37 proc wmposition {top} { 38 set geo [wm geometry $top] 39 return [string range $geo [string first + $geo] end] 40 } ;# wmposition 41 42 proc wmrestore {w position} { 43 if {[wm state $w] == "withdrawn"} { 44 wm deiconify $w 45 wm geometry $w $position 46 } 47 } ;# wmrestore 48 49 proc wmcenter w { 50 wm withdraw $w 51 update idletasks 52 set x [expr [winfo screenwidth $w]/2 \ 53 - [winfo reqwidth $w]/2 - [winfo vrootx [winfo parent $w]]] 54 set y [expr [winfo screenheight $w]/2 \ 55 - [winfo reqheight $w]/2 - [winfo vrooty [winfo parent $w]]] 56 wm geom $w +$x+$y 57 wm deiconify $w 58 } ;# wmcenter 59 60 proc withdraw_with_save_loc {top} { 61 set ::MV(location) [wmposition $top] 62 wm withdraw $top 63 } ;# withdraw_with_save_loc 64 65 proc restore_using_save_loc {top} { 66 wmrestore $top $::MV(location) 67 } ;# restore_using_save_loc $::MV(top) 68 69 proc qid {} { 70 # unique identifier 71 if ![info exists ::MV(qid)] { set ::MV(qid) 0 } 72 return [incr ::MV(qid)] 73 } ;# qid 74 75 proc get_move_enable {} { 76 # special case boolean, used for setting 77 # ::MV(enable,offsets) which is the -variable 78 # for the Enable checkbutton and may be 79 # managed externally 80 # ensure it is 1|0 for comparisons always 81 if {[hal getp $::m.move-enable]} { 82 return 1 83 } else { 84 return 0 85 } 86 } ;# get_move_enable 87 88 proc do_poll {} { 89 set ::MV(enable,offsets) [get_move_enable] 90 set apply_offsets [hal getp $::m.apply-offsets] 91 set offset_applied [hal getp $::m.offset-applied] 92 set at_limit [hal getp $::m.waypoint-limit] 93 94 if {$apply_offsets != $::MV(old,apply_offsets)} { 95 if {$apply_offsets} { 96 if !$::MV(no_display) {restore_using_save_loc $::MV(top)} 97 if { $::MV(control_move_enable) \ 98 && $::MV(auto_enable_apply_offsets) \ 99 } { 100 set ::MV(enable,offsets) 1; hal setp $::m.move-enable 1 101 } 102 } else { 103 # apply-offsets deasserted ==> moveoff component will remove offsets 104 zero_all_offset_inputs 105 withdraw_with_save_loc $::MV(top) 106 } 107 } 108 109 if {$::MV(enable,offsets) != $::MV(old,enable,offsets)} { 110 foreach aname $::MV(axes) { 111 if $::MV(enable,offsets) { 112 $::MV(button,apply,$aname) configure -state normal 113 } else { 114 $::MV(button,apply,$aname) configure -state disabled 115 } 116 } 117 if { !$::MV(enable,offsets) \ 118 && !$::MV(entry,keep_on_disable)} { 119 foreach letter {x y z a b c u v w} { 120 set ::MV(offset,$letter) [format "$::MV(offset,format)" 0] 121 } 122 } 123 } 124 125 set status_msg "" 126 if {$at_limit} { 127 set status_msg "Waypoint limit (Disable required)"; set bg orange 128 } else { 129 if $offset_applied { 130 if $::MV(enable,offsets) { 131 set status_msg "OFFSETS ACTIVE"; set bg red 132 $::MV(button,enable) conf -state normal 133 } else { 134 set status_msg "Removing offsets"; set bg yellow 135 $::MV(button,enable) conf -state disabled 136 } 137 } else { 138 if $::MV(enable,offsets) { 139 set status_msg "Offsets Enabled" 140 set bg cyan 141 $::MV(button,enable) conf -state normal 142 } else { 143 set status_msg "Offsets Disabled"; set bg green 144 $::MV(button,enable) conf -state normal 145 } 146 } 147 } 148 149 # move_enable deasserted while apply_offsets true 150 # Note: apply_offsets included in case external connection 151 # deasserts it 152 if { ($::MV(enable,offsets) != $::MV(old,enable,offsets)) \ 153 && !$::MV(enable,offsets) \ 154 && $::MV(opt,resume_withdelay) \ 155 && ($::MV(old,enable,offsets) != -1) \ 156 && $apply_offsets \ 157 } { 158 # move_enable deasserted ==> moveoff component will remove offsets 159 after 0 request_resume_after_delay 160 } 161 162 if { ![hal getp motion.motion-enabled]} { 163 set bg white 164 set status_msg "${status_msg} --- Motion Off" 165 if { $::MV(control_move_enable) } { 166 set ::MV(enable,offsets) 0; hal setp $::m.move-enable 0 167 $::MV(button,enable) conf -state disabled 168 zero_all_offset_inputs 169 } 170 } 171 172 if {"$status_msg" != $::MV(old,status_msg)} { 173 set ::MV(label,applied,text) $status_msg 174 $::MV(label,applied) configure -state normal -bg $bg 175 if { !$::MV(opt,no_resume_inhibit) } { 176 if $offset_applied { 177 disallow_resume 178 } else { 179 allow_resume 180 } 181 } 182 } 183 184 foreach aname $::MV(axes) { 185 set jnum $::MV($aname,jnum) 186 set ::MV(current,$aname) [format "$::MV(current,format)" \ 187 [hal getp $::m.offset-current-${jnum}]] 188 } 189 190 set waypoint_pct [hal getp $::m.waypoint-percent-used] 191 set waypoint_msg "Waypoint Usage: ${waypoint_pct} %" 192 set ::MV(label,message,text) "$waypoint_msg" 193 194 if {"$status_msg" != $::MV(old,waypoint_msg)} { 195 if {$waypoint_pct >= $::MV(waypoint,threshold,low)} { 196 pack $::MV(label,message,frame) -expand 1 -fill x 197 if {$waypoint_pct > $::MV(waypoint,threshold,high)} { 198 $::MV(label,message) conf -bg red 199 } else { 200 $::MV(label,message) conf -bg "#d9d9d9" 201 } 202 } else { 203 $::MV(label,message) conf -bg "#d9d9d9" 204 pack forget $::MV(label,message,frame) 205 } 206 } 207 208 set ::MV(old,apply_offsets) $apply_offsets 209 set ::MV(old,enable,offsets) $::MV(enable,offsets) 210 set ::MV(old,status_msg) $status_msg 211 set ::MV(old,waypoint_msg) $waypoint_msg 212 213 after $::MV(poll,ms) do_poll 214 } ;# do_poll 215 216 proc request_resume_after_delay {} { 217 if [get_move_enable] { 218 return ;# could get canceled by another writer 219 } 220 set offset_applied [hal getp $::m.offset-applied] 221 if { !$offset_applied} { 222 resume_after_delay 223 } else { 224 #reschedule 225 after $::MV(resume,delay,sample,ms) request_resume_after_delay 226 } 227 } ;# request_resume_after_delay 228 229 proc resume_after_delay {} { 230 withdraw_with_save_loc $::MV(top) 231 set dly [format %.1f $::MV(resume,delay,secs)] 232 set ::MV(resume,msg) "Auto Resume in $dly secs" 233 234 set t [toplevel .resuming] 235 set ::MV(resume,widget) $t 236 wm title $t "$::MV(prog) Auto Resume" 237 set msg_fsize $::MV(font,size) 238 pack [label $t.l -textvar ::MV(resume,msg) \ 239 -font [list Helvetica $msg_fsize bold] \ 240 ] -side top -fill both 241 set cancel_fsize [expr $::MV(font,size) + 8] 242 if !$::MV(opt,no_cancel_autoresume) { 243 pack [button $t.b -text "Cancel Auto Resume" -bd 5 \ 244 -font [list Helvetica $cancel_fsize bold] \ 245 -command cancel_auto_resume \ 246 ] -expand 1 -fill both 247 } 248 if $::MV(no_display) { 249 # use window manager placement for auto resume cancel widget 250 } else { 251 # use the same geometry as the toplevel for the popup: 252 wm geometry $t [wm geometry $::MV(top)] 253 } 254 255 set ::MV(resume,delay,remaining,ms) [expr 1000 *$::MV(resume,delay,secs)] 256 after $::MV(resume,delay,sample,ms) pulse_resume_wait 257 } ;# resume_after_delay 258 259 proc pulse_resume_wait {} { 260 set dly_ms $::MV(resume,delay,remaining,ms) 261 if { ![hal getp halui.program.is-paused] } { 262 # some other actor resumed 263 after $::MV(resume,pulse,ms) clear_resume 264 return 265 } 266 if {$dly_ms <= 0} { 267 hal setp halui.program.resume 1 268 after $::MV(resume,pulse,ms) clear_resume 269 destroy $::MV(resume,widget) 270 } else { 271 set dly_secs [format %.1f [expr $dly_ms/1000.]] 272 set ::MV(resume,msg) "Auto resume in $dly_secs secs" 273 set ::MV(resume,delay,remaining,ms) [expr $dly_ms \ 274 - $::MV(resume,delay,sample,ms)] 275 set ::MV(resume,cancel,id) \ 276 [after $::MV(resume,delay,sample,ms) pulse_resume_wait] 277 } 278 } ;# pulse_resume 279 280 proc cancel_auto_resume {} { 281 catch {after cancel $::MV(resume,cancel,id)} 282 clear_resume 283 if !$::MV(no_display) {restore_using_save_loc $::MV(top)} 284 # no competing app connected to $::m.move-enable 285 if { $::MV(control_move_enable) } { 286 set ::MV(enable,offsets) 1; hal setp $::m.move-enable 1 287 zero_all_offset_inputs 288 } 289 } ;# cancel_auto_resume 290 291 proc clear_resume {} { 292 hal setp halui.program.resume 0 293 destroy $::MV(resume,widget) 294 } ;# pulse_resume 295 296 proc do_offset {aname} { 297 if { ![hal getp motion.motion-enabled] } {return} 298 set jnum $::MV($aname,jnum) 299 hal setp $::m.offset-in-${jnum} $::MV(offset,$aname) 300 set ::MV(offset,$aname) [format "$::MV(offset,format)" \ 301 $::MV(offset,$aname)] 302 } ;# do_offset 303 304 proc bump_offset {aname value} { 305 if { ![hal getp motion.motion-enabled] } {return} 306 set jnum $::MV($aname,jnum) 307 switch $value { 308 plus {set ::MV(offset,$aname) [format "$::MV(offset,format)" \ 309 [expr $::MV(offset,$aname) + $::MV(increment)]] 310 } 311 zero {set ::MV(offset,$aname) 0 312 } 313 minus {set ::MV(offset,$aname) [format "$::MV(offset,format)" \ 314 [expr $::MV(offset,$aname) - $::MV(increment)]] 315 } 316 } 317 hal setp $::m.offset-in-${jnum} $::MV(offset,$aname) 318 } ;# bump_offset 319 320 proc toggle_enable_backtrack {args} { 321 if {$::MV(enable,backtrack)} { 322 hal setp $::m.backtrack-enable 1 323 } else { 324 hal setp $::m.backtrack-enable 0 325 } 326 } ;# toggle_enable_backtrack 327 328 proc toggle_enable_offsets {args} { 329 if {$::MV(enable,offsets)} { 330 hal setp $::m.move-enable 1 331 } else { 332 hal setp $::m.move-enable 0 333 } 334 zero_all_offset_inputs 335 } ;# toggle_enable_offsets 336 337 proc zero_all_offset_inputs {} { 338 if {! $::MV(control_move_enable)} { return } 339 foreach aname $::MV(axes) { 340 set ::MV(offset,$aname) [format "$::MV(offset,format)" 0] 341 set jnum $::MV($aname,jnum) 342 hal setp $::m.offset-in-${jnum} 0.0 343 } 344 } ;# zero_all_offset_inputs 345 346 proc make_gui {} { 347 set t $::MV(top) 348 wm withdraw $::MV(top) 349 350 set f1 [frame $t.[qid] -relief groove -bd 4] 351 pack $f1 -fill x -expand 1 -side top 352 set ::MV(enable,offsets) [get_move_enable] 353 set ::MV(button,enable) noop ;# anticipate possible external control 354 if $::MV(control_move_enable) { 355 set f1a [frame $f1.[qid] -relief ridge -bd 2] 356 pack $f1a -fill x -expand 1 -side top 357 set ::MV(button,enable) [checkbutton $f1a.[qid] \ 358 -text "Enable Offsets" \ 359 -anchor w \ 360 -variable ::MV(enable,offsets) \ 361 -command toggle_enable_offsets] 362 pack $::MV(button,enable) -side left -fill x -expand 1 -anchor w 363 364 if {[llength $::MV(axes)] > 1} { 365 set ::MV(enable,backtrack) 1 366 set ::MV(button,backtrack) [checkbutton $f1a.[qid] \ 367 -text "Backtrack" \ 368 -anchor e \ 369 -variable ::MV(enable,backtrack) \ 370 -command toggle_enable_backtrack] 371 pack $::MV(button,backtrack) -side left -fill x -expand 1 -anchor w 372 } else { 373 set ::MV(enable,backtrack) 0 ;# no backtrack for single axis 374 } 375 hal setp $::m.backtrack-enable $::MV(enable,backtrack) 376 377 pack [label $f1.[qid] -text Increment:] -side left 378 set ::MV(increment) [lindex $::MV(increments) 0] ;# default 379 foreach inc $::MV(increments) { 380 pack [radiobutton $f1.[qid] -variable ::MV(increment) \ 381 -text $inc -value $inc \ 382 ] -side left 383 } 384 } 385 386 foreach aname $::MV(axes) { 387 set jnum $::MV($aname,jnum) 388 set f2 [frame $t.[qid]] 389 390 pack $f2 -fill x -expand 1 391 set ::MV(button,apply,$aname) noop 392 set ::MV(entry,offset,$aname) noop 393 394 if $::MV(show,entry) { 395 set ::MV(button,apply,$aname) [button $f2.[qid] -bd 2 -padx 2 -pady 2\ 396 -text "$aname Offset" \ 397 -command [list do_offset $aname]] 398 pack $::MV(button,apply,$aname) -side left -anchor w 399 set ::MV(entry,offset,$aname) [entry $f2.[qid] \ 400 -width 10 \ 401 -textvariable ::MV(offset,$aname) \ 402 -justify right \ 403 ] 404 pack $::MV(entry,offset,$aname) -side left -anchor w -fill x 405 bind $::MV(entry,offset,$aname) <Return> [list do_offset $aname] 406 } 407 if $::MV(show,increments) { 408 set ::MV(bump,minus,$aname) [button $f2.[qid] -bd 2 \ 409 -width $::MV(button,increment,width) \ 410 -text "-" \ 411 -command [list bump_offset $aname minus]] 412 pack $::MV(bump,minus,$aname) -side left 413 414 set ::MV(bump,zero,$aname) [button $f2.[qid] -bd 2 \ 415 -width $::MV(button,increment,width) \ 416 -text "0" \ 417 -command [list bump_offset $aname zero]] 418 pack $::MV(bump,zero,$aname) -side left 419 420 set ::MV(bump,plus,$aname) [button $f2.[qid] -bd 2 \ 421 -width $::MV(button,increment,width) \ 422 -text "+" \ 423 -command [list bump_offset $aname plus]] 424 pack $::MV(bump,plus,$aname) -side left 425 } 426 if !$::MV(show,entry) { 427 set Aname [string toupper $aname] 428 pack [label $f2.[qid] -text "Current $Aname Offset:"] -side left 429 } 430 set ::MV(label,current,$aname) [label $f2.[qid] \ 431 -width 10 -bd 0 \ 432 -fg red -bg black\ 433 -textvariable ::MV(current,$aname) \ 434 -justify right \ 435 ] 436 pack $::MV(label,current,$aname) -side left -anchor w -fill x -expand 1 437 } 438 439 set f3 [frame $t.[qid] -relief sunken -bd 4] 440 pack $f3 -fill x -expand 1 441 set ::MV(label,applied,text) "" 442 set ::MV(label,applied) [label $f3.l \ 443 -width 30 \ 444 -anchor w \ 445 -state normal \ 446 -textvariable ::MV(label,applied,text) ] 447 pack $::MV(label,applied) -side left -fill x -expand 1 448 449 set f4 [frame $t.[qid] -relief sunken -bd 4] 450 pack $f4 -fill x -expand 1 451 set ::MV(label,message,frame) $f4 452 pack forget $::MV(label,message,frame) 453 set ::MV(label,message,text) "Remove offsets before resuming" 454 set ::MV(label,message) [label $f4.l \ 455 -width 30 \ 456 -state normal \ 457 -textvariable ::MV(label,message,text) ] 458 pack $::MV(label,message) -side left -fill x -expand 1 459 if {$::MV(location) == "center"} { 460 set ::MV(location) [wmcenter $::MV(top)] 461 } 462 wm resizable $t 0 0 463 } ;# make_gui 464 465 proc noop {args} { 466 } ;# noop 467 468 proc bye {} { 469 if 0 { 470 set offset_applied [hal getp $::m.offset-applied] 471 if $offset_applied { 472 puts "$::MV(prog):Disallow window delete while offset applied" 473 return 474 } 475 set txt "Are you Sure?\n 476 You probaly should resume in the main GUI" 477 set ans [tk_messageBox -type okcancel \ 478 -title "Close $::MV(prog)" \ 479 -icon question \ 480 -message "$txt" 481 ] 482 if {"$ans" == "cancel"} return 483 destroy $::MV(top) 484 destroy . 485 return 486 } 487 puts "$::MV(prog):Disallow window delete" 488 return 489 } ;# bye 490 491 proc bitpin_exists {pattern} { 492 # return unique name iff unique bit pin matching pattern exists 493 set ans [string trim [hal list pin -tbit $pattern]] 494 if {[llength $ans] == 1} {return "$ans"} 495 return "" 496 } ;# bitpin_exists 497 498 proc connect_pin_to_sig {pinname new_signame} { 499 if {[is_connected $pinname existing_signame] != "not_connected"} { 500 set use_signame $existing_signame 501 } else { 502 set use_signame $new_signame 503 } 504 set msg "" 505 if {"$existing_signame" != ""} { 506 set msg "(attaching)" 507 } 508 puts "$::MV(prog):net $use_signame $pinname $msg" 509 hal net $use_signame $pinname 510 return "$use_signame" 511 } ;# connect_pin_to_sig 512 513 proc disallow_resume {} { 514 set resume_inhibit_pin [bitpin_exists *.resume-inhibit] 515 if {"$resume_inhibit_pin" == ""} return 516 hal setp $resume_inhibit_pin 1 517 } ;# disallow_resume 518 519 proc allow_resume {} { 520 set resume_inhibit_pin [bitpin_exists *.resume-inhibit] 521 if {"$resume_inhibit_pin" == ""} return 522 hal setp $resume_inhibit_pin 0 523 } ;# allow_resume 524 525 proc set_defaults {} { 526 # housekeeping: 527 set ::MV(control_move_enable) 1 528 set ::MV(no_display) 0 529 set ::MV(show,entry) 1 530 set ::MV(show,increments) 1 531 532 set ::m mv ;# expected name of the moveoff component 533 # (loadrt moveoff names=mv) 534 set ::MV(old,apply_offsets) -1 535 set ::MV(old,enable,offsets) -1 536 set ::MV(old,status_msg) -1 537 set ::MV(old,waypoint_msg) -1 538 set ::MV(offset,format) "%g" 539 set ::MV(current,format) $::MV(offset,format) 540 541 # defaults: 542 set ::MV(parm,axes) xyz ;# not a list,no spaces 543 set ::MV(font) {Helvetica 14 bold} 544 set ::MV(font,family) [lindex $::MV(font) 0] 545 set ::MV(font,size) [lindex $::MV(font) 1] 546 set ::MV(font,weight) [lindex $::MV(font) 2] 547 set ::MV(location) center ;# start position: center | +x+y (in pixels) 548 # example set ::MV(location) +10+10 549 # example set ::MV(location) center 550 551 foreach letter {x y z a b c u v w} { 552 set ::MV(offset,$letter) [format "$::MV(offset,format)" 0] ;# initial value 553 } 554 555 set ::MV(increments) {0.001 0.01 0.10 1.0} ;# increments for +/- buttons 556 557 set ::MV(opt,mode) onpause 558 set ::MV(opt,debug) 0 559 set ::MV(opt,resume_withdelay) 0 560 set ::MV(opt,noentry) 0 561 set ::MV(opt,no_resume_inhibit) 0 562 set ::MV(opt,no_pause_requirement) 0 563 set ::MV(opt,no_cancel_autoresume) 0 564 set ::MV(opt,no_display) 0 565 set ::MV(resume,pulse,ms) 100 566 set ::MV(resume,delay,sample,ms) 500 567 set ::MV(resume,delay,secs) 5 568 569 # defaults with no cmdline opts: 570 set ::MV(auto_enable_apply_offsets) 0 ;# for immediate enable 571 set ::MV(poll,ms) 1000 ;# polling interval 572 set ::MV(button,increment,width) 3 ;# width in chars 573 set ::MV(waypoint,threshold,low) 50 ;# percent 574 set ::MV(waypoint,threshold,high) 80 ;# percent 575 set ::MV(entry,keep_on_disable) 0 ;# default 0 is remove them 576 } ;# set_defaults 577 578 proc verify_context {} { 579 # return "" if ok, else errtxt 580 581 if !$::MV(opt,no_pause_requirement) { 582 if {"" == [bitpin_exists halui.program.is-paused]} { 583 return "linuxcnc and halui must be running\n 584 For info:\n$::MV(prog) --help | more" 585 } 586 } 587 if {"" == [bitpin_exists $::m.apply-offsets]} { 588 return "moveoff component must be loaded with name: $::m" 589 } 590 591 switch [is_connected $::m.apply-offsets sig] { 592 not_connected {} 593 is_input { return \ 594 "$::MV(prog):$::m.apply-offsets must not be connected <$sig>" 595 } 596 default {return "is_connected:$::m.apply-offsets unexpected"} 597 } 598 599 switch [is_connected $::m.move-enable sig] { 600 not_connected {puts \ 601 "$::MV(prog):$::m.move-enable not connected, Providing controls" 602 set ::MV(control_move_enable) 1 603 foreach name {apply-offsets backtrack-enable} { 604 if {[is_connected $::m.$name] != "not_connected"} { 605 return "Error: $::M.$name is already connected" 606 } 607 } 608 foreach aname $::MV(axes) { 609 set jnum $::MV($aname,jnum) 610 set pname $::m.offset-in-${jnum} 611 if {[is_connected $pname] != "not_connected"} { 612 return "Error: $pname is already connected" 613 } 614 } 615 } 616 is_input { 617 set ::MV(control_move_enable) 0 618 set msg "$::m.move-enable already connected <$sig>, no controls" 619 if $::MV(opt,no_display) { 620 set ::MV(no_display) 1 621 set msg "${msg}, no_display" 622 } 623 puts "$::MV(prog): $msg" 624 } 625 default {return "is_connected:move-enable unexpected"} 626 } 627 if { $::MV(opt,resume_withdelay) \ 628 && ([is_connected halui.program.resume] != "not_connected") } { 629 return "halui.program.resume is connected cannot use -autoresume <$sig>" 630 } 631 632 return "" 633 } ;# verify_context 634 635 proc get_parms {} { 636 # return "" or errtxt 637 while {[llength $::argv] >0} { 638 # beware wish handling of reserved cmdline arguments 639 # to use -h: use -- -h, 640 # lreplace shifts argv for no. of items for each iteration 641 set opt [lindex $::argv 0] 642 switch -- $opt { 643 -h - -? - 644 --help {usage} 645 646 -noentry {set ::MV(opt,noentry) 1 647 set ::MV(show,entry) 0 648 set ::MV(show,increments) 1 649 set ::argv [lreplace $::argv 0 0] 650 } 651 652 -axes {set ::MV(parm,axes) [lindex $::argv 1] 653 set ::argv [lreplace $::argv 0 1] 654 } 655 -inc {lappend incrlist [lindex $::argv 1] 656 set ::argv [lreplace $::argv 0 1] 657 } 658 -size {set ::MV(font) [list $::MV(font,family) \ 659 [lindex $::argv 1] $::MV(font,weight)] 660 set ::argv [lreplace $::argv 0 1] 661 } 662 -loc {set ::MV(location) [lindex $::argv 1] 663 set ::argv [lreplace $::argv 0 1] 664 } 665 666 -autoresume {set ::MV(opt,resume_withdelay) 1 667 set ::argv [lreplace $::argv 0 0] 668 } 669 -delay {set ::MV(resume,delay,secs) [lindex $::argv 1] 670 set ::argv [lreplace $::argv 0 1] 671 } 672 673 -mode {set ::MV(opt,mode) [lindex $::argv 1] 674 set ::argv [lreplace $::argv 0 1] 675 } 676 677 -no_resume_inhibit {set ::MV(opt,no_resume_inhibit) 1 678 set ::argv [lreplace $::argv 0 0] 679 } 680 -no_pause_requirement {set ::MV(opt,no_pause_requirement) 1 681 set ::argv [lreplace $::argv 0 0] 682 } 683 -no_cancel_autoresume {set ::MV(opt,no_cancel_autoresume) 1 684 set ::argv [lreplace $::argv 0 0] 685 } 686 -no_display {set ::MV(opt,no_display) 1 687 set ::argv [lreplace $::argv 0 0] 688 } 689 690 -debug {set ::MV(opt,debug) 1 691 set ::argv [lreplace $::argv 0 0] 692 } 693 694 default {usage "Unkown option <$opt>"} 695 } 696 } 697 set debug_get_parms 0 698 if {$debug_get_parms} { 699 if [info exists incrlist] {puts "incrlist=$incrlist"} 700 puts " axes=$::MV(parm,axes)" 701 puts " font=$::MV(font)" 702 puts " loc=$::MV(location)" 703 puts " resume,delay,secs=$::MV(resume,delay,secs)" 704 puts "opt,resume_withdelay=$::MV(opt,resume_withdelay)" 705 puts " opt,noentry=$::MV(opt,noentry)" 706 puts " opt,debug=$::MV(opt,debug)" 707 puts " opt,mode=$::MV(opt,mode)" 708 } 709 if [info exists ::MV(font)] { option add *Font $::MV(font) } 710 711 if [info exists ::MV(parm,axes)] { 712 set ::MV(parm,axes) [string tolower $::MV(parm,axes)] 713 set plist [split $::MV(parm,axes) ""] ;# xQyz-->{x Q y z} 714 foreach letter $plist { 715 if {[string first $letter xyzabcuvw] < 0} { 716 return "unknown axis letter <$letter>" 717 } 718 } 719 # make a list in usual order: eg from xyz to {x y z} 720 foreach letter {x y z a b c u v w} { 721 if {[string first $letter $::MV(parm,axes)] >= 0} { 722 lappend ::MV(axes) $letter 723 } 724 } 725 } 726 if {[llength $::MV(axes)] > 9} { 727 # size limit of the component 728 return "too many axes specified, limit is 9" 729 } 730 if [info exists incrlist] { 731 set ::MV(increments) [lsort -real -increasing $incrlist] 732 } 733 if {[llength $::MV(increments)] > 4} { 734 return "too many increments, limit is 4" 735 } 736 switch $::MV(opt,mode) { 737 onpause {} 738 always { if $::MV(opt,resume_withdelay) { 739 puts "$::MV(prog):Incompatible -mode always and -autoresume" 740 puts "$::MV(prog):Disabling -autoresume" 741 #return "Incompatible -mode always and -autoresume" 742 } 743 set ::MV(opt,resume_withdelay) 0 ;# force for mode -always 744 set ::MV(opt,no_resume_inhibit) 1 ;# force for mode -always 745 } 746 default {return "Unknown mode <$::MV(opt,mode)>"} 747 } 748 749 return "" ;# ok 750 } ;# get_parms 751 752 proc set_restrictions_on_widgets {} { 753 foreach aname $::MV(axes) { 754 set ans [is_connected $::m.offset-in-$::MV($aname,jnum) sig] 755 if {$ans == "is_input"} { 756 puts "$::MV(prog):$aname input is already connected <$sig>" 757 set ::MV(show,entry) 0 758 set ::MV(show,increments) 0 759 } 760 } 761 } ;# set_restrictions_on_widgets 762 763 proc cross_reference {} { 764 # return "" or errtxt 765 foreach aname $::MV(axes) { 766 set jnum [joint_number_for_axis $aname] 767 set ::MV($aname,jnum) $jnum 768 set ::MV($jnum,aname) $aname ;# cross-ref 769 if [catch {hal getp $::m.offset-current-${jnum}} msg ] { 770 return "axis:$aname index=$jnum $msg" 771 } 772 } 773 return "" ;# ok 774 } ;# cross_reference 775 776 proc error_popup {msg} { \ 777 set answer [tk_messageBox \ 778 -parent . \ 779 -icon error \ 780 -type ok \ 781 -title "$::MV(prog) Error" \ 782 -message "$msg" \ 783 ] 784 puts "$msg" 785 } ;# popup 786 #----------------------------------------------------------------------- 787 proc usage { {errtxt ""} } { 788 foreach item {resume_withdelay \ 789 noentry \ 790 no_resume_inhibit \ 791 no_pause_requirement \ 792 no_cancel_autoresume \ 793 no_display \ 794 } { 795 if $::MV(opt,$item) { 796 set default_$item inuse 797 } else { 798 set default_$item notused 799 } 800 } 801 puts stdout \ 802 " 803 Usage: 804 $::MV(prog) \[Options\] 805 806 Options: 807 \[--help | -? | -- -h \] (This text) 808 809 \[-mode \[onpause | always\]\] (default: $::MV(opt,mode)) 810 (onpause: show gui when program paused) 811 (always: show gui always) 812 813 \[-axes axisnames\] (default: $::MV(parm,axes) (no spaces)) 814 (letters from set of: x y z a b c u v w) 815 (example: -axes z) 816 (example: -axes xz) 817 (example: -axes xyz) 818 \[-inc incrementvalue\] (default: $::MV(increments) ) 819 (specify one per -inc (up to 4) ) 820 (example: -inc 0.001 -inc 0.01 -inc 0.1 ) 821 \[-size integer\] (default: $::MV(font,size) 822 (Overall gui popup size is based on font size) 823 \[-loc center|+x+y\] (default: $::MV(location)) 824 (example: -loc +10+200) 825 \[-autoresume\] (default: $default_resume_withdelay) 826 (resume program when move-enable deasserted) 827 \[-delay delay_secs\] (default: $::MV(resume,delay,secs) (resume delay)) 828 829 Options for special cases: 830 \[-noentry\] (default: $default_noentry) 831 (don\'t create entry widgets) 832 \[-no_resume_inhibit\] (default: $default_no_resume_inhibit) 833 (do not use a resume-inhibit-pin) 834 \[-no_pause_requirement\] (default: $default_no_pause_requirement) 835 (no check for halui.program.is-paused) 836 \[-no_cancel_autoresume\] (default: $default_no_cancel_autoresume) 837 (useful for retracting offsets with simple) 838 (external controls) 839 \[-no_display\] (default: $default_no_display) 840 (Use when both external controls and external) 841 (displays are in use) 842 843 Note: If the moveoff move-enable pin ($::m.move-enable) is connected when 844 $::MV(prog) is started, external controls are required and only 845 displays are provided. 846 " 847 #"vim 848 849 if $::MV(opt,debug) {parray ::MV} 850 if {"$errtxt" != ""} { 851 puts "$::MV(prog):$errtxt" 852 exit 1 853 } 854 exit 0 855 } ;# usage 856 857 #----------------------------------------------------------------------- 858 # begin 859 if ![info exists ::MV(top)] { 860 package require Tk 861 wm withdraw . 862 package require Hal 863 set ::MV(prog) [file tail $::argv0] 864 set_defaults 865 866 set errtxt [get_parms] 867 if {"$errtxt" != ""} { 868 error_popup "get_parms: $errtxt" 869 usage "$errtxt" 870 } 871 872 set errtxt [cross_reference] 873 if {"$errtxt" != ""} { 874 error_popup "cross_reference: $errtxt" 875 usage "$errtxt" 876 } 877 878 set errtxt [verify_context] 879 if {"$errtxt" != ""} { 880 error_popup "verify_context:\n$errtxt" 881 if $::MV(opt,debug) {parray ::MV} 882 exit 1 883 } else { 884 puts "$::MV(prog):verify_context: ok" 885 } 886 887 set_restrictions_on_widgets ;# conditionally disable some controls 888 889 # connect power-on (to existing signal if necessary) 890 set psigname [connect_pin_to_sig motion.motion-enabled mvoff_gui:power_on] 891 connect_pin_to_sig $::m.power-on $psigname 892 893 set titletxt "$::MV(prog) $::MV(opt,mode)" 894 if {$::MV(control_move_enable)} { 895 set titletxt "$titletxt local" 896 } else { 897 set titletxt "$titletxt external" 898 } 899 switch $::MV(opt,mode) { 900 always { hal setp $::m.apply-offsets 1 } 901 onpause { set signame [connect_pin_to_sig halui.program.is-paused \ 902 mvoff_gui:apply_offsets] 903 connect_pin_to_sig $::m.apply-offsets $signame 904 if {$::MV(opt,resume_withdelay)} { 905 set titletxt "$titletxt autoresume:on" 906 } else { 907 set titletxt "$titletxt autoresume:off" 908 } 909 } 910 default {puts "$::MV(prog):Unexpected mode: $::MV(opt,mode)"} 911 } 912 set ::MV(top) [toplevel .t] 913 wm title $::MV(top) "$titletxt" 914 wm protocol $::MV(top) WM_DELETE_WINDOW bye 915 916 make_gui 917 do_poll 918 919 if $::MV(opt,debug) {parray ::MV} 920 }