Version 5 of x10-cm17a
Updated 2002-02-02 02:01:35Michael Jacobson: This is a console program to interface with the X10.com CM17A firecracker [L1 ]. This was one of my first Tcl programs and it need to cleaned up (a lot!!!) to use namespaces and be a library. But I have had a couple people ask for the code so instead of reinventing the wheel just grap if from here.
Link to the FireCracker (CM17A) Communications Specification [L2 ].
## By Mike Jacobson
## need WinCom or Tcl8.4a with TIP35 patches
## to control the DTR and DSR lines
## tested on Windows 95/98/Me/NT only
package require WinCom
catch { console show }
set rts 0
set dtr 0
set chan {}
#added not in spec ???
# B0 90 for "H All Lights On"
# B0 80 for "H All Units Off".
# $operation FUNCTION
# L Brighten Last Light Programmed 14%
# M Dim Last Light Programmed 14%
# N All Lights Off
# O All Lights On
# P All Units Off
# L 000 1000 1000 0 88
# M 000 1001 1000 0 98
# N 000 1010 0000 0 A0
# O 000 1001 0000 0 90
# P 000 1000 0000 0 80
proc X10_Cmd {house station command} {
#| Byte 1 | Byte 2 |
#|X|X|X|X|0|X|0|0|X|X|X|X|X|0|0|0|
#|1 2 3 4 5 6 7 8|1 2 3 4 5 6 7 8|
#Byte 1
set outstr 0
if {[lsearch {BRIGHT DIM AUO ALF ALO} $command] != -1} {
set station 0
}
#1: One for house codes E-L
if {[regexp {[E-L]} $house]} {
incr outstr 0x8000
}
#2: One for house codes A-D & I-L
if {[regexp {[A-D,I-L]} $house]} {
incr outstr 0x4000
}
#3: One for house codes A,B,G,H,I,J,O,P
if {[regexp {[A,B,G,H,I,J,O,P]} $house]} {
incr outstr 0x2000
}
#4: One for house codes B,D,F,H,J,L,N,P
if {[regexp {[B,D,F,H,J,L,N,P]} $house]} {
incr outstr 0x1000
}
#5: Always zero
#6: One for units 9-16
if {(9 <= $station) && ( $station <= 16) } {
incr outstr 0x0400
}
#7: Always zero
#8: Always zero
#Byte 2
#1: One for BRIGHT or DIM or AUO or ALF or ALO
if {[lsearch {BRIGHT DIM AUO ALF ALO} $command] != -1} {
incr outstr 0x0080
}
#2: One for unit codes 5-8 & 13-16
if {((5 <= $station) && ( $station <= 8)) || ((13 <= $station) && ( $station <= 16)) } {
incr outstr 0x0040
}
#3: One for OFF or ALF (Zero for ON or BRIGHT/DIM)
if {[lsearch {OFF ALF} $command] != -1} {
incr outstr 0x0020
}
#4: One for unit codes 2,4,6,8,10,12,14,16 & DIM & ALO command
if {[lsearch {2 4 6 8 10 12 14 16} $station] != -1 } {
incr outstr 0x0010
} elseif {[lsearch {DIM ALO} $command] != -1 } {
incr outstr 0x0010
}
#5: One for unit codes 3,4,7,8,11,12,15,16 & BRIGHT & DIM commands
if {[lsearch {3 4 7 8 11 12 15 16} $station] != -1 } {
incr outstr 0x0008
} elseif {[lsearch {DIM BRIGHT} $command] != -1} {
incr outstr 0x0008
}
#6: Always zero
#7: Always zero
#8: Always zero
SendByte 0xD5 ;# header
SendByte 0xAA
SendByte [expr [expr $outstr & 0xFF00] >> 8]
SendByte [expr $outstr & 0xFF]
SendByte 0xAD ;# footer
return $outstr
}
proc Pause { {msec 1000} } {
update
after $msec {set Pause 1}
vwait Pause
}
proc Send_Standby {} {
# puts "in standby"
global chan dts rts
set rts 1
set dts 1
wincom::config $chan -dtr enable
wincom::config $chan -rts enable
Pause 10
}
proc Send_1 {} {
# puts "in send 1"
global chan dtr# wincom::config $chan -rts enable
set dts 0
wincom::config $chan -dtr disable
Pause 1
}
proc Send_0 {} {
# puts "in send 0"
global chan rts# wincom::config $chan -dtr enable
set rts 0
wincom::config $chan -rts disable
Pause 1
}
proc Send_Reset {} {
# puts "in reset"
global chan rts dtr
set rts 0
set dts 0
wincom::config $chan -dtr disable
wincom::config $chan -rts disable
Pause 50
}
proc Send_Wait {} {
#puts "in wait"
global chan rts dtr
if {$rts == 0} {
set rts 1
wincom::config $chan -rts enable
}
if {$dtr == 0} {
set dtr 1
wincom::config $chan -dtr disable
}
Pause 1
#puts "out wait"
}
proc SendByte {iByte} {
#puts "Byte to send [DispHex $iByte]"
for {set i 0} {$i <=7} {incr i} {
if {[expr $iByte & 0x80]} {
Send_1
#puts "1"
} else {
Send_0
#puts "0"
}
Send_Wait
set iByte [expr $iByte * 2]
}}
proc DispHex {NumIn} {
set StrOut [format "%X" $NumIn]
return $StrOut
}
proc Bin2Int {binstr} {
set binstr [string trim $binstr]
puts $binstr
set binlen [string length "$binstr"]
puts $binlen
set outstr 0
for {set i 0} {$i < $binlen} {incr i} {
set num [string index "$binstr" $i]
puts $num
if {$num == 0} {
set outstr [expr $outstr << 1]
} elseif {$num == 1} {
set outstr [expr [expr $outstr << 1] + 1]
}
}
return $outstr
}
proc X10 {cmd args} {
global chan
if {[string equal -nocase $cmd SEND]} {
if {$chan == ""} {
puts "init COM port 1"
set chan [open com1 r+]
Pause 50
Send_Reset
Send_Standby
# ???? may need to restore this stuff
#fconfigure $chan -blocking 1 -buffering none
#wincom::config $chan -mode "19200,n,8,1" -timeout 10
}
#puts "X10_Cmd $args"
puts "X10 command sent [DispHex [eval X10_Cmd $args]]"
} elseif {[string equal -nocase $cmd CLOSE]} {
close $chan
set chan {}
puts "close COM port 1"
}
}
## example
## X10 {type} {house} {station} {command}
## X10 {SEND CLOSE} {A-P} {1-16} {OFF ON BRIGHT DIM AUO ALF ALO}
##
## X10 SEND A 1 ON
## X10 SEND P 12 DIM
## X10 SEND H 2 AU0 ;# all units on (may not work)
## X10 SEND H 2 ALF ;# all units off (may not work)