Tcl/Tk Home
|
Overview
|
TclRCX
|
Tcl Plug-in
|
Apps.& Ext.
|
More Links
|
RCX:
+ FAQ
+ Kekoa's page
+ Lego Robotics
+ Official site

rcx0.tcl

(use "save as..." on this link (rcx0.tcl) if you want to save and use locally)
#
# Lego(r) Mindstorms(tm) RCX  interface in Tcl
#
# (c) 1998 Laurent Demailly - http://www.demailly.com/~dl/
# See the 'Artistic' LICENSE (http://language.perl.com/misc/Artistic.html)
# for terms, conditions, and in particular the DISCLAIMER OF ALL WARRANTIES.
# (If you'd like or need a license with other terms, don't hesitate
#  to contact the author)
#
# This is a work in progress and it does not do much yet...
# check back http://www.demailly.com/tcl/rcx/ for updates.
#
# LEGO is a registered trademark of the LEGO Group, which does not sponsor,
# authorize, or endorse this work.
#
#
# This program is greatly inspired and has been made possible
# by the work of :
#   + Paul Haas and his perl based talkrcx, http://hamjudo.com/rcx/
#   + Kekoa Proudfoot rcx informations page and Dave Baum contributions
#     http://graphics.stanford.edu/~kekoa/rcx/
#   + Russel Nelson's rcx informations page, Lego Robotics web page,
#     http://www.crynwr.com/lego-robotics/
#
# $Id: rcx0.tcl,v 1.4 1998/10/05 05:21:58 dl Exp $
#


namespace eval ::rcx {

    #####
    # exported APIs

    namespace export init terminate outMsg d2h h2d invert hInvert v2h \
	    flip mkMsg outMsg dump 

    #####
    # namespace variables
    
    # serial port device name used
    variable serialPort
    
    # serial port channel (file descriptor)
    variable chan

    # bit flipping
    variable flip 0

    # Platform dependant code:

    switch $tcl_platform(platform) {
	"windows" {
	    variable defSerialPort com1:
	}
	"unix" {
	    variable defSerialPort /dev/ttyS0
	}
	"macintosh" {
	    # what is the serial port name like on a mac ?
	    # unfortunatly current tcl versions does not have the
	    # serial port driver handling on the Mac yet.
	    error "sorry, serial port not supported on the mac yet,\
		    write it yourself or tell bugs@scriptics.com you need it!"
	}
    }


    #####
    # entry points (APIs)

    # Initialize/Open the serial port and set the modes

    proc init {{aSerialPort ""}} {
	variable defSerialPort
	variable serialPort
	variable chan

	# called without argument specifying which serial port to use ?
	if {[string length $aSerialPort]==0} {
	    # Override the default if the RCXTTY environment variable
	    # is defined (compatibility with Kekoa's send.c)
	    if {[info exists ::env(RCXTTY)]} {
		set aSerialPort $::env(RCXTTY)
	    } else {
		set aSerialPort $defSerialPort
	    }
	}
	# remember what we actually used in the namespace variable
	set serialPort $aSerialPort

	set chan [open $serialPort RDWR]
	fconfigure $chan -mode 2400,o,8,1 -buffering none -translation binary\
		-blocking false
	return $chan
    }

    # end communication and reset namespace state

    proc terminate {} {
	variable chan
	variable serialPort

	close $chan
	unset chan
	unset serialPort
    }

    #####
    # utility procs

    # data -> hex string conv

    proc d2h {data} {
	binary scan $data H* v
	return $v
    }

    # hex string -> data conv

    proc h2d {hexstr} {
	# remove un signifixant white space, ...
	regsub -all "\[ \t\n\]+" $hexstr {} hexstr
	# remove "0x"
	regsub -all -nocase 0x $hexstr {} hexstr
	binary format H* $hexstr
    }

    # complement / bit invert a value

    proc invert {val} {
	expr {0xff^$val}
    }
    proc hInvert {val} {
	v2h [invert $val]
    }

    # byte value to hex string

    proc v2h {val} {
	format "%02x" $val
    }

    #####
    # core proc actually doing the work

    proc flip {cmdByte} {
	variable flip
	if {$flip} {
	    set flip 0
	    set hexValue 0x$cmdByte
	    return [v2h [expr {0x08^$hexValue}]]
	} else {
	    set flip 1
	    return $cmdByte
	}
    }

    # messages starts with "55 ff 00", then each value and its complement
    # then a (check)sum and the checksum's complement.
    # see http://graphics.stanford.edu/~kekoa/rcx/protocol.html
    # mkMsg {f7 12} -> 55ff00f70812ed1091f6
    proc mkMsg {hexlst} {
	set res {55 ff 00}
	set v 0
	foreach byte $hexlst {
	    lappend res $byte
	    set hexbyte 0x$byte
	    incr v $hexbyte
	    lappend res [hInvert $hexbyte]
	}
	lappend res [v2h $v] [hInvert $v]
	join $res ""
    }


    # out the args,...
    proc outMsg {args} {
	variable chan
	variable flip
	set msg [mkMsg $args]
	set data [h2d $msg]
	set lg [string length $data]
	dump
	puts -nonewline $chan $data
	flush $chan
	puts -nonewline "sent $msg..."; flush stdout
	fconfigure $chan -blocking true
	set echo [read $chan $lg]
	fconfigure $chan -blocking false
	if {[string compare $echo $data]} {
	    puts " error, invalid echo: [d2h $echo]"
	} else {
	    puts " echoed ok."
	}
    }

    proc dump {} {
	variable chan
	set w [read $chan]
	if {[string length $w]==0} {
	    if {[eof $chan]} {
		puts "eof on $chan... closing..."
		terminate
	    } else {
		#puts "(empty read on $chan)";
		return
	    }
	}
	puts "read [d2h $w]"
    }

    array set byteCodes  {
	10 {ping {Check whether or not the RCX is alive.
If the PC receives a reply to this request, it assumes the RCX is alive
and the connection is good.}}
        12 {getVal {} {}}
	13 {motorPower }
	21 {switchMotor }
    }

    proc rcxCode {name code helpMsg argList body} {
	variable code2name
	variable name2code
	variable help

	set code2name($code) $name
	set name2code($name) $code
	set help($name) $helpMsg

	proc $name $argList "set code \[flip $code\]\n$body"

	namespace export $name
    }

    rcxCode ping 10 {check if the RCX is alive} {} {
	outMsg $code
    }
    rcxCode switchMotor 21 {switch motors power on/off} {arg} {
	outMsg $code $arg
    }

}


proc TEST {} {
    # import all rcx commands in the current namespace
    namespace import rcx::*
    # init and serial port opening
    set f [init]
    puts "Sending all motors on on $f ([fconfigure $f])"
    # ping the rcx
    # (was 'outMsg [flip 10]', now:)
    ping
    # set all motors on :
    # (was 'outMsg [flip 21] 87', now :)
    switchMotor 87
    # wait 2 seconds
    after 2000 
    # stop the motors
    switchMotor 47 
    # let the motor free (instead of blocking them off)
    switchMotor 07
    ping
    dump
}

puts "try 'TEST' to test ! (and 'info body TEST' for the code)"



Tcl top | Overview | TclRCX | Tcl Plug-in | Apps.& Ext. | More Links

demailly.com © 1994-2009 Laurent Demailly, Last update: Tue Sep 29 1998