asa
[Michael Jacobson]: This is a console program to interface with the X10.com CM17A firecracker [http://www.x10.com/firecracker/fc_x10_cm17a_br1.htm].  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 [ftp://ftp.x10.com/pub/manuals/cm17a_protocol.txt].

[http://graphics.x10.com/images2/ck17a_detail.jpg]
----
 ## 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)