x10-cm17a

Michael 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 needs 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 (or update it and post below).

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)

MacSoileau - 2011-12-18 15:03:33

Modified the original script to work using fconfigure instead of the WinCom. Also had to modify the Pause timing to make it work for me. Thanks to Mike Jacobson for the original work!

## By Mike Jacobson
## Modified by Mac Soileau to work without additional packages
## Tested on Windows 7
 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 {} {
        global chan dts rts
        set rts 1
        set dts 1
        fconfigure $chan -ttycontrol {RTS 1 DTR 1}
        #puts "Send_Standby" 
        Pause 100
 }

 proc Send_1 {} {
        global chan dtr
        set dts 0
        fconfigure $chan -ttycontrol {DTR 0 RTS 1}
#        puts "Send 1"
        Pause 10
 }

 proc Send_0 {} {
        global chan rts
    set rts 0
        fconfigure $chan -ttycontrol {RTS 0 DTR 1}
#        puts "Send 0"
        Pause 10
 }

 proc Send_Reset {} {
        global chan rts dtr
        set rts 0
        set dts 0
        fconfigure $chan -ttycontrol {RTS 0 DTR 0}
#        puts "Send Reset"
        Pause 500
 }

 proc Send_Wait {} {
        global chan rts dtr
        fconfigure $chan -ttycontrol {DTR 1 RTS 1}
#        puts "Send Wait"
        Pause 10
 }

 proc SendByte {iByte} {
    #puts "Byte to send [DispHex $iByte]"
        for {set i 0} {$i <=7} {incr i} {
                if {[expr $iByte & 0x80]} {
                        Send_1
                } else {
                        Send_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+]
                        fconfigure $chan -handshake none -blocking 1 -buffering none -mode 19200,n,8,1
                        Pause 50
                        Send_Reset
                        Send_Standby

                }
                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)