|
|
(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
© 1994-2009
Laurent Demailly,
Last update: Tue Sep 29 1998
|