This page consist of my main body of Tcl X10 code.
I wrote this software because I needed/wanted a Pure Tcl solution for using my CM11 interface module. The result is a work in progress that lets you control your CM11 from any machine/OS for which a Tcl 8.4 or better interpreter exist. The machine does not even need to have a serial port, as long as you have a machine that does which can run Tcl 8.4 and has a TCP/IP connection.
I hope this library is useful to you. If it is, drop me a note at [email protected] to tell me you like it.
I used to have more documentation at tclx10.scheffers.net, that site is down, but the wayback machine still has it [L1 ].
A very simple example
This would just turn device O 13 Off and then back on again.
#!/usr/bin/env tclsh package require tclx10 connect /dev/ttyS1 address O 13 function O Off address O 13 function O On
That's it. I used this to remotely powercycle a troublesome router.
'Documentation'
Connecting to the CM11
There are two ways of connecting to your CM11, directly on the localmachine or over a TCP/IP connection.
Local serial port
This is probably the best way to connect.
package require x10 #On a windows machine, com port 1 x10::connect com1:
That's it.
Connecting takes about two seconds, this is because the CM11 may be polling the computer after an (old) power failure or pending events. After a power failure, the CM11 is updated with the computer local time. Make sure your clock is set correctly.
For Linux machines, substitute /dev/ttyS0 for com1:
Remote TCP/IP
package require x10 #On a windows machine, com port 1 x10::tcpconnect $servername $portnumber $password
(note the server implementation is missing from this page at this moment. It was simply a 10 line tcl script.)
When to connect?
After you have setup all your aliasses and event handlers. If you connect before that, you handlers will not be called upon connecting.
Setting up aliasses
Aliasses are a convenient way to work with devices, it is basically a name for a housecode+devicenumber.
There are two commands you need to know for this: alias and unalias
package require x10 x10::alias A 3 bathroom x10::alias A 4 kitchen x10::alias A 5 chandelier x10::alias A 6 bedroom
Groups
Aliasses can be a single device or a whole bunch of devices, to make a group just repeatedly call alias with different devices and the same name:
x10::alias A 4 firstfloor x10::alias A 5 firstfloor x10::alias A 10 firstfloor
Aliasses are used by the x10 command and the x10events. Direct addresses are harder to use and more error prone, you should create aliasses for all your devices.
Handling Events
Whenever another X10 controler sends a command over the powerline, the CM11 will notify the library of the incomming event.
You can register event handlers which are called whenever such an event occurs.
All event handlers are procs in the ::x10events namespace. To create a new handler, just create a proc in this namespace. It must accept four arguments: house, device, function, data.
Handler names
The name of a handler is usually the name of the alias (case sensitive!), housecode/devicenumber (i.e. A6) or just the housecode A, B, etc. There are also a two predefined/reserved event handler names: master and default.
Execution order
The event dispatcher calls event handlers in the following order (if they exist):
So, for [alias A 5 bathroom]:
Return codes
Each event handler should return either X10_DONE or X10_CONTINUE.
You can use this to have a master event handler that logs all events, for example and then lets the alias-named handler handle the actual events. The default handler can raise the alarm when it sees an event with no handler.
List of X10 Commands
These are the 'function's supported by X10. These names should be used when calling x10.
AllUnitsOff
AllLightsOn
On
Off
Dim
Bright
AllLightsOff
ExtendedCode
HailRequest
HailAcknowledge
PresetDim1
PresetDim2
ExtendedDataTransfer
StatusOn
StatusOff
StatusRequest
The next block is the actual library:
X10.tcl
# # X10.Tcl - A library for using the X10-CM11 module from Tcl # # Copyright (C) 2003 Pascal Scheffers <[email protected]> # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials provided # with the distribution. 3. The name of the author may not be used # to endorse or promote products derived from this software without # specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE # ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE # GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER # IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR # OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN # IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. package provide x10 0.5 namespace eval x10 { variable conn "" variable queue variable aliasses ;# House/Device -> Name mappings variable events_namespace ::x10events interp alias {} [namespace current]::dputs {} puts #converted from binary tables in protocol.txt array set codes { house.6 A house.14 B house.2 C house.10 D house.1 E house.9 F house.5 G house.13 H house.7 I house.15 J house.3 K house.11 L house.0 M house.8 N house.4 O house.12 P A 6 B 14 C 2 D 10 E 1 F 9 G 5 H 13 I 7 J 15 K 3 L 11 M 0 N 8 O 4 P 12 1 6 2 14 3 2 4 10 5 1 6 9 7 5 8 13 9 7 10 15 11 3 12 11 13 0 14 8 15 4 16 12 device.6 1 device.14 2 device.2 3 device.10 4 device.1 5 device.9 6 device.5 7 device.13 8 device.7 9 device.15 10 device.3 11 device.11 12 device.0 13 device.8 14 device.4 15 device.12 16 AllUnitsOff 0 AllLightsOn 1 On 2 Off 3 Dim 4 Bright 5 AllLightsOff 6 ExtendedCode 7 HailRequest 8 HailAcknowledge 9 PresetDim1 10 PresetDim2 11 ExtendedDataTransfer 12 StatusOn 13 StatusOff 14 StatusRequest 15 command.0 AllUnitsOff command.1 AllLightsOn command.2 On command.3 Off command.4 Dim command.5 Bright command.6 AllLightsOff command.7 ExtendedCode command.8 HailRequest command.9 HailAcknowledge command.10 PresetDim1 command.11 PresetDim2 command.12 ExtendedDataTransfer command.13 StatusOn command.14 StatusOff command.15 StatusRequest CmAck 85 StatusCode 139 SetClock 155 PCReady 0 InterfacePoll 90 PcPollAck 195 PowerFail 165 SetMacro 251 } proc header { dims fa {es ""} } { #X10 Header: 7 6 5 4 3 2 1 0 # < Number of Dims> 1 F/A E/S #return header byte if {$dims > 22 && $dims < 0 } { error "Dims out of range: $dims" } if { $fa ne "function" && $fa ne "address" } { error "fa should be 'function' or 'address'" } if { $es ne "" && $es ne "extended" } { error "es should be empty or 'extended'" } set fa [expr { $fa eq "function" }] set es [expr { $es eq "extended" }] #NB: $dims*8 is the same as shr($dims, 3) set val [expr $dims*8 | 4 | $fa*2 | $es] set hdr [binary format c $val] #binary scan $hdr c x return $hdr } proc fa_byte { housecode f_d } { # Return a function or address byte (they're essentially the same): # Code: 7 6 5 4 3 2 1 0 # Address: < Housecode > <Device Code> # Function:< Housecode > < Function > variable codes return [binary format c [expr $codes($housecode)*16 | $codes($f_d)]] } proc function { housecode function {dims 0} } { dputs "Function $housecode $function dim $dims" transmit [header $dims function][fa_byte $housecode $function] } proc address { housecode device } { dputs "Address $housecode$device" transmit [header 0 address][fa_byte $housecode $device] } proc transmit { code {tries 3} } { variable conn variable codes #run the x10 send protocol: # 1. Check for polling state # 2. Send code # 3. receive csum # 4. optionally retry until csum matches # 5. send Ack if csum okay # 6. wait for confirm code from cm11 #setup state: set csum [checksum $code] set c "" set try 0 # 1. check for poll #read 1 byte, timeout 0, checkforpoll = true: x10read 1 0 1 # 2, 3, 4: send code, receiver csum, retry if bad while { $c ne $csum && $try < $tries } { if { $c ne "" } { set cx [toint $c] ;# binary scan $c c cx dputs "Checksum received was bad: [format %x $cx]" #if the (first) checksum returned didn't match, it may be that #the cm11 has started polling... if { $cx eq $codes(PowerFail) } { setclock } if { $cx eq $codes(InterfacePoll) } { handlepoll } } incr try #dputs "Send [string length $code] bytes to CM11" puts -nonewline $conn $code set c [x10read 1 1000 0] if { $c ne "" } { set cx [toint $c] ;#binary scan $c c cx #dputs "Received [format %x $cx] from cm11" } } # 5. Send Ack: #dputs "Sending Ack" puts -nonewline $conn \x0 # 6. Wait for interface ready (10 sec max) #dputs "Wait for InterfaceReady..." set c [x10read 1 10000] if { $c ne "" } { set cx [toint $c] ;#binary scan $c c cx } if { $c eq [binary format c $codes(CmAck)] } { dputs "OK transmited [string length $code] bytes" return OK } dputs "FAILED to transmit [string length $code] bytes" return FAILED } proc xmit_fa { code } { variable conn set csum [checksum $code] set c "" set tries 0 while { $c ne $csum && $tries < 10 } { incr tries dputs "Try: $tries" puts -nonewline $conn $code set c [read $conn 1] set cnt 0 while { $c eq "" && $cnt < 50 } { incr cnt after 30 set c [read $conn 1] } if { $c ne "" } { set cx [toint $c] ;#binary scan $c c cx dputs "Got csum [format %x $cx] $c=$csum? " } else { dputs "No csum returned!" } } if { $c ne $csum } { dputs "Confirm!" puts -nonewline $conn \x0 } else { dputs "bad checksum: $csum ne $c" } } proc toint { bytes } { binary scan $bytes c* ints set r [list] foreach int $ints { lappend r [expr ($int + 0x100)%0x100] } return $r } proc checksum { code } { set csum 0 foreach byte [split $code ""] { set x [toint $byte] ;#binary scan $byte c x incr csum $x } return [binary format c [expr $csum & 0xff]] } proc x10read { bytes timeout {checkpoll 1}} { variable codes variable conn set timeout [expr $timeout / 10] set cnt 0 set c "" #dputs "Read $bytes [fconfigure $conn -ttystatus]" set c [read $conn 1] if { $c ne "" } { set cx [toint $c] ;#binary scan $c c cx dputs "Read first: [format %x $cx]" if { $checkpoll && [lsearch "$codes(PowerFail) $codes(InterfacePoll)]" $cx] > -1 } { if { $cx eq $codes(PowerFail) } { dputs "CheckPoll! Calling setclock" setclock return "" } if { $cx eq $codes(InterfacePoll) } { dputs "CheckPoll! Calling handlepoll" handlepoll return "" } } } while { [string length $c] < $bytes && $cnt < $timeout } { incr cnt after 10 append c [read $conn [expr $bytes -[string length $c]]] } if { $c ne "" } { #dputs "Read response after [expr $cnt*10]ms" } else { #dputs "No data after [expr $cnt*10]ms" } if { $c ne "" } { set cx [toint $c] ;#binary scan $c c cx #dputs "Read: [format %x $cx]" if { $checkpoll && ( $codes(PowerFail) eq $cx || $codes(InterfacePoll) eq $cx ) } { if { $cx eq $codes(PowerFail) } { dputs "CheckPoll! Calling setclock" setclock return "" } if { $cx eq $codes(InterfacePoll) } { dputs "CheckPoll! Calling handlepoll" handlepoll return "" } } } return $c } proc connect { port } { resetQueue variable conn set conn [open $port r+] fconfigure $conn -blocking 0 -buffering none -translation binary fconfigure $conn -mode 4800,n,8,1 -handshake none dputs "Connected [fconfigure $conn -ttystatus]" fileevent $conn readable [namespace current]::x10event #Now we must wait for input for at least 1 second, as the interface #may be polling! x10read 1 2000 1 #We can discard the input character, x10read will dispatch #the correct setup functions if needed. } proc tcpconnect { server port password } { resetQueue variable conn dputs "Trying $server:$port..." set conn [socket $server $port] dputs "Logging in..." puts $conn $password flush $conn set login [gets $conn] if { $login ne "Ok" } { error $login } dputs "Connected." fconfigure $conn -blocking 0 -buffering none -translation binary fileevent $conn readable [namespace current]::x10event #Now we must wait for input for at least 1 second, as the interface #may be polling! x10read 1 2000 1 #We can discard the input character, x10read will dispatch #the correct setup functions if needed. } proc setclock { } { variable conn variable codes dputs "Setting clock" #empty the buffer first, the cm11 will fill Tcl's buffer fast #if you're not checking often enough. read $conn # Data to send to CM11 # Bit range Description # 55 to 48 timer download header (0x9b) # 47 to 40 Current time (seconds) # 39 to 32 Current time (minutes ranging from 0 to 119) # 31 to 23 Current time (hours/2, ranging from 0 to 11) # 23 to 16 Current year day (bits 0 to 7) # 15 Current year day (bit 8) # 14 to 8 Day mask (SMTWTFS) # 7 to 4 Monitored house code # 3 Reserved # 2 Battery timer clear flag # 1 Monitored status clear flag # 0 Timer purge flag set now [clock seconds] set second [clock format $now -format %S] if { [string index $second 0] == 0 } { #remove leading 0 set second [string index $second 1] } set minute [clock format $now -format %M] if { [string index $minute 0] == 0 } { #remove leading 0 set second [string index $minute 1] } set hour [clock format $now -format %k] set yday [clock format $now -format %j] if { [string index $yday 0] == 0 } { #remove leading 0 set second [string range $yday 1 end] } if { [string index $yday 0] == 0 } { #remove second leading 0 set second [string range $yday 1 end] } set wday [clock format $now -format %u] append data [binary format c $codes(SetClock)] append data [binary format c $second] append data [binary format c [expr $minute + (($hour % 2) * 60)]] append data [binary format c [expr $hour /2]] append data [binary format c [expr $yday % 256]] append data [binary format c [expr ($yday / 256)*128 | $wday]] append data \x0 puts -nonewline $conn $data } proc handlepoll {} { variable conn variable codes dputs "Handling interface poll" #first empty the buffer, the cm11 will fill Tcl's buffer fast #if you're not checking often enough. set devnull [read $conn] dputs "Discarded [string length $devnull] bytes." #first Ack the poll: puts -nonewline $conn [binary format c $codes(PcPollAck)] # Byte Function # 0 Upload Buffer Size # 1 Function / Address Mask # 2 Data Byte #0 # 3 Data Byte #1 # 4 Data Byte #2 # 5 Data Byte #3 # 6 Data Byte #4 # 7 Data Byte #5 # 8 Data Byte #6 # 9 Data Byte #7 # read buffer size: set size -1 set try 0 #now get the size, ignoring all bytes larger/smaller than 10. #(this is because Tcl may have buffered one or two 0x5a bytes since #flushing the buffer) while { $try < 10 && ( $size < 0 || $size > 10 ) } { set s [x10read 1 2000 0] if { $s eq "" } { error "Error getting size while handling interface poll" } set size [toint $s] ;#binary scan $s c size incr try } dputs "Skipped [expr $try -1] bytes. Have to read $size bytes" set buffer [x10read $size 5000 0] if { $buffer eq "" } { error "Error getting data while handling interface poll" } binary scan [string index $buffer 0] b8 mask set buf [toint [string range $buffer 1 end]] dputs "Read [string length $buffer] additional bytes: {$buf}" set nextisdim 0 foreach byte $buf function [split $mask ""] { if { $byte eq "" } { break } set house [expr ($byte & 0xf0) / 16] set f_a [expr $byte & 0xf] if { $nextisdim } { dputs " * Level $byte=[expr {int($byte/210.0*100)}]%" addLevel [expr {int($byte/210.0*100)}] set nextisdim 0 } elseif { $function } { dputs " * Function $codes(house.$house) $codes(command.$f_a)" if { $codes(command.$f_a) eq "Dim" || $codes(command.$f_a) eq "Bright" } { set nextisdim 1 } addFunction $codes(house.$house) $codes(command.$f_a) } else { addAddress $codes(house.$house) $codes(device.$f_a) dputs " * Address $codes(house.$house) $codes(device.$f_a)" } } dputs "" } proc addAddress { house device } { variable queue if { $queue(house) ne $house } { resetQueue set queue(house) $house } if { [lsearch $queue(addresses) $device] == -1 } { lappend queue(addresses) $device } } proc addFunction { house function } { variable queue if { $queue(house) ne $house } { resetQueue set queue(house) $house set queue(function) $function } elseif { $function ne "Dim" && $function ne "Bright" } { foreach address $queue(addresses) { dispatch $house $address $function -1 } resetQueue } } proc addLevel { level } { variable queue if { $queue(house) ne "" } { foreach address $queue(addresses) { dispatch $queue(house) $address $queue(function) $level } resetQueue } } proc dispatch { house device function data } { variable aliasses variable events_namespace dputs "Dispatch: $house$device $function $data" #First, add the master/main handler: set procs [list master] #Next, add the aliasses if { [info exists aliasses($house.$device)] } { set procs [concat $procs $aliasses($house.$device)] } lappend procs $house$device $house default foreach p $procs { if { [info procs ${events_namespace}::$p] ne "" } { dputs "Calling ${events_namespace}::$p" if { [${events_namespace}::$p $house $device $function $data] eq "X10_DONE" } { return } } } } proc resetQueue { } { variable queue set queue(house) "" set queue(addresses) [list] set queue(function) "" set queue(dim) -1 } proc x10event { } { variable conn variable codes dputs "X10 Event [clock format [clock seconds]]" set c [read $conn 1] if { $c eq "" } { return } set cx [toint $c] ;#binary scan $c c cx binary scan $c b* bx dputs "$cx 0x[format %x $cx] $bx $codes(PowerFail) $codes(InterfacePoll)" if { $cx == $codes(PowerFail) } { dputs "Event: powerfail" setclock } if { $cx == $codes(InterfacePoll) } { dputs "Event: HandlePoll" handlepoll } set ::awhile [clock seconds] } proc setmacro {} { variable conn variable codes # The macro memory is 42 bytes long and is cleared by this function puts -nonewline $conn [binary format c $codes(SetMacro)][string repeat \x0 42] set c [x10read 1] dputs "Csum $c" } proc alias {house device name} { variable aliasses lappend aliasses($house.$device) $name lappend aliasses(name.$name) [list $house $device] } proc unalias {name} { variable aliasses if { [info exists aliasses(name.$name)] } { foreach {house device} $aliasses(name.$name) { if { [info exists aliasses($house.$device)] } { unset aliasses($house.$device) } } unset aliasses(name.$name) } } proc x10 {devices function {dims 0}} { variable aliasses set addresses [list] set houses [list] #first decode aliasses: foreach name $devices { if { [llength $name] == 2 } { lappend addresses $name } else { if { [info exists aliasses(name.$name)] } { set addresses [concat $addresses $aliasses(name.$name)] } else { error "Unknown device $name" } } } #now split into houses: dputs [list $addresses] foreach a $addresses { foreach {house address} $a {} if { [lsearch $houses $house] == -1 } { lappend houses $house } lappend ha($house) $address } #finally, loop over houses to actually do it: foreach house $houses { foreach address $ha($house) { address $house $address } function $house $function $dims } #Phew. We're done. } namespace export connect tcpconnect x10read address function toint alias unalias x10 }
And a pkgIndex.tcl would be:
package ifneeded x10 0.5 [list source [file join $dir x10.tcl]]
This is a more elaborate usage example
lappend auto_path .
package require x10
namespace import x10::*
#Create the event handlers:
namespace eval x10events {
#All handlers are optional.
#
# Handler proc names, in calling order:
#
# master - always called first
# aliasses - as defined with the [x10::alias] command
# $house$address - i.e. [proc A5] called for A5 only
# $house - i.e. [proc A] called for all house A events
# default - called last, when nothing exists and/or returned X10_DONE
#
# Handlers should either return X10_DONE or X10_CONTINUE depending
# on what the event dispatcher should do:
# X10_DONE: Stop trying all other handlers for this event
# X10_CONTINUE: continue trying other handlers
#
proc default {house device function data} {
puts "Default Handler got $house$device $function"
return X10_DONE
}
proc master {house device function data} {
puts "Master got $house$device $function"
return X10_CONTINUE
}
proc lamp4 {house device function data} {
puts "Lamp 4 $function"
return X10_DONE
}
proc lamp5 {house device function data} {
puts "Lamp 5 $function"
x10 {{B 2} lamp4} $function
return X10_CONTINUE
}
proc A5 {house device function data} {
puts "A5 $function"
return X10_DONE
}
proc lamp6 {house device function data} {
puts "Lamp 6 $function"
return X10_DONE
}
proc A6 {house device function data} {
puts "A6 $function"
return X10_CONTINUE
}
}
#Setup the aliases used above.
alias A 1 lamp1
alias A 2 lamp2
alias A 3 lamp3
alias A 4 lamp4
alias A 6 lamp6
alias A 5 lamp5
alias B 2 bathroom
#Choose your connection:
# Connect through Tcp (you need a proxy for this to work)
#tcpconnect io 1026 somethingsecret
# Or windows comm port:
#connect com1:
# Or a unix serial port:
connect /dev/ttyS0
proc doTurnOn {} {
puts "TurnOn"
#x10::x10 lamp2 Off
#x10::x10 lamp1 On
x10::x10 lamp2 On
x10::x10 lamp2 Dim 65
}
#after 50 doTurnOn
after 50 "x10 lamp5 Off"
#start the eventloop, you should not do this in a wish application
puts "Enter eventloop"
vwait forever