8b44ccfa6a
1) HALLIB_DIR: new directory for system-wide hal files (*.hal,*.tcl and
supporting files).
Locations:
RIP: HALLIB = lib/hallib/
DEB: HALLIB = /usr/share/linuxcnc/hallib/
2) HALLIB_PATH: search path for locating halfiles:
HALLIB_PATH = .:HALLIB_DIR (e.g., ini directory then system library)
3) LIB: prefix to explicitly specify a system library halfile (with
no search of the ini file directory)
[HAL]
...
HALFILE = LIB:filename.[hal|tcl]
...
This patch addresses a general issue of the multiple copies (or links) of
halfiles throughout the config tree and makes it simple to explicitly specify a
library halfile so that a user does not need to copy these files when modifying
a configuration. For example, one can instruct a user with:
'Include the line HALFILE = LIB:xhc-hb04.tcl in the [HAL] stanza of
your ini file'
Signed-off-by: Dewey Garrett <dgarrett@panix.com>
151 lines
4.3 KiB
Tcl
Executable file
151 lines
4.3 KiB
Tcl
Executable file
#!/usr/bin/tclsh
|
|
|
|
#-----------------------------------------------------------------------
|
|
# Copyright: 2014
|
|
# Author: Dewey Garrett <dgarrett@panix.com>
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 2 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to the Free Software
|
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
#-----------------------------------------------------------------------
|
|
|
|
set ::progname [file tail $::argv0]
|
|
set ::periodic_delay_ms 2000
|
|
set ::popup_hold_ms 0 ;# use 0 for forever
|
|
set ::debug 0
|
|
|
|
proc bool_from_string {v} {
|
|
# hal getp returns TRUE,FALSE
|
|
switch [string tolower $v] {
|
|
true {set v 1}
|
|
false {set v 0}
|
|
}
|
|
return $v
|
|
} ;# bool_from_string
|
|
|
|
proc dputs {msg} {
|
|
if $::debug {
|
|
puts stderr $::progname:debug:$msg
|
|
}
|
|
} ;# dputs
|
|
|
|
proc start_monitor {} {
|
|
package require Hal
|
|
package require Tk
|
|
|
|
wm withdraw .
|
|
set ::popupw [toplevel .p]
|
|
wm withdraw $::popupw
|
|
wm title $::popupw $::progname
|
|
wm protocol $::popupw WM_DELETE_WINDOW hide
|
|
pack [label ${::popupw}.t -text [now] -font bold]
|
|
pack [label ${::popupw}.l -text "startup" -font bold]
|
|
pack [button ${::popupw}.b -text "OK" -command dismiss] -anchor e
|
|
|
|
if [catch {set value [hal getp xhc-hb04.connected]} msg ] {
|
|
# this can occur if loadusr xhc-hb04 fails,
|
|
puts "$::progname: xhc-hb04 comp not loaded"
|
|
puts "$::progname: <$msg>"
|
|
puts "$::progname: exiting"
|
|
return
|
|
}
|
|
set ::connected false
|
|
if [catch { set ::connected [hal getp xhc-hb04.connected]
|
|
} msg] {
|
|
puts "$::progname: connected? <$msg>"
|
|
}
|
|
set ::connected [bool_from_string $::connected]
|
|
|
|
set ::require_pendant false
|
|
if [catch { set ::require_pendant [hal getp xhc-hb04.require_pendant]
|
|
} msg] {
|
|
puts "$::progname: require_pendant? <$msg>"
|
|
puts "$::progname: pendant connection not required, Continuing"
|
|
}
|
|
set ::require_pendant [bool_from_string $::require_pendant]
|
|
dputs "startup:connected=$::connected required=$::require_pendant"
|
|
|
|
if {!$::require_pendant && !$::connected} {
|
|
popup "\nrequire_pendant==0\nPendant not connected at startup"
|
|
}
|
|
|
|
after $::periodic_delay_ms check
|
|
} ;# start_monitor
|
|
|
|
proc now {} {
|
|
return [clock format [clock seconds]]
|
|
} ;# now
|
|
|
|
proc popup {msg} {
|
|
dputs $msg
|
|
$::popupw.l configure -text [now]
|
|
$::popupw.l configure -text $msg
|
|
center $::popupw
|
|
|
|
if {$::popup_hold_ms != 0} {
|
|
after $::popup_hold_ms [list wm iconify $::popupw]
|
|
}
|
|
} ;# popup
|
|
|
|
proc center {w} {
|
|
update idletasks
|
|
set x [expr [winfo screenwidth $w]/2 \
|
|
- [winfo reqwidth $w]/2 - [winfo vrootx [winfo parent $w]]]
|
|
set y [expr [winfo screenheight $w]/2 \
|
|
- [winfo reqheight $w]/2 - [winfo vrooty [winfo parent $w]]]
|
|
wm geom $w +$x+$y
|
|
wm deiconify $w
|
|
} ;# center
|
|
|
|
proc hide {} {
|
|
wm withdraw $::popupw
|
|
} ;# hide
|
|
|
|
proc dismiss {} {
|
|
wm withdraw $::popupw
|
|
} ;# dismiss
|
|
|
|
proc check {} {
|
|
if [catch { set ::connected_new [hal getp xhc-hb04.connected]
|
|
} msg] {
|
|
puts "$::progname <$msg>"
|
|
}
|
|
set ::connected_new [bool_from_string $::connected_new]
|
|
dputs "check:connected_new=$::connected_new required=$::require_pendant"
|
|
|
|
set allow_recheck 1
|
|
if {$::connected_new != $::connected} {
|
|
if $::connected_new {
|
|
set msg "\nConnected to pendant"
|
|
} else {
|
|
set msg "\nLost connection to pendant"
|
|
}
|
|
if $::require_pendant {
|
|
if {$::connected_new} {
|
|
set msg "$msg\nUnexpected"
|
|
} else {
|
|
# xhc-hb04 will timeout and exit so no more checks
|
|
set msg "$msg\nReconnect not supported for require_pendant==1"
|
|
set allow_recheck 0
|
|
}
|
|
}
|
|
dputs "$::progname: $msg"
|
|
popup $msg
|
|
}
|
|
|
|
set ::connected $::connected_new
|
|
if $allow_recheck {after $::periodic_delay_ms check}
|
|
} ;# check
|
|
|
|
# begin -----------------------------------------------------
|
|
start_monitor
|