Posted to tcl by patthoyts at Tue Apr 19 21:10:41 GMT 2011view raw

  1. proc tms_open {port} {
  2. variable TMSSettings
  3. set chan [open $port r+]
  4. fconfigure $chan -mode $TMSSettings \
  5. -buffering line -blocking 0 \
  6. -translation {cr cr}
  7. return $chan
  8. }
  9.  
  10. proc tms_send {chan cmd} {
  11. puts -nonewline $chan "$cmd\r"
  12. flush $chan
  13. after 500 {set ::waiting_send 1} ; vwait ::waiting_send
  14. set limit 0
  15. while {[incr limit] < 10 && [gets $chan line] < 0} {
  16. after 100 {set ::waiting_send 1} ; vwait ::waiting_send
  17. }
  18. #puts "> $cmd\n< $line"
  19. return $line
  20. }
  21.  
  22. proc tms_get {port} {
  23. variable tms_opened 1
  24. set tms [tms_open $port]
  25. if {[catch {
  26. set line [tms_send $tms T]
  27. } err]} {
  28. puts stderr "error: $err"
  29. }
  30. close $tms
  31. variable tms_opened 0
  32. binary scan $line c6a4 header hex
  33. return [format %.1f [expr {[scan $hex %x] / 10.0}]]
  34. }