Posted to tcl by crshults at Sun Nov 10 05:17:25 GMT 2013view raw

  1. # Specification for this device says it returns a 1-byte status and the bits
  2. # are to be interpreted as follows:
  3. set status {
  4. {"Heater On" "Heater Off" }
  5. {"Primary Motor On" "Primary Motor Off" }
  6. {"Secondary Motor On" "Secondary motor Off"}
  7. {"Object In Path" "Object Not In Path" }
  8. {"Light On" "Light Off" }
  9. {"Reserved" "Reserved" }
  10. {"Fuel Low" "Fuel Not Low" }
  11. {"Reserved" "Reserved" }
  12. }
  13. # My goal is to read the status and print only what changed, so if bit 0 flips
  14. # from 0 to 1, the output will be: {Heater Off}
  15.  
  16. set current_status "Unknown"
  17.  
  18. # This is just a dummy to give us a random status byte
  19. proc get_device_response {} {
  20. return [subst "\\x[format %X [expr {int(rand()*256)}]]"]
  21. }
  22.  
  23. # I feel like this proc is way too ugly
  24. proc device_response_handling {} {
  25. set response [get_device_response]
  26. if {$response == $::current_status} return
  27. if {$::current_status != "Unknown"} {
  28. binary scan $::current_status B* current_status_bits
  29. } else {
  30. set current_status_bits xxxxxxxx
  31. }
  32. set ::current_status $response
  33. binary scan $::current_status B* new_status_bits
  34. set actual_changes_occurred no
  35. set result [lmap status_text $::status old [split $current_status_bits ""] new [split $new_status_bits ""] {
  36. if {[lindex $status_text $new] == "Reserved"} {
  37. continue
  38. } elseif {$old == $new} {
  39. continue
  40. } else {
  41. set actual_changes_occurred yes
  42. lindex $status_text $new
  43. }
  44. }]
  45. if {$actual_changes_occurred} {
  46. puts "New Device Status: $result"
  47. }
  48. }
  49.  
  50. # repeated calls of [device_response_handling] should suffice to demonstrate