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
pascal@scheffers.net to tell me you like it.

I used to have more documentation at tclx10.scheffers.net, but that seems to be lost forever. 

The first block is the actual library. 

----
X10.tcl

 #
 # X10.Tcl - A library for using the X10-CM11 module from Tcl
 #
 # Copyright (C) 2003 Pascal Scheffers <Pascal@Scheffers.Net>
 # 

 # 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]]


----
'''A very simple example'''

This would just turn device O 13 Off and then back on again.

 #!/usr/bin/env tclsh

 source [file join [file dirname [info script]] x10.tcl]

 connect /dev/ttyS1

 address O 13
 function O Off

 address O 13
 function O On

----
'''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

----



----
!!!!!!
%| enter categories here |%
!!!!!!