Import LinuxCNC source tree

scripts/monitor-xhc-hb04

@@ -0,0 +1,151 @@
+#!/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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 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