#lang racket/base ;; Copyright Neil Van Dyke. See file "info.rkt". (require (for-syntax racket/base syntax/parse) racket/match racket/system (planet neil/mcfly)) (module+ test (require (planet neil/overeasy:3))) (doc (require scribble/bnf "roomba-doc-utils.rkt")) (doc (section "Introduction") (para "This package implements a " (hyperlink "http://docs.racket-lang.org/" "Racket") " interface for controlling many " (tech "models") " of the " (hyperlink "http://en.wikipedia.org/wiki/Roomba" "iRobot Roomba") " robot vacuum cleaner, and the " (hyperlink "http://www.irobot.com/create" "iRobot Create") " educational/hobby robot platform. This package currently runs on GNU/Linux and possibly on Apple Mac OS X.") (para "One reason to control a Roomba using Racket is " (hyperlink "http://en.wikipedia.org/wiki/Constructionism_%28learning_theory%29" "constructionist learning") " opportunities for children. Another reason is various hobby projects, getting the robot hardware to do useful or amusing things other than clean one's floor, perhaps as a small piece of something much bigger. Another reason is the principle among engineer-types that it is good to be able to modify, experiment with, and improve things that you own.") (para "Using this package requires first using a special cable or hardware interface to connect the computer running your Racket program with the Roomba. " "(If you don't already have such a cable or hardware interface, see section " (secref "Cables") " of this document.) This package implements the protocol that is used over that hardware connection. You then write your program using the definitions provided by this package.") (para "Obligatory Cautions: Roomba hacking is not without risks; please don't sue us. Also, this package is " (italic "not") " produced by iRobot Corp.; please don't bother them about this package.") ;; TODO: Give example short program. ) (doc (section "Logging") (para "This package sends logging messages to the " " Racket " (hyperlink "http://docs.racket-lang.org/reference/logging.html" "logger") ", naming the messages as ``" (tt "roomba") "''. This includes " (tt "debug") " level messages for each use of most of this package's API. You can see these messages in the usual Racket ways, such as by using the " (tt "-W") " argument to the command-line " (tt "racket") " program, or via the DrRacket Log window.")) (define-logger roomba) (doc (section "Exceptions")) (doc (defstruct* (exn:fail:roomba exn:fail) ((roomba roomba?)) (para "Supertype for exceptions related to the Roomba."))) (provide exn:fail:roomba? exn:fail:roomba-roomba) (define-struct (exn:fail:roomba exn:fail) (roomba) #:transparent) (doc (defstruct* (exn:fail:roomba:io exn:fail:roomba) () (para "Exception due to I/O problem with communication link with the Roomba."))) (provide exn:fail:roomba:mode?) (define-struct (exn:fail:roomba:io exn:fail:roomba) () #:transparent) (doc (defstruct* (exn:fail:roomba:mode exn:fail:roomba) ((expected (listof symbol?)) (actual symbol?)) (para "Exception due to attempting to use a command on the Roomba when it is not believed to be in the proper " (tech "mode") " for that command."))) (provide exn:fail:roomba:mode? exn:fail:roomba:mode-expected exn:fail:roomba:mode-actual) (define-struct (exn:fail:roomba:mode exn:fail:roomba) (expected actual) #:transparent) (doc (defstruct* (exn:fail:roomba:unsupported exn:fail:roomba) () (para "Exception due to attempting an operation not supported on this particular Roomba. For example, attempting " (racket start-roomba-demo) " on a Roomba 400 rather than on an iRobot Create."))) (provide exn:fail:roomba:mode?) (define-struct (exn:fail:roomba:unsupported exn:fail:roomba) () #:transparent) (doc (section "Protocols") (para "This package supports a few different Roomba " (deftech "protocols") ".")) (define (%roomba-protocol-struct-write-proc roomba port write?) (fprintf port "#" (roomba-protocol-struct-symbol roomba))) (doc (defproc (roomba-protocol? (any/c x)) boolean? (para "Predicate for a " (racket roomba-protocol) " object."))) (provide (rename-out (roomba-protocol-struct? roomba-protocol?))) (define-struct roomba-protocol-struct (symbol default-baud post-start-opcode) #:methods gen:custom-write ((define write-proc %roomba-protocol-struct-write-proc))) (doc (defthing roomba-sci roomba-protocol? (para (deftech "SCI") ", the protocol used by the Roomba second generation, especially the 400 series, described by " (hyperlink "http://www.usna.edu/Users/weapsys/esposito/roomba.matlab/Roomba_SCI.pdf" (italic "iRobot Roomba Serial Command Interface (SCI) Specification")) ", dated 2005.") (para "Note that not all second generation Roombas shipped with firmware that supports SCI, but reportedly all of them can be upgraded with 2.1 firmware. If the Roomba was not manufactured after October 2005, then search the Web for ``roomba firmware update'' for your particular model number. The update process will likely involve an iRobot OSMO dongle, or using the iRobot Scheduler Remote with a special cable). If you need help determining the model number or manufacturing date, see section " (secref "Models") " of this document."))) (provide roomba-sci) (define roomba-sci (make-roomba-protocol-struct 'roomba-sci 57600 130)) (doc (defthing roomba-roi roomba-protocol? (para (deftech "ROI") ", the protocol used by the Roomba 500 and 600 series, described by " (hyperlink "http://www.irobot.lv/uploaded_files/File/iRobot_Roomba_500_Open_Interface_Spec.pdf" (italic "iRobot Roomba 500 Open Interface (OI) Specification")) "."))) (provide roomba-roi) (define roomba-roi (make-roomba-protocol-struct 'roomba-roi 115200 131)) (doc (defthing roomba-coi roomba-protocol? (para (deftech "COI") ", the protocol used by the iRobot Create, described by " (hyperlink "http://www.irobot.com/filelibrary/pdfs/hrd/create/Create%20Open%20Interface_v2.pdf" (italic "iRobot Create Open Interface (OI) Specification")) ".") (para "Note that we say ``" (tt "roomba") "'' even though it's for a Create rather than a Roomba, due to the identifier naming convention of this package. And also, as Billy Joel might put it, to the tune of ``Always a Woman'':") (nested #:style 'inset (para (italic "It can talk with a beep, it has wall-sensing eyes" (linebreak) "It can ruin your day with low-batt'ry surprise" (linebreak) "But it brings out the best that your programs can be" (linebreak) "Oh, it doesn't clean floors, but it's always a Roomba to me"))))) (provide roomba-coi) (define roomba-coi (make-roomba-protocol-struct 'roomba-coi 57600 131)) (doc (section "Models") (para "A " (deftech "model") " refers to a particular manufactured model of Roomba or similar robot, such as the iRobot Create. This package defines a number of specific Roomba models, and you can also define your own.") (para "If you don't know which model of Roomba you have, or you need to know the manufacturing date, look for the serial number barcode label on the Roomba or the box. Given a serial number label like, for example, ``" (tt "JEN 04000 090620 08 00999") "'', the model number is given by the ``04000'', and the date is in the second group of digits: year 2009 (" (tt "09") " + 2000), month " (tt "06") ", day of month " (tt "20") ". The " (racket decode-roomba-manufacturing-code) " procedure can do this for you.") (para "As suggested in section " (secref "Protocols") ", this package works with most Roombas from the second generation, 500 series, and 600 series, as well as with the Create.") (para "This package does not presently work on the Roomba 700 series, since iRobot has not documented the protocol for that series, unlike for the 400, 500, and Create. However, a 700 user reported that it seems to provide a serial protocol similar to " (tech "SCI") ", " (tech "ROI") ", and " (tech "COI") ", but somewhat different, in a non-backward-compatible way. So, given access to a 700, the protocol might not be too hard to understand and support in a future version of this package. Realistically, someone who can afford a 700 series can probably also afford a $50 used 400 for hobby purposes, so 700 support seems a low priority. All that said, the author of this package welcomes expensive gifts at any time of year.") (para "Note that this package does not work on iRobot Scooba, even though the Scooba looks similar to a Roomba and has a mini-DIN connector, since the Scooba reportedly uses a different protocol than the Roombas and the Create. The Scooba's protocol might not even be for control, but only for firmware updating. The main reason we imagine for controlling a Scooba from Racket would be to make a robot puppy that uses the Scooba's liquid bladder.")) (doc (defproc (decode-roomba-manufacturing-code (str string?)) (listof (cons/c symbol? any/c)) (para "Decodes a manufacturing code from a barcode label found on the Roomba and its box, returning the information as a human-readable alist. For example:") (racketinput (decode-roomba-manufacturing-code "JEN041100610060012345")) (racketresultblock '((manufacturer . jetta) (status . new) (model . 4110) (date . #(2006 10 6)) (rev . 0) (serial . 12345))) (para "The decoding is based on information from a " (hyperlink "http://www.robotreviews.com/chat/viewtopic.php?f=1&t=16354#p110177" "2006-12-29 robotreviews.com post by newmom") "."))) (provide decode-roomba-manufacturing-code) (define decode-roomba-manufacturing-code (let ((rx (regexp (string-append "^" "([A-Z][A-Z])" "([RN])" "([0-9][0-9][0-9][0-9][0-9])" "([0-9][0-9])" "([0-9][0-9])" "([0-9][0-9])" "([0-9][0-9])" "([0-9][0-9][0-9][0-9][0-9])" "$")))) (lambda (str) (let ((str (string-upcase (regexp-replace* #rx"[ \t\r\n]+" str "")))) (cond ((regexp-match rx str) => (lambda (m) (apply (lambda (all mfgr status model year month mday rev serial) `((manufacturer . ,(or (hash-ref #hash(("JE" . jetta) ("PR" . prc)) mfgr #f) mfgr)) (status . ,(or (hash-ref #hash(("N" . new) ("R" . refurbished)) status #f) status)) (model . ,(string->number model)) (date . ,(vector (+ 2000 (string->number year)) (string->number month) (string->number mday))) (rev . ,(string->number rev)) (serial . ,(string->number serial)))) m))) (else (error 'decode-roomba-manufacturing-code "could not decode ~S" str))))))) (module+ test (test (decode-roomba-manufacturing-code "JEN 04000 090620 08 12345") '((manufacturer . jetta) (status . new) (model . 4000) (date . #(2009 6 20)) (rev . 8) (serial . 12345))) (test (decode-roomba-manufacturing-code "JEN041100610060012345") '((manufacturer . jetta) (status . new) (model . 4110) (date . #(2006 10 6)) (rev . 0) (serial . 12345)))) (define (%roomba-model-struct-write-proc roomba-model port write?) (fprintf port "#" (roomba-model-struct-number roomba-model))) (doc (defproc (roomba-model? (x any/c)) boolean? (para "Predicate for a Roomba model."))) (provide (rename-out (roomba-model-struct? roomba-model?) (roomba-model-struct-number roomba-model-number) (roomba-model-struct-generation roomba-model-generation) (roomba-model-struct-protocol roomba-model-protocol))) (define-struct roomba-model-struct (number generation protocol) #:methods gen:custom-write ((define write-proc %roomba-model-struct-write-proc))) (doc (defproc (make-roomba-model (#:number number (or/c exact-nonnegative-integer? symbol?)) (#:generation generation (or/c #f 1 2 3 4)) (#:protocol protocol roomba-protocol?)) roomba-model? (para "Make a new " (racket roomba-model) " object, for situations in which this package does not already provide an appropriate pre-defined object. (Perhaps you will also email the author/maintainer of this package, so that the model can be added for everyone else.)"))) (provide (rename-out (%make-roomba-model/kw make-roomba-model))) (define (%make-roomba-model/kw #:number number #:generation generation #:protocol protocol) (make-roomba-model-struct number generation protocol)) (doc (defparam current-number-to-roomba-model-hash hasheqv (hash/c (or/c exact-nonnegative-integer? symbol?) roomba-model?) (para "Parameter for a hash that maps Roomba model numbers to " (racket roomba-model) " objects. By default, it is populated with the following model numbers:") (itemlist (item "Second Generation --- " (racket 'second-generation 1100 'series-4000 'series-400 4000 400 4100 410 4105 416 4110 'sagelike-4130 'discolike-4130 4150 4170 4188 4210 4220 4225 4230 4260)) (item "500 Series --- " (racket 'series-500 510 530 532 535 550 560 562 564 570 571 572 580 581)) (item "600 Series --- " (racket 'series-600 610 620 630 650 660)) (item "Create --- " (racket 'create 4400 4418))) (para "Note that some second generations need a firmware update before they'll work with this package. See the documentation for " (racket roomba-sci) ".") (para "The list of model numbers is mostly based on the ``" (hyperlink "http://en.wikipedia.org/wiki/Roomba#List_of_models" "List of models") "'' section of the Wikipedia page on Roomba."))) (provide current-number-to-roomba-model-hash) (define current-number-to-roomba-model-hash (make-parameter (make-immutable-hasheqv (map (lambda (model) (cons (roomba-model-struct-number model) model)) (list ;; (make-roomba-model-struct 'second-generation 2 roomba-sci) (make-roomba-model-struct 1100 2 roomba-sci) (make-roomba-model-struct 'series-4000 2 roomba-sci) (make-roomba-model-struct 'series-400 2 roomba-sci) (make-roomba-model-struct 4000 2 roomba-sci) (make-roomba-model-struct 400 2 roomba-sci) (make-roomba-model-struct 4100 2 roomba-sci) (make-roomba-model-struct 410 2 roomba-sci) (make-roomba-model-struct 4105 2 roomba-sci) (make-roomba-model-struct 416 2 roomba-sci) (make-roomba-model-struct 4110 2 roomba-sci) (make-roomba-model-struct 'sagelike-4130 2 roomba-sci) (make-roomba-model-struct 'discolike-4130 2 roomba-sci) (make-roomba-model-struct 4150 2 roomba-sci) (make-roomba-model-struct 4170 2 roomba-sci) (make-roomba-model-struct 4188 2 roomba-sci) (make-roomba-model-struct 4210 2 roomba-sci) (make-roomba-model-struct 4220 2 roomba-sci) (make-roomba-model-struct 4225 2 roomba-sci) (make-roomba-model-struct 4230 2 roomba-sci) (make-roomba-model-struct 4260 2 roomba-sci) ;; (make-roomba-model-struct 'series-500 3 roomba-roi) (make-roomba-model-struct 510 3 roomba-roi) (make-roomba-model-struct 530 3 roomba-roi) (make-roomba-model-struct 532 3 roomba-roi) (make-roomba-model-struct 535 3 roomba-roi) (make-roomba-model-struct 550 3 roomba-roi) (make-roomba-model-struct 560 3 roomba-roi) (make-roomba-model-struct 562 3 roomba-roi) (make-roomba-model-struct 564 3 roomba-roi) (make-roomba-model-struct 570 3 roomba-roi) (make-roomba-model-struct 571 3 roomba-roi) (make-roomba-model-struct 572 3 roomba-roi) (make-roomba-model-struct 580 3 roomba-roi) (make-roomba-model-struct 581 3 roomba-roi) ;; (make-roomba-model-struct 'series-600 3 roomba-roi) (make-roomba-model-struct 610 3 roomba-roi) (make-roomba-model-struct 620 3 roomba-roi) (make-roomba-model-struct 630 3 roomba-roi) (make-roomba-model-struct 650 3 roomba-roi) (make-roomba-model-struct 660 3 roomba-roi) ;; create (make-roomba-model-struct 'create 2 roomba-coi) (make-roomba-model-struct 4400 2 roomba-coi) (make-roomba-model-struct 4418 2 roomba-coi) ;; ))))) (doc (defparam current-default-roomba-model model (or/c roomba-model? exact-nonnegative-integer? symbol?)) (para "Parameter for the default " (racket roomba-model) ", which is used by " (racket open-roomba) ", " (racket with-roomba) ", and perhaps other procedures and syntax. The default value of this is " (racket 'create) ", meaning the iRobot Create platform in general. You might wish to change this parameter to something else, like " (racket 'second-generation) " or an exact model number.")) (provide current-default-roomba-model) (define current-default-roomba-model (make-parameter 'create)) (define (%resolve-roomba-model-or-number model #:error-name (error-name '%resolve-roomba-model-or-number)) (if (roomba-model-struct? model) model (hash-ref (current-number-to-roomba-model-hash) model (lambda () (error error-name "invalid roomba-model or number: ~S" model))))) (module+ test (test (format "~S" (%resolve-roomba-model-or-number 400)) "#") (test (format "~S" (%resolve-roomba-model-or-number 'create)) "#")) (doc (section "Roomba Object") (para "There is a " (racket roomba) " object that represents a connection to the robot. This can be an explicit argument to each operation on the robot, but there is also a " (racket current-roomba) " Racket parameter that is the default robot when it is not given as an argument.")) (define (%roomba-struct-write-proc roomba port write?) (fprintf port "#" (cond ((roomba-struct-name roomba) => (lambda (x) x)) ((roomba-struct-model roomba) => roomba-model-struct-number) (else #f)) (roomba-struct-mode roomba))) (doc (defproc (roomba? (x any/c)) boolean? (para "Predicate for the " (racket roomba) " object."))) (provide (rename-out (roomba-struct? roomba?))) (define-struct roomba-struct ((name) (model) (protocol) (protocol-symbol) (device) (in) (out) (mode #:mutable)) #:methods gen:custom-write ((define write-proc %roomba-struct-write-proc))) (doc (defproc (get-roomba-name (#:roomba roomba roomba? (current-roomba))) roomba-name? (para "Returns the current name of the " (racket roomba) ", as supplied by the optional " (racket #:name) " argument to a procedure like " (racket open-roomba) "."))) (provide get-roomba-name) (define (get-roomba-name #:roomba (roomba (current-roomba))) (roomba-struct-name roomba)) (doc (defparam current-roomba roomba roomba? (para "Parameter for the " (racket roomba) " that is the default for command procedures. This parameter is usually set automatically by " (racket open-roomba) ", but can also be set manually, like a normal Racket parameter."))) (provide current-roomba) (define current-roomba (make-parameter #f)) (define-syntax (%roomba-protocol-ecase stx) (syntax-case stx () ((_ #:error-name ERROR-NAME #:roomba ROOMBA #:cases CASE0 CASE1 ...) #'(let* ((roomba ROOMBA) (proto (roomba-struct-protocol-symbol roomba))) (case proto CASE0 CASE1 ... (else (raise (make-exn:fail:roomba:unsupported (format "~S: not supported on ~S in protocol ~S" ERROR-NAME roomba proto) (current-continuation-marks) roomba)))))))) (doc (section "Opening and Closing")) (doc (defparam current-default-roomba-device path path-string? (para "Parameter that is the default " (deftech "device") ", which is normally a special operating system device file for the serial port device through which the Roomba is accessed. This parameter defaults to a value like " (racket "/dev/ttyUSB0") ", depending on the Racket platform."))) (provide current-default-roomba-device) (define current-default-roomba-device ;; TODO: Determine appropriate default serial port for Mac OS X. (make-parameter (case (system-type 'os) ((macosx) "/dev/tty.usbserial") (else "/dev/ttyUSB0")))) (define (%roomba-args-int16 error-name variable-name arg) (if (and (integer? arg) (<= -32768 arg 32767)) (let ((arg (if (exact? arg) arg (inexact->exact arg)))) (let ((bstr (integer->integer-bytes arg 2 #true #true))) (values (bytes-ref bstr 0) (bytes-ref bstr 1)))) (error error-name "expected ~S to be 16-bit integer, but was ~S" variable-name arg))) (module+ test (test-section '%roomba-args-int16 (test 'from-sci-spec-1 (%roomba-args-int16 'my-error-name 'my-variable-name -200) (values #xff #x38)) (test 'from-sci-spec-2 (%roomba-args-int16 'my-error-name 'my-variable-name 500) (values #x01 #xf4)))) (define (%roomba-args-one error-name variable-name arg permissible) (if (member arg permissible) arg (error error-name "expected ~S to be one of ~S, but was ~S" variable-name permissible arg))) (define (%roomba-arg-fraction-0-to-1 error-name variable-name arg) (if (and (number? arg) (<= 0 arg 1)) arg (error error-name "expected ~S to be a number between 0 and 1, inclusive, but was ~S" variable-name arg))) (define (%roomba-arg-byte error-name variable-name arg) (if (byte? arg) arg (error error-name "expected ~S to be a byte, but was ~S" variable-name arg))) (define (%roomba-arg-pwm-128 error-name variable-name arg) (exact->inexact (truncate (* (%roomba-arg-fraction-0-to-1 error-name variable-name arg) 128)))) (define (%roomba-arg-song-number error-name variable-name arg) (if (and (integer? arg) (<= 0 arg 15)) arg (error error-name "expected ~S to be a valid song number (0-15), was ~S" variable-name arg))) (define (%roomba-mode-change-with-delay roomba mode) (log-roomba-debug "(%roomba-mode-change-with-delay ~S ~S)" roomba mode) (set-roomba-struct-mode! roomba mode) ;; Note: Per the SCI spec, we ``allow 20 milliseconds between sending ;; commands that change the SCI mode.'' (sleep 30/1000)) (define (%assert-roomba-mode error-name roomba expected-modes) (let ((actual-mode (roomba-struct-mode roomba))) (if (memq actual-mode expected-modes) (void) (raise (make-exn:fail:roomba:mode (format "~S: expected ~S to be in modes ~S, but was actually in mode ~S" error-name roomba expected-modes actual-mode) (current-continuation-marks) roomba expected-modes actual-mode))))) (define (%send-byte-to-roomba roomba command-byte) (log-roomba-debug "(%send-byte-to-roomba ~S ~S)" roomba command-byte) (with-handlers* ((exn:fail? (lambda (e) (close-roomba #:roomba roomba) (raise (make-exn:fail:roomba:io (format "%send-byte-to-roomba: error sending ~S command ~S: ~A" roomba command-byte (exn-message e)) (exn-continuation-marks e) roomba))))) (let ((out (roomba-struct-out roomba))) (write-byte command-byte out) (flush-output out)))) (define (%send-byte-string-to-roomba roomba command-bytes) (log-roomba-debug "(%send-byte-string-to-roomba ~S ~S)" roomba command-bytes) (with-handlers* ((exn:fail? (lambda (e) (close-roomba #:roomba roomba) (raise (make-exn:fail:roomba:io (format "%send-byte-string-to-roomba: error sending ~S command ~S: ~A" roomba command-bytes (exn-message e)) (exn-continuation-marks e) roomba))))) (let ((out (roomba-struct-out roomba))) (write-bytes command-bytes out) (flush-output out)))) (define (%send-byte-list-to-roomba roomba byte-list) (log-roomba-debug "(%send-byte-list-to-roomba ~S ~S)" roomba byte-list) (%send-byte-string-to-roomba roomba (apply bytes byte-list))) (define (%read-byte-string-from-roomba roomba read-size) (log-roomba-debug "(%read-byte-string-from-roomba ~S ~S)" roomba read-size) (with-handlers* ((exn:fail? (lambda (e) (close-roomba #:roomba roomba) (raise (make-exn:fail:roomba:io (format "%read-byte-string-from-roomba: error reading ~S bytes from ~S: ~A" read-size roomba (exn-message e)) (exn-continuation-marks e) roomba))))) (read-bytes read-size (roomba-struct-in roomba)))) (define (%get-roomba-stty-minus-f-arg-string) (case (system-type 'os) ((macosx) "-f") (else "-F"))) (doc (defproc (open-roomba (#:name name (or/c #f string?) #f) (#:model model (or/c roomba-model? exact-nonnegative-integer? symbol?) (current-roomba-default-model)) (#:device device path-string? (current-default-roomba-device)) (#:set-current? set-current? boolean? #true)) roomba) (para "Opens a connection to a Roomba, and returns an object for the connection. If " (racket set-current?) " is true, then " (racket current-roomba) " is also set to the object.")) (provide open-roomba) (define (open-roomba #:name (name #f) #:model (model (current-default-roomba-model)) #:device (device (current-default-roomba-device)) #:set-current? (set-current? #true)) (log-roomba-debug "(open-roomba #:device ~S #:set-current? ~S)" device set-current?) ;; TODO: Distinguish device baud and Roomba baud, such as with Rootooth. ;; Maybe make the device-* constants below be arguments. (let* ((model (%resolve-roomba-model-or-number model #:error-name 'open-roomba)) (device (path->string (cleanse-path device))) (protocol (roomba-model-struct-protocol model)) (device-baud (roomba-protocol-struct-default-baud protocol)) (device-data-bits 8) (device-parity #false) (device-stop-bits 1) (args `("/bin/stty" ,(%get-roomba-stty-minus-f-arg-string) ,device ,(number->string device-baud) "raw" "-echo" "clocal" ,(string-append "cs" (number->string device-data-bits)) ,@(if device-parity `("parenb" ,(case device-parity ((even) "-parodd") ((odd) "parodd") (else (error 'open-roomba "invalid device-parity ~S" device-parity)))) '("-parenb" "-parodd")) ,(case device-stop-bits ((1) "-cstopb") ((2) "cstopb") (else (error 'open-roomba "invalid device-stop-bits ~S" device-stop-bits))) "-hupcl" "-crtscts" "-onlcr" "-iexten" "-echok" "-echoe" "-echoctl" "-echoke" ))) (log-roomba-debug "open-roomba: initializing device with command ~S" args) ;; TODO: Make a generalized fancy system package and use that instead, to get stderr. (or (apply system* args) (error 'open-roomba "stty ~S failed" device)) (log-roomba-debug "open-roomba: opening device file") (let-values (((in out) (with-handlers* ((exn:fail? (lambda (e) (with-handlers ((exn:fail? void)) ;; TODO: !!! Figure ;; out what to do ;; here, and make ;; sure it doesn't ;; send anything to ;; the Roomba. ;; ;; (system* "/bin/stty" ;; (%get-roomba-stty-minus-f-arg-string) ;; device ;; "sane") (raise e))))) (open-input-output-file device #:exists 'update)))) (log-roomba-debug "open-roomba: device file is open") ;; TODO: Do we actually need to turn off buffering? (file-stream-buffer-mode in 'none) (file-stream-buffer-mode out 'none) (let* ((protocol (roomba-model-struct-protocol model)) (roomba (make-roomba-struct name model protocol (roomba-protocol-struct-symbol protocol) device in out #f))) ;; TODO: do we really need this 500ms delay? (log-roomba-debug "open-roomba: pausing 500ms") (sleep 500/1000) (log-roomba-debug "open-roomba: sending start command") (%send-byte-to-roomba roomba 128) (%roomba-mode-change-with-delay roomba 'passive) (log-roomba-debug "open-roomba: sending safe/control command") (%send-byte-to-roomba roomba (roomba-protocol-struct-post-start-opcode protocol)) (%roomba-mode-change-with-delay roomba 'safe) ;; Note: We've not yet seen pre-existing input. This code was originally added because, at Create power-on, ;; the iRobot serial cable LEDs show transmit activity from the Create side. (log-roomba-debug "open-roomba: consuming any pre-existing input") (and (byte-ready? in) (let* ((buf-size 2048) (buf-bytes (make-bytes buf-size))) (let loop () (let ((read-count (read-bytes-avail!/enable-break buf-bytes in 0 buf-size))) (or (zero? read-count) (begin (log-roomba-warning "open-roomba: pre-existing input ~S" (subbytes buf-bytes 0 read-count)) (loop))))))) (if set-current? (begin (log-roomba-debug "open-roomba: setting current-roomba") (current-roomba roomba)) (log-roomba-debug "open-roomba: not setting current-roomba")) (log-roomba-debug "open-roomba: returning") roomba)))) (doc (defproc (close-roomba (#:roomba roomba roomba? (current-roomba))) void? (para "Closes the connection to the Roomba, if not already closed. Changes the " (tech "mode") " to " (racket 'closed) "."))) (provide close-roomba) (define (close-roomba #:roomba (roomba (current-roomba))) (log-roomba-debug "(close-roomba #:roomba ~S)" roomba) (if (eq? 'closed (roomba-struct-mode roomba)) (log-roomba-warning "close-roomba: already closed") (begin (set-roomba-struct-mode! roomba 'closed) (with-handlers ((exn:fail? (lambda (e) (log-roomba-warning "close-roomba: error closing input port: ~S" (exn-message e))))) (close-input-port (roomba-struct-in roomba))) (with-handlers ((exn:fail? (lambda (e) (log-roomba-warning "close-roomba: error closing output port: ~S" (exn-message e))))) (close-output-port (roomba-struct-out roomba))) ;; TODO: !!! attempt stty sane here, like in open-roomba. (or ;; maybe "sane" is not the thing to use) ))) (doc (defform (with-roomba maybe-name maybe-model maybe-device body ...+) #:grammar ((maybe-name code:blank (code:line #:name string?)) (maybe-model code:blank (code:line #:model (or/c roomba-model? exact-nonnegative-integer? symbol?))) (maybe-device code:blank (code:line #:device string?))) (para "This is a convenience for calling " (racket open-roomba) " and " (racket close-roomba) ". In most cases, " (racket close-roomba) " will be called even if the body is exited due to an exception."))) (provide with-roomba) (define-syntax (with-roomba stx) (syntax-parse stx ((_ (~optional (~seq #:name NAME)) (~optional (~seq #:model MODEL)) (~optional (~seq #:device DEVICE)) BODYn ...+) (with-syntax ((NAME (or (attribute NAME) (syntax/loc stx #f))) (MODEL (or (attribute MODEL) (syntax/loc stx (current-default-roomba-model)))) (DEVICE (or (attribute DEVICE) (syntax/loc stx (current-default-roomba-device))))) #'(let ((roomba (open-roomba #:name NAME #:model (%resolve-roomba-model-or-number MODEL #:error-name 'with-roomba) #:device DEVICE #:set-current? #false))) (dynamic-wind void (lambda () (parameterize ((current-roomba roomba)) BODYn ...)) (lambda () (close-roomba #:roomba roomba)))))))) (doc (section "Modes") (para "A Roomba " (deftech "mode") " is a general operating mode of the Roomba. The modes are identified in this package by a symbol:") (itemlist (item (racket 'off) " --- Powered off or sleeping, and you probably need to manually press a button to wake it up.") (item (racket 'passive) " --- Sensors can be read, but cannot be controlled in this mode.") (item (racket 'safe) " --- Can be controlled. Lift and cliff sensors, or plugging into charger, " (italic "do") " trigger switch to " (racket 'passive) " mode. " (racket 'safe) " is the usual mode for most purposes.") (item (racket 'full) " --- Can be controlled. Lift and cliff sensors, and charger plugging do " (italic "not") " switch Roomba to " (racket 'passive) " mode. Switching to " (racket 'full) " mode also stops any battery charging. Don't use " (racket 'full) " mode unless you're sure you need to, and you can cover the safety risks other ways.") (item (racket 'closed) " --- This connection with the Roomba is closed, so this connection does not know the mode. The mode is changed to this when " (racket close-roomba) " is called, when " (racket with-roomba) " exits, or when an I/O error occurs when attempting to talk with the Roomba."))) (doc (defproc (roomba-mode? (x any/c)) boolean? (para "Predicate for " (tech "mode") "."))) (provide roomba-mode?) (define (roomba-mode? x) (and (member x '(off passive safe full)) #true)) (doc (defproc (get-roomba-mode (#:roomba roomba roomba? (current-roomba))) roomba-mode? (para "Returns the current " (tech "mode") " of the Roomba, as cached in the " (racket roomba) " object (without talking to the robot)."))) (provide get-roomba-mode) (define (get-roomba-mode #:roomba (roomba (current-roomba))) (roomba-struct-mode roomba)) ;; TODO: Have a get-roomba-mode-from-roomba (in roomba-roi, it can use packet ;; 35 sensor read. Make it not work talk to roomba if cached mode is "closed", ;; of coure. (doc (defproc (set-roomba-mode (#:roomba roomba roomba? (current-roomba)) (#:mode mode (or/c 'safe 'full 'off))) void? (para "Changes the " (tech "mode") " of the Roomba. This sends mode change commands to the Roomba, not merely changes the believed mode in the " (racket roomba) " object. Works in modes: " (racket 'passive) ", " (racket 'safe) ", " (racket 'full) "."))) (provide set-roomba-mode) (define (set-roomba-mode #:roomba (roomba (current-roomba)) #:mode mode) (log-roomba-debug "(set-roomba-mode #:roomba ~S #:mode ~S)" roomba mode) (%assert-roomba-mode 'set-roomba-mode roomba '(passive safe full)) (case mode ((safe) (%send-byte-to-roomba roomba 131) (%roomba-mode-change-with-delay roomba 'safe)) ((full) (%send-byte-to-roomba roomba 132) (%roomba-mode-change-with-delay roomba 'full)) ((off) (%send-byte-to-roomba roomba 133) (%roomba-mode-change-with-delay roomba 'off)) (else (error 'set-roomba-mode "invalid mode ~S" mode)))) (doc (section "Stock Behaviors")) (doc (subsection "Cleaning")) (doc (defproc (start-roomba-spot-clean (#:roomba roomba roomba? (current-roomba))) void? (para "Like pressing the Spot button, starts a spot-cleaning, and switches to " (racket 'passive) " mode. Works in modes: " (racket 'safe) ", " (racket 'full) "."))) (provide start-roomba-spot-clean) (define (start-roomba-spot-clean #:roomba (roomba (current-roomba))) (log-roomba-debug "(start-roomba-spot-clean #:roomba ~S)" roomba) (%assert-roomba-mode 'start-roomba-spot-clean roomba '(safe full)) (%send-byte-to-roomba roomba 134) (%roomba-mode-change-with-delay roomba 'passive)) (doc (defproc (start-roomba-clean (#:roomba roomba roomba? (current-roomba))) void? (para "Like pressing the Clean button, starts a normal cleaning cycle, and switches to " (racket 'passive) " mode. Works in modes: " (racket 'safe) ", " (racket 'full) "."))) (provide start-roomba-clean) (define (start-roomba-clean #:roomba (roomba (current-roomba))) (log-roomba-debug "(start-roomba-clean #:roomba ~S)" roomba) (%assert-roomba-mode 'roomba-clean roomba '(safe full)) (%send-byte-to-roomba roomba 135) (%roomba-mode-change-with-delay roomba 'passive)) (doc (defproc (start-roomba-max-clean (#:roomba roomba roomba? (current-roomba))) void? (para "Like pressing the Max button, starts a maximum-time cleaning cycle, and switches to " (racket 'passive) " mode. Works in modes: " (racket 'safe) ", " (racket 'full) "."))) (provide start-roomba-max-clean) (define (start-roomba-max-clean #:roomba (roomba (current-roomba))) (log-roomba-debug "(start-roomba-max-clean #:roomba ~S)" roomba) (%assert-roomba-mode 'start-roomba-max-clean roomba '(safe full)) (%send-byte-to-roomba roomba 136) (%roomba-mode-change-with-delay roomba 'passive)) (doc (subsection "Docking")) (doc (defproc (start-roomba-seek-dock (#:roomba roomba roomba? (current-roomba))) void? (para "Directs the Roomba to start seeking its dock. This might only work during some kind of cleaning cycle."))) ;; TODO: What does this do to the mode? passive? (provide start-roomba-seek-dock) (define (start-roomba-seek-dock #:roomba (roomba (current-roomba))) (log-roomba-debug "(start-roomba-seek-dock #:roomba ~S)" roomba) (%assert-roomba-mode 'start-roomba-max-clean roomba '(safe full)) (%send-byte-to-roomba roomba 143)) (doc (subsection "Demos")) (doc (defproc (start-roomba-demo (#:roomba roomba roomba? (current-roomba)) (#:demo demo symbol? #f)) void? (para "Start one of the iRobot Create demos, where " (racket demo) " is one of the symbols:") (nested #:style 'inset (tabular #:sep (hspace 2) (list (list (racket 'cover) "Drive around to cover room.") (list (racket 'cover-and-dock) "Cover room, until see Home Base, then dock.") (list (racket 'spot-cover) "Cover room with spiral.") (list (racket 'mouse) "Follows walls.") (list (racket 'figure-eight) "Drive in figure-eight.") (list (racket 'wimp) "Flees when bumped.") (list (racket 'home) "(See Create manual.)") (list (racket 'tag) "(See Create manual.)") (list (racket 'pachelbel) "Plays Pachelbel's Canon for cliff sensors.") (list (racket 'banjo) "Plays notes for cliff and bump sensors.")))) (para "Starting a demo changes mode to " (racket 'passive) ". Works in protocols: " (tech "COI") ". Works in modes: " (racket 'passive) ", " (racket 'safe) ", " (racket 'full) "."))) (provide start-roomba-demo) (define (start-roomba-demo #:roomba (roomba (current-roomba)) #:demo (demo #f)) (log-roomba-debug "(start-roomba-demo #:roomba ~S #:demo ~S)" roomba demo) (%roomba-protocol-ecase #:error-name 'start-roomba-demo #:roomba roomba #:cases ((roomba-coi) (%assert-roomba-mode 'start-roomba-demo roomba '(passive safe full)) (let* ((demo (or demo 'cover-and-dock)) (demo-byte (case demo ((cover) 0) ((cover-and-dock) 1) ((spot-cover) 2) ((mouse) 3) ((figure-eight) 4) ((wimp) 5) ((home) 6) ((tag) 7) ((pachelbel) 8) ((banjo) 9) (else (error 'start-roomba-demo "invalid demo ~S" demo))))) (%send-byte-string-to-roomba roomba (bytes 136 demo-byte)) (%roomba-mode-change-with-delay roomba 'passive))))) (doc (defproc (stop-roomba-demo (#:roomba roomba roomba? (current-roomba))) void? (para "Stop the current iRobot Create demo that is playing. Works in modes: " (racket 'passive) ", " (racket 'safe) ", " (racket 'full) "."))) (provide stop-roomba-demo) (define (stop-roomba-demo #:roomba (roomba (current-roomba))) (log-roomba-debug "(stop-roomba-demo #:roomba ~S)" roomba) (%roomba-protocol-ecase #:error-name 'stop-roomba-demo #:roomba roomba #:cases ((roomba-coi) (%assert-roomba-mode 'stop-roomba-demo roomba '(passive safe full)) (%send-byte-string-to-roomba roomba (bytes 136 -1)) (%roomba-mode-change-with-delay roomba 'passive)))) (doc (section "Driving")) (doc (defproc (set-roomba-drive (#:roomba roomba roomba? (current-roomba)) (#:velocity-mm/s velocity-mm/s integer?) (#:radius-mm radius-mm ((or/c #f integer?) #f))) void? (para "Sets the drive speed and turning radius of the Roomba.") (para (racket velocity-mm/s) " is the velocity in millimeters per second, with a range of " (racket -500) " to " (racket +500) ", with negative numbers meaning to drive in reverse.") (para (racket radius-mm) " is the turning radius in millimeters, with a range of " (racket -2000) " to " (racket +2000) ", or " (racket #f) ", meaning straight. Works in modes: " (racket 'safe) ", " (racket 'full) "."))) (provide set-roomba-drive) (define (set-roomba-drive #:roomba (roomba (current-roomba)) #:velocity-mm/s velocity-mm/s #:radius-mm (radius-mm #f)) (log-roomba-debug "(set-roomba-drive #:roomba ~S #:velocity-mm/s ~S #:radius-mm ~S)" roomba velocity-mm/s radius-mm) (%assert-roomba-mode 'set-roomba-drive roomba '(safe full)) (let-values (((velocity-1 velocity-2) (%roomba-args-int16 'set-roomba-drive 'velocity-mm/s velocity-mm/s)) ((radius-1 radius-2) (if radius-mm (%roomba-args-int16 'set-roomba-drive 'radius-mm radius-mm) (values #x80 #x00)))) (%send-byte-string-to-roomba roomba (bytes 137 velocity-1 velocity-2 radius-1 radius-2)))) (doc (defproc (set-roomba-wheels (#:roomba roomba roomba? (current-roomba)) (#:left-mm/s left-mm/s integer?) (#:right-mm/s right-mm/s integer?)) void? (para "Sets the drive speed of the left and right wheels of the Roomba. Each is specified in in millimeters per second, with a range of " (racket -500) " to " (racket +500) ", and with negative numbers meaning to drive that wheel in reverse. This is a lower-level alternative to " (racket set-roomba-drive) ". Works in protocols: " (tech "COI") ". Works in modes: " (racket 'safe) ", " (racket 'full) "."))) (provide set-roomba-wheels) (define (set-roomba-wheels #:roomba (roomba (current-roomba)) #:left-mm/s left-mm/s #:right-mm/s right-mm/s) (log-roomba-debug "(set-roomba-wheels #:roomba ~S #:left-mm/s ~S #:right-mm/s ~S)" roomba left-mm/s right-mm/s) (%roomba-protocol-ecase #:error-name 'set-roomba-wheels #:roomba roomba #:cases ((roomba-coi) (%assert-roomba-mode 'set-roomba-wheels roomba '(safe full)) (let-values (((left-1 left-2) (%roomba-args-int16 'set-roomba-wheels 'left-mm/s left-mm/s)) ((right-1 right-2) (%roomba-args-int16 'set-roomba-wheels 'right-mm/s right-mm/s))) (%send-byte-string-to-roomba roomba (bytes 145 right-1 right-2 left-1 left-2)))))) (doc (section "Motors")) (doc (defproc (set-roomba-motors (#:roomba roomba roomba? (current-roomba)) (#:side-brush? side-brush? boolean? #false) (#:vacuum? vacuum? boolean? #false) (#:main-brush? main-brush? boolean? #false)) void? (para "Sets the on/off states of each of the Roomba's motors, other than the drive motors. When they keyword argument for a motor is not provided, the default is " (racket #false) " (i.e., off)."))) (provide set-roomba-motors) (define (set-roomba-motors #:roomba (roomba (current-roomba)) #:side-brush? (side-brush? #false) #:vacuum? (vacuum? #false) #:main-brush? (main-brush? #false)) ;; TODO: For roomba-roi, add #:side-brush-clockwise? and #:main-brush-outward? (log-roomba-debug "(set-roomba-motors #:roomba ~S #:side-brush? ~S #:vacuum? ~S #:main-brush ~S)" roomba side-brush? vacuum? main-brush?) (%assert-roomba-mode 'set-roomba-motors roomba '(safe full)) (%send-byte-string-to-roomba roomba (bytes 138 (bitwise-ior (if side-brush? #b001 0) (if vacuum? #b010 0) (if main-brush? #b100 0))))) (doc (section "Lights")) (doc (defproc (set-roomba-leds (#:roomba roomba roomba? (current-roomba)) (#:debris? debris? boolean? #false) (#:max? max? boolean? #false) (#:clean? clean? boolean? #false) (#:spot? spot? boolean? #false) (#:dock? dock? boolean? #false) (#:check? check? boolean? #false) (#:play? play? boolean? #false) (#:advance? advance? boolean? #false) (#:status status (or/c #f 'red 'green 'amber) #false) (#:power-color power-color byte? 0) (#:power-intensity power-intensity byte? 0)) void? (para "Sets the states of all the LEDs on the Roomba at once.") (para "The follow table shows which series of Roomba " (tech "models") " support which variables, and how the corresponding LEDs are usually labeled. Note that not all models of a series have all LEDs that the series supports. Attempting to set a non-existent LED through this procedure has no effect, not even a warning.") (nested #:style 'inset (tabular #:sep (hspace 2) (list (list (bold "Variable") (bold "Labels") (bold "Series")) (list (racket debris?) "Dirt Detect, Dirt Alert, Debris" "2nd, 500, 600") (list (racket max?) "Max" "2nd") (list (racket clean?) "Clean" "2nd") (list (racket spot?) "Spot" "2nd, 500, 600") (list (racket dock?) "Dock" "500, 600") (list (racket check?) "Check Robot" "500, 600") (list (racket play?) "Play" "Create") (list (racket advance?) "Advance" "Create") (list (racket status) "Status" "2nd") (list (elem (racket power-color) ", " (linebreak) (racket power-intensity)) "Power (Clean)" "2nd, 500, Create")))) (para "The Boolean LEDs are self-explanatory.") (para (racket status) " is one of 3 colors, or " (racket #f) " for off.") (para (racket power-color) " is a value from 0 to 255, representing a color from green to red.") ;; TODO: Have symbols as an alternate way of specifying power-color? (para (racket power-intensity) " is a value from 0 to 255, representing a range from off to full intensity.") (para "Note that not all Roomba models have all these LEDs. The LEDs that they do have might be labeled differently between models."))) (provide set-roomba-leds) (define (set-roomba-leds #:roomba (roomba (current-roomba)) #:debris? (debris? #false) #:max? (max? #false) #:clean? (clean? #false) #:spot? (spot? #false) #:dock? (dock? #false) #:check? (check? #false) #:play? (play? #false) #:advance? (advance? #false) #:status (status #false) #:power-color (power-color 0) #:power-intensity (power-intensity 0)) (log-roomba-debug "(set-roomba-leds #:roomba ~S #:debris? ~S #:max? ~S #:play? ~S #:clean? ~S #:spot? ~S #:advance? ~S #:status ~S #:power-color ~S #:power-intensity ~S)" roomba debris? max? play? clean? spot? advance? status power-color power-intensity) (%assert-roomba-mode 'set-roomba-leds roomba '(safe full)) ;; TODO: Distinguish different models or at least protocols, so that which ;; LEDs are turned on is more accurate. For example, if someone says "#:max" ;; but not "#:play", and we're on an Create, it doesn't make sense to turn on ;; the Play LED. (%send-byte-string-to-roomba roomba (bytes 139 (let ((proto (roomba-struct-protocol-symbol roomba))) (case proto ((roomba-sci) (bitwise-ior (if debris? #b00000001 0) (if max? #b00000010 0) (if clean? #b00000100 0) (if spot? #b00001000 0) (case status ((#f) 0) ((red) #b00010000) ((green) #b00100000) ((amber) #b00110000) (else (error 'set-roomba-leds "invalid status ~S" status))))) ((roomba-roi) (bitwise-ior (if debris? #b00000001 0) (if spot? #b00000010 0) (if dock? #b00000100 0) (if check? #b00001000 0))) ((roomba-coi) (bitwise-ior (if play? #b00000010 0) (if advance? #b00001000 0))) (else (error 'set-roomba-leds "invalid roomba-protocol-symbol ~S" proto)))) power-color ;; TODO: error-check power-intensity ;; TODO: error-check ))) (doc (section "Sound") (para "The Roomba permits short songs by stored in numbered memory slots and then played back on command. The songs consist of single-voice notes with durations, and the volume is fixed.") (para "This library provides a " (deftech "song language") " for describing songs to be stored, with the BNF grammar:") (BNF (list (nonterm "song-language") (BNF-seq (litchar "(") (kleeneplus (nonterm "note")) (litchar ")"))) (list (nonterm "note") (nonterm "frequency") (BNF-seq (litchar "(") (nonterm "frequency") (nonterm "duration") (litchar ")"))) (list (nonterm "frequency") (italic (racket symbol?)) (italic (racket number?))) (list (nonterm "duration") (litchar "whole") (litchar "w") (litchar "half") (litchar "h") (litchar "quarter") (litchar "q") (italic (racket number?)))) (para "For " (nonterm "frequency") ", usually you will use a symbol like " (racket 'c4) " or " (racket 'cs4) ", in the manner of " (hyperlink "http://en.wikipedia.org/wiki/Common_Music_Notation" "Common Music Notation") " (CMN). You can also use single-letter note symbols, like " (racket 'c) ". If a number is given, it's the frequency that this library tries to approximate on the Roomba.") (para "For " (nonterm "duration") ", symbols like " (racket 'whole) " and " (racket 'h) " denote whole and half notes, respectively. If the duration for a note is not given, a quarter note is assumed. If the duration is given as a number, it's in 64ths of a second.") (para "For example, here's a start of Mary Had a Little Lamb:") (racketblock '(b a g a b b (b h) a a (a h) b d (d h)))) (doc (defproc (roomba-song-language? (x any/c)) boolean? (para "Predicate for " (tech "song language") ". This predicate does not necessarily do a complete check of " (racket x) ", and is mainly here for documentation purposes."))) (provide roomba-song-language?) (define (roomba-song-language? x) (pair? x)) (doc (defproc (roomba-song-number? (x any/c)) boolean? (para "Predicate for " (deftech "song number") ", which is an exact nonnegative integer in the range of 0 to 15. This is used to identify a song storage slot on the Roomba."))) (provide roomba-song-number?) (define (roomba-song-number? x) (and (exact-nonnegative-integer? x) (<= 0 x 15))) (define-values (%symbol-to-roomba-note-number-hash %frequency-to-roomba-note-number-alist) ;; (cmn freq sci-ok? sci-number) (let ((notes '((c0 16.352 #false 31) (cs0 17.324 #false 31) (d0 18.354 #false 31) (ds0 19.445 #false 31) (e0 20.602 #false 31) (f0 21.827 #false 31) (fs0 23.125 #false 31) (g0 24.5 #false 31) (gs0 25.957 #false 31) (a0 27.5 #false 31) (as0 29.135 #false 31) (b0 30.868 #false 31) (c1 32.703 #false 31) (cs1 34.648 #false 31) (d1 36.708 #false 31) (ds1 38.891 #false 31) (e1 41.203 #false 31) (f1 43.654 #false 31) (fs1 46.249 #false 31) (g1 48.999 #true 31) (gs1 51.913 #true 32) (a1 55.0 #true 33) (as1 58.27 #true 34) (b1 61.735 #true 35) (c2 65.406 #true 36) (cs2 69.296 #true 37) (d2 73.416 #true 38) (ds2 77.782 #true 39) (e2 82.407 #true 40) (f2 87.307 #true 41) (fs2 92.499 #true 42) (g2 97.999 #true 43) (gs2 103.83 #true 44) (a2 110.0 #true 45) (as2 116.54 #true 46) (b2 123.47 #true 47) (c3 130.81 #true 48) (cs3 138.59 #true 49) (d3 146.83 #true 50) (ds3 155.56 #true 51) (e3 164.81 #true 52) (f3 174.61 #true 53) (fs3 185.0 #true 54) (g3 196.0 #true 55) (gs3 207.65 #true 56) (a3 220.0 #true 57) (as3 233.08 #true 58) (b3 246.94 #true 59) (c4 261.63 #true 60) (cs4 277.18 #true 61) (d4 293.66 #true 62) (ds4 311.13 #true 63) (e4 329.63 #true 64) (f4 349.23 #true 65) (fs4 369.99 #true 66) (g4 392.0 #true 67) (gs4 415.3 #true 68) (a4 440.0 #true 69) (as4 466.16 #true 70) (b4 493.88 #true 71) (c5 523.25 #true 72) (cs5 554.37 #true 73) (d5 587.33 #true 74) (ds5 622.25 #true 75) (e5 659.26 #true 76) (f5 698.46 #true 77) (fs5 739.99 #true 78) (g5 783.99 #true 79) (gs5 830.61 #true 80) (a5 880.0 #true 81) (as5 932.33 #true 82) (b5 987.77 #true 83) (c6 1046.5 #true 84) (cs6 1108.7 #true 85) (d6 1174.7 #true 86) (ds6 1244.5 #true 87) (e6 1318.5 #true 88) (f6 1396.9 #true 89) (fs6 1480.0 #true 90) (g6 1568.0 #true 91) (gs6 1661.2 #true 92) (a6 1760.0 #true 93) (as6 1864.7 #true 94) (b6 1975.5 #true 95) (c7 2093.0 #true 96) (cs7 2217.5 #true 97) (d7 2349.3 #true 98) (ds7 2489.0 #true 99) (e7 2637.0 #true 100) (f7 2793.8 #true 101) (fs7 2960.0 #true 102) (g7 3136.0 #true 103) (gs7 3322.4 #true 104) (a7 3520.0 #true 105) (as7 3729.3 #true 106) (b7 3951.1 #true 107) (c8 4186.0 #true 108) (cs8 4434.9 #true 109) (d8 4698.6 #true 110) (ds8 4978.0 #true 111) (e8 5274.0 #true 112) (f8 5587.7 #true 113) (fs8 5919.9 #true 114) (g8 6271.9 #true 115) (gs8 6644.9 #true 116) (a8 7040.0 #true 117) (as8 7458.6 #true 118) (b8 7902.1 #true 119) (c9 8372.0 #true 120) (cs9 8869.8 #true 121) (d9 9397.3 #true 122) (ds9 9956.1 #true 123) (e9 10548.1 #true 124) (f9 11175.3 #true 125) (fs9 11839.8 #true 126) (g9 12543.9 #true 127) (gs9 13289.8 #false 127) (a9 14080.0 #false 127) (as9 14917.2 #false 127) (b9 15804.3 #false 127) (c10 16744.0 #false 127) (cs10 17739.7 #false 127) (d10 18794.5 #false 127) (ds10 19912.1 #false 127) (e10 21096.2 #false 127) (f10 22350.6 #false 127) (fs10 23679.6 #false 127) (g10 25087.7 #false 127) (gs10 26579.5 #false 127) (a10 28160.0 #false 127) (as10 29834.5 #false 127) (b10 31608.5 #false 127)))) (values (make-immutable-hasheq (map (lambda (note) (apply (lambda (cmn freq sci-ok? sci-number) (cons cmn sci-number)) note)) notes)) (map (lambda (note) (apply (lambda (cmn freq sci-ok? sci-number) (cons freq sci-number)) note)) notes)))) (define (%symbol->roomba-note-number-or-false sym) (if (eq? 'rest sym) 0 (hash-ref %symbol-to-roomba-note-number-hash sym #f))) (module+ test (test (%symbol->roomba-note-number-or-false 'c0) 31) (test (%symbol->roomba-note-number-or-false 'gs1) 32) (test (%symbol->roomba-note-number-or-false 'a4) 69) (test (%symbol->roomba-note-number-or-false 'fs9) 126) (test (%symbol->roomba-note-number-or-false 'b10) 127) (test (%symbol->roomba-note-number-or-false 'xxx) #f)) (define (%frequency->roomba-note-number freq) (let ((freq (exact->inexact freq))) (if (zero? freq) 0 (let loop ((alist %frequency-to-roomba-note-number-alist) (best-number #f) (best-diff +inf.0)) (if (null? alist) best-number (let*-values (((this-pair) (car alist)) ((this-freq) (car this-pair)) ((this-diff) (abs (- this-freq freq))) ((best-number best-diff) (if (< this-diff best-diff) (values (cdr this-pair) this-diff) (values best-number best-diff)))) (if (= this-freq freq) best-number (loop (cdr alist) best-number best-diff)))))))) (module+ test (test (%frequency->roomba-note-number 0 ) 0) (test (%frequency->roomba-note-number 1 ) 31) (test (%frequency->roomba-note-number 48 ) 31) (test (%frequency->roomba-note-number 48.0) 31) (test (%frequency->roomba-note-number 49 ) 31) (test (%frequency->roomba-note-number 49.0) 31) (test (%frequency->roomba-note-number 50 ) 31) (test (%frequency->roomba-note-number 50.0) 31) (test (%frequency->roomba-note-number 51 ) 32) (test (%frequency->roomba-note-number 51.0) 32) (test (%frequency->roomba-note-number 52 ) 32) (test (%frequency->roomba-note-number 52.0) 32) (test (%frequency->roomba-note-number 55 ) 33) (test (%frequency->roomba-note-number 55.0) 33) (test (%frequency->roomba-note-number 56 ) 33) (test (%frequency->roomba-note-number 56.0) 33) ;; (test (%frequency->roomba-note-number 11839.8) 126) (test (%frequency->roomba-note-number 11839.9) 126) (test (%frequency->roomba-note-number 12543.8) 127) (test (%frequency->roomba-note-number 12543.9) 127) (test (%frequency->roomba-note-number 12544.0) 127)) (define (%roomba-song-language-note-duration->second64ths-or-false #:second64ths-per-whole second64ths-per-whole #:duration duration) (let ((duration (case duration ((whole w) (truncate second64ths-per-whole)) ((half h) (truncate (* 1/2 second64ths-per-whole))) ((quarter q) (truncate (* 1/4 second64ths-per-whole))) (else duration)))) (if (and (integer? duration) (<= 0 duration 255)) (if (exact? duration) duration (exact->inexact duration)) #false))) (define (%compile-roomba-song-language-as-data-byte-list #:error-name error-name #:song-language song-language) (values (length song-language) (let loop ((data song-language)) (if (null? data) '() (let*-values (((note) (car data)) ((freq dur) (match note ((list freq dur) (values freq dur)) (freq (values freq 'quarter)) (_ (error error-name "invalid note ~S in song language ~S" note song-language)))) ((num) (cond ((integer? freq) (%frequency->roomba-note-number freq)) ((symbol? freq) (or (%symbol->roomba-note-number-or-false (case freq ((a) 'a4) ((b) 'b4) ((c) 'c4) ((d) 'd4) ((e) 'e4) ((f) 'f4) ((g) 'g4) (else freq))) (error error-name "invalid note name in note ~S in song language ~S" note song-language))) (else (error error-name "invalid frequency in note ~S in song language ~S" note song-language)))) ((dur) (or (%roomba-song-language-note-duration->second64ths-or-false #:second64ths-per-whole 64 ;; TODO: Get this right! #:duration dur) (error error-name "invalid duration in note ~S in song language ~S" note song-language)))) `(,num ,dur ,@(loop (cdr data)))))))) (define (%compile-roomba-song-language-as-sci-message-bytes #:error-name (error-name '%compile-roomba-song-language-as-sci-message-bytes) #:song-number song-number #:song-language song-language) (let-values (((song-length song-byte-list) (%compile-roomba-song-language-as-data-byte-list #:error-name error-name #:song-language song-language))) (if (<= 1 song-length 16) (apply bytes 140 song-number song-length song-byte-list) (error error-name "invalid song length ~S for song ~S" song-length song-language)))) (module+ test (test (%compile-roomba-song-language-as-sci-message-bytes #:song-number 0 #:song-language '(b a g a b b (b h) a a (a h) b d (d h))) (let ((d 62) (g 67) (a 69) (b 71) ;; (h 32) (q 16)) (bytes 140 0 13 b q a q g q a q b q b q b h a q a q a h b q d q d h))) ;; TODO: More test cases, such as including numbers for frequency and ;; duration. ) (define (%compiled-roomba-song-struct-write-proc compiled-roomba-song port write?) (fprintf port "#" (compiled-roomba-song-struct-song-language compiled-roomba-song))) (doc (defproc (compiled-roomba-song? (x any/c)) boolean? (para "Predicate for the compiled roomba song as produced by " (racket compile-roomba-song) "."))) (provide (rename-out (compiled-roomba-song-struct? compiled-roomba-song?))) (define-struct compiled-roomba-song-struct (song-language roomba song-number sci-message-bytes) #:methods gen:custom-write ((define write-proc %compiled-roomba-song-struct-write-proc))) (doc (defproc (compile-roomba-song (#:roomba roomba roomba? (current-roomba)) (#:song-number song-number roomba-song-number? 0) (#:song-language song-language roomba-song-language?)) roomba-song? (para "Compiles a song in the " (tech "song language") " to a form that is more time-efficient to store with " (racket store-song-on-roomba) ". This may be useful for breaking up a long song into fragments that are stored during playback.") (para "Note that such a compiled song has the song number compiled into it."))) (provide compile-roomba-song) (define (compile-roomba-song #:roomba (roomba (current-roomba)) #:song-number (song-number 0) #:song-language song-language) (log-roomba-debug "(compile-roomba-song #:roomba ~S #:song-number ~S #:song-language ~S)" roomba song-number song-language) (make-compiled-roomba-song-struct song-language roomba song-number (%compile-roomba-song-language-as-sci-message-bytes #:error-name 'compile-roomba-song #:song-number song-number #:song-language song-language))) (doc (defproc (store-song-on-roomba (#:roomba roomba roomba? (current-roomba)) (#:song-number song-number roomba-song-number? 0) (#:song song (or/c roomba-song-language? compiled-roomba-song?))) void? (para "Stores a song on the Roomba in a song number slot, to be played later using " (racket play-song-on-roomba) ". It replaces any song previously stored at that song number on the Roomba.") (para "The longest song that can be stored in in a song number slot at a time is 16 notes. However, longer songs can be played by fragmenting among multiple slots, and/or storing fragments as they are needed during playback."))) (provide store-song-on-roomba) (define (store-song-on-roomba #:roomba (roomba (current-roomba)) #:song-number (song-number 0) #:song song) (log-roomba-debug "(store-song-on-roomba #:roomba ~S #:song-number ~S #:song ~S)" roomba song-number song) (%assert-roomba-mode 'store-song-on-roomba roomba '(safe full)) (%send-byte-string-to-roomba roomba (if (compiled-roomba-song-struct? song) (compiled-roomba-song-struct-sci-message-bytes song) (%compile-roomba-song-language-as-sci-message-bytes #:error-name 'store-song-on-roomba #:song-number song-number #:song-language song)))) (doc (defproc (play-song-on-roomba (#:roomba roomba roomba? (current-roomba)) (#:song-number number roomba-song-number? 0)) void? (para "Plays song number " (racket number) " as stored using " (racket store-song-on-roomba) ".") (para "Note that, in the current version of this package, " (racket song-number) " must agree with the song number under which the song was compiled."))) (provide play-song-on-roomba) (define (play-song-on-roomba #:roomba (roomba (current-roomba)) #:song-number (song-number 0)) (log-roomba-debug "(play-song-on-roomba #:roomba ~S #:song-number ~S)" roomba song-number) (%assert-roomba-mode 'play-song-on-roomba roomba '(safe full)) (%send-byte-string-to-roomba roomba (bytes 141 (%roomba-arg-song-number 'play-song-on-roomba 'song-number song-number)))) (doc (section "Sensors")) (doc (defproc (read-roomba-sensors (#:roomba roomba roomba? (current-roomba)) (#:packet-code packet-code (or/c #f exact-nonnegative-integer?) #f)) (listof (cons/c symbol? any/c)) (para "Get sensor values for a packet code as an " (tech "association list") ". The available packet codes and their association list pairs are documented in section " (secref "Sensor Packets") ". If " (racket packet-code) " is " (racket #f) ", then the default will vary between Roomba protocols, to give a large number of sensors values (e.g., on a Roomba 400 would default to " (racket 0) "; iRobot Create, " (racket 6) ").") (para "If you aren't familiar with association lists, see section " (secref "Association List Primer") ".") (para "Some examples on a Roomba 400:") (racketinput (read-roomba-sensors #:packet-code 1)) (racketresultblock ((dirt-detect-right . 0) (dirt-detect-left . 0) (side-brush-overcurrent? . #f) (vacuum-overcurrent? . #f) (main-brush-overcurrent? . #f) (drive-right-overcurrent? . #f) (drive-left-overcurrent? . #f) (virtual-wall? . #f) (cliff-right? . #f) (cliff-front-right? . #f) (cliff-front-left? . #f) (cliff-left? . #f) (wall? . #f) (bump-right? . #f) (bump-left? . #f) (wheeldrop-right? . #f) (wheeldrop-left? . #f) (wheeldrop-caster? . #f))) (racketinput (read-roomba-sensors #:packet-code 2)) (racketresultblock ((angle . 0) (distance . 0) (max-button? . #f) (clean-button? . #f) (spot-button? . #f) (power-button? . #f) (remote-control-command . 255))) (racketinput (read-roomba-sensors #:packet-code 3)) (racketresultblock ((battery-capacity . 973) (battery-charge . 889) (battery-temperature . 30) (battery-current . -176) (battery-voltage . 13888) (battery-charging-state . not-charging))) (para "An example with the default packet code on an iRobot Create:") (racketinput (read-roomba-sensors)) (racketresultblock ((requested-left-velocity . 0) (requested-right-velocity . 0) (requested-radius . 0) (requested-velocity . 0) (number-of-stream-packets . 0) (song-playing? . #f) (song-number . 0) (oi-mode . safe) (internal-charger? . #f) (home-base-charger? . #f) (cargo-bay-analog-signal . 0) (digital-input-0? . #f) (digital-input-1? . #f) (digital-input-2? . #f) (digital-input-3? . #f) (device-detect? . #f) (cliff-right-signal . 1029) (cliff-front-right-signal . 1276) (cliff-front-left-signal . 960) (cliff-left-signal . 1032) (wall-signal . 0) (battery-capacity . 2702) (battery-charge . 2696) (battery-temperature . 25) (battery-current . -169) (battery-voltage . 13554) (battery-charging-state . not-charging) (angle . 0) (distance . 0) (max-button? . #f) (clean-button? . #f) (spot-button? . #f) (power-button? . #f) (remote-control-command . 255) (infrared-byte . 255) (dirt-detect-right . 0) (dirt-detect-left . 0) (side-brush-overcurrent? . #f) (vacuum-overcurrent? . #f) (main-brush-overcurrent? . #f) (drive-right-overcurrent? . #f) (drive-left-overcurrent? . #f) (virtual-wall? . #f) (cliff-right? . #f) (cliff-front-right? . #f) (cliff-front-left? . #f) (cliff-left? . #f) (wall? . #f) (bump-right? . #f) (bump-left? . #f) (wheeldrop-right? . #f) (wheeldrop-left? . #f) (wheeldrop-caster? . #f))))) (provide read-roomba-sensors) (define (read-roomba-sensors #:roomba (roomba (current-roomba)) #:packet-code (packet-code #f)) (log-roomba-debug "(read-roomba-sensors #:roomba ~S #:packet-code ~S)" roomba packet-code) (%assert-roomba-mode 'read-roomba-sensors roomba '(passive safe full)) (let ((packet-code (if packet-code (%roomba-arg-byte 'read-roomba-sensors 'packet-code packet-code) (%roomba-protocol-ecase #:error-name 'read-roomba-sensors #:roomba roomba #:cases ((roomba-sci roomba-roi) 0) ((roomba-coi) 6))))) (%send-byte-string-to-roomba roomba (bytes 142 packet-code)) (let*-values (((read-size decoder-proc) (case packet-code ((0) (values 26 %decode-roomba-sensor-packet-0)) ((1) (values 10 %decode-roomba-sensor-packet-1)) ((2) (values 6 %decode-roomba-sensor-packet-2)) ((3) (values 10 %decode-roomba-sensor-packet-3)) ;; TODO: In error messages about protocol, include the ;; packet-code in the error message. (else (%roomba-protocol-ecase #:error-name 'read-roomba-sensors #:roomba roomba #:cases ((roomba-coi) (case packet-code ((4) (values 14 %decode-roomba-sensor-packet-4)) ((5) (values 12 %decode-roomba-sensor-packet-5)) ((6) (values 52 %decode-roomba-sensor-packet-6)) ((7) (values 1 %decode-roomba-sensor-packet-7)) ((8) (values 1 %decode-roomba-sensor-packet-8)) ((9) (values 1 %decode-roomba-sensor-packet-9)) ((10) (values 1 %decode-roomba-sensor-packet-10)) ((11) (values 1 %decode-roomba-sensor-packet-11)) ((12) (values 1 %decode-roomba-sensor-packet-12)) ((13) (values 1 %decode-roomba-sensor-packet-13)) ((14) (values 1 %decode-roomba-sensor-packet-14)) ((15) (values 1 %decode-roomba-sensor-packet-15)) ((16) (values 1 %decode-roomba-sensor-packet-16)) ((17) (values 1 %decode-roomba-sensor-packet-17)) ((18) (values 1 %decode-roomba-sensor-packet-18)) ((19) (values 2 %decode-roomba-sensor-packet-19)) ((20) (values 2 %decode-roomba-sensor-packet-20)) ((21) (values 1 %decode-roomba-sensor-packet-21)) ((22) (values 2 %decode-roomba-sensor-packet-22)) ((23) (values 2 %decode-roomba-sensor-packet-23)) ((24) (values 1 %decode-roomba-sensor-packet-24)) ((25) (values 2 %decode-roomba-sensor-packet-25)) ((26) (values 2 %decode-roomba-sensor-packet-26)) ((27) (values 2 %decode-roomba-sensor-packet-27)) ((28) (values 2 %decode-roomba-sensor-packet-28)) ((29) (values 2 %decode-roomba-sensor-packet-29)) ((30) (values 2 %decode-roomba-sensor-packet-30)) ((31) (values 2 %decode-roomba-sensor-packet-31)) ((32) (values 1 %decode-roomba-sensor-packet-32)) ((33) (values 2 %decode-roomba-sensor-packet-33)) ((34) (values 1 %decode-roomba-sensor-packet-34)) ((35) (values 1 %decode-roomba-sensor-packet-35)) ((36) (values 1 %decode-roomba-sensor-packet-36)) ((37) (values 1 %decode-roomba-sensor-packet-37)) ((38) (values 1 %decode-roomba-sensor-packet-38)) ((39) (values 2 %decode-roomba-sensor-packet-39)) ((40) (values 2 %decode-roomba-sensor-packet-40)) ((41) (values 2 %decode-roomba-sensor-packet-41)) ((42) (values 2 %decode-roomba-sensor-packet-42)) (else (error 'read-roomba-sensors "invalid packet-code ~S" packet-code)))))))) ((bstr) (%read-byte-string-from-roomba roomba read-size))) (log-roomba-debug "read-roomba-sensors: read ~S" bstr) (decoder-proc bstr 0 '())))) ;; TODO: Add "let-roomba-sensors". The below example is for SCI. Also ;; generate code for OI, and do a runtime check on protocol to determine ;; which code to use. ;; ;; (let-roomba-sensors (bump-left? bump-right? wall? dirt-detect-left battery-charge) ;; BODYn ...) ;; ;; ;;=expand=> ;; ;; (let* ((roomba (current-roomba)) ;; (packet-1 (roomba-sensors #:roomba roomba #:packet-code 1 #:format 'raw)) ;; (packet-3 (roomba-sensors #:roomba roomba #:packet-code 3 #:format 'raw)) ;; (byte-1-0 (bytes-ref packet-1 0))) ;; ;; Note: bindings below are exposed to body of macro ;; (let ((bump-left? (decode-bump-left-roomba-sensor-byte byte-1-0)) ;; (bump-right? (decode-bump-right-roomba-sensor-byte byte-1-0)) ;; (wall? (decode-wall-roomba-sensor packet-1 1)) ;; (dirt-detect-left (decode-dirt-dectector-left-roomba-sensor packet-1 8)) ;; (dirt-detect-left (decode-dirt-dectector-left-roomba-sensor packet-1 9)) ;; (battery-charge (decode-roomba-sensor-packet-25 packet-3 6))) ;; BODYn ...)) ;; ;; ;; ;; (NAME SCI-PACKET SCI-OFFSET OI-PACKET SHARED-BYTE DECODE) ;; ;; (bump-right? 1 0 7 #true decode-bump-right-roomba-sensor-byte) ;; (bump-left? 1 0 7 #true decode-bump-left-roomba-sensor-byte) ;; (wheeldrop-right? 1 0 7 #true decode-wheeldrop-right-roomba-sensor-byte) ;; (wheeldrop-left? 1 0 7 #true decode-wheeldrop-left-roomba-sensor-byte) ;; (wheeldrop-caster? 1 0 7 #true decode-wheeldrop-caster-roomba-sensor-byte) ;; ;; (wall? 1 1 8 #false decode-wall-roomba-sensor) ;; (cliff-left? 1 2 9 #false decode-cliff-left-roomba-sensor) ;; (cliff-front-left? 1 3 10 #false decode-cliff-front-left-roomba-sensor) ;; (cliff-front-right? 1 4 11 #false decode-cliff-front-right-roomba-sensor) ;; (cliff-right? 1 5 12 #false decode-cliff-right-roomba-sensor) ;; (virtual-wall? 1 6 13 #false decode-virtual-wall-roomba-sensor) ;; ;; (side-brush-overcurrent? 1 7 14 #true decode-side-brush-overcurrent-roomba-sensor-byte) ;; (vacuum-overcurrent? 1 7 14 #true decode-vacuum-overcurrent-roomba-sensor-byte) ;; (main-brush-overcurrent? 1 7 14 #true decode-main-brush-overcurrent-roomba-sensor-byte) ;; (drive-right-overcurrent? 1 7 14 #true decode-drive-right-overcurrent-roomba-sensor-byte) ;; (drive-left-overcurrent? 1 7 14 #true decode-drive-left-overcurrent-roomba-sensor-byte) ;; ;; (dirt-detect-left 1 8 15 #false decode-dirt-detect-left-roomba-sensor) ;; (dirt-detect-right 1 9 16 #false decode-dirt-detect-right-roomba-sensor) ;; ;; (remote-control-command 2 0 #false decode-roomba-sensor-packet-17) ;; ;; (max-button? 2 1 #true decode-max-button-roomba-sensor-byte) ;; (clean-button? 2 1 #true decode-clean-button-roomba-sensor-byte) ;; (spot-button? 2 1 #true decode-spot-button-roomba-sensor-byte) ;; (power-button? 2 1 #true decode-power-button-roomba-sensor-byte) ;; ;; (distance 2 2 #false decode-roomba-sensor-packet-19) ;; (angle 2 4 #false decode-roomba-sensor-packet-20) ;; ;; (battery-charging-state 3 0 #false decode-roomba-sensor-packet-21) ;; (battery-voltage 3 1 #false decode-roomba-sensor-packet-22) ;; (battery-current 3 3 #false decode-roomba-sensor-packet-23) ;; (battery-temperature 3 5 #false decode-roomba-sensor-packet-24) ;; (battery-charge 3 6 #false decode-roomba-sensor-packet-25) ;; (battery-capacity 3 8 #false decode-roomba-sensor-packet-26) (doc (subsection #:tag "Sensor Packets" "Sensor Packets")) (define (%roomba:signed-byte->integer byt) (if (byte? byt) (if (< byt 128) byt (- (+ (bitwise-xor (bitwise-and #b01111111 byt) #b01111111) 1))) (raise-type-error '%roomba:signed-byte->integer "byte?" 0 byt))) (module+ test (test (%roomba:signed-byte->integer #b01111111) +127) (test (%roomba:signed-byte->integer #b01111110) +126) (test (%roomba:signed-byte->integer #b01111101) +125) (test (%roomba:signed-byte->integer #b00000001) +1) (test (%roomba:signed-byte->integer #b00000000) 0) (test (%roomba:signed-byte->integer #b11111111) -1) (test (%roomba:signed-byte->integer #b10000010) -126) (test (%roomba:signed-byte->integer #b10000001) -127) (test (%roomba:signed-byte->integer #b10000000) -128)) (define (%decode-roomba-sint16-bytes bstr offset) (integer-bytes->integer bstr #true #true offset (+ 2 offset))) (define (%decode-roomba-uint16-bytes bstr offset) (integer-bytes->integer bstr #false #true offset (+ 2 offset))) (doc (para "The first 7 packet codes are actually for " (deftech "group packets") ", that include all the contents of a range of other packets:") (def-roomba-group-packets (0 "7 - 26" all) (1 "7 - 16" all) (2 "17 - 20" all) (3 "21 - 26" all) (4 "27 - 34" (coi)) (5 "35 - 42" (coi)) (6 "7 - 42" (coi))) (para "The non-group packets are listed below.")) (define (%decode-roomba-sensor-packet-0 bstr offset alist) (let* ((alist (%decode-roomba-sensor-packet-1 bstr offset alist)) (alist (%decode-roomba-sensor-packet-2 bstr (+ 10 offset) alist)) (alist (%decode-roomba-sensor-packet-3 bstr (+ 16 offset) alist))) alist)) (define (%decode-roomba-sensor-packet-1 bstr offset alist) (let* ((alist (%decode-roomba-sensor-packet-7 bstr offset alist)) (alist (%decode-roomba-sensor-packet-8 bstr (+ 1 offset) alist)) (alist (%decode-roomba-sensor-packet-9 bstr (+ 2 offset) alist)) (alist (%decode-roomba-sensor-packet-10 bstr (+ 3 offset) alist)) (alist (%decode-roomba-sensor-packet-11 bstr (+ 4 offset) alist)) (alist (%decode-roomba-sensor-packet-12 bstr (+ 5 offset) alist)) (alist (%decode-roomba-sensor-packet-13 bstr (+ 6 offset) alist)) (alist (%decode-roomba-sensor-packet-14 bstr (+ 7 offset) alist)) (alist (%decode-roomba-sensor-packet-15 bstr (+ 8 offset) alist)) (alist (%decode-roomba-sensor-packet-16 bstr (+ 9 offset) alist))) alist)) (define (%decode-roomba-sensor-packet-2 bstr offset alist) (let* ((alist (%decode-roomba-sensor-packet-17 bstr offset alist)) (alist (%decode-roomba-sensor-packet-18 bstr (+ 1 offset) alist)) (alist (%decode-roomba-sensor-packet-19 bstr (+ 2 offset) alist)) (alist (%decode-roomba-sensor-packet-20 bstr (+ 4 offset) alist))) alist)) (define (%decode-roomba-sensor-packet-3 bstr offset alist) (let* ((alist (%decode-roomba-sensor-packet-21 bstr offset alist)) (alist (%decode-roomba-sensor-packet-22 bstr (+ 1 offset) alist)) (alist (%decode-roomba-sensor-packet-23 bstr (+ 3 offset) alist)) (alist (%decode-roomba-sensor-packet-24 bstr (+ 5 offset) alist)) (alist (%decode-roomba-sensor-packet-25 bstr (+ 6 offset) alist)) (alist (%decode-roomba-sensor-packet-26 bstr (+ 8 offset) alist))) alist)) (define (%decode-roomba-sensor-packet-4 bstr offset alist) (let* ((alist (%decode-roomba-sensor-packet-27 bstr offset alist)) (alist (%decode-roomba-sensor-packet-28 bstr (+ 2 offset) alist)) (alist (%decode-roomba-sensor-packet-29 bstr (+ 4 offset) alist)) (alist (%decode-roomba-sensor-packet-30 bstr (+ 6 offset) alist)) (alist (%decode-roomba-sensor-packet-31 bstr (+ 8 offset) alist)) (alist (%decode-roomba-sensor-packet-32 bstr (+ 10 offset) alist)) (alist (%decode-roomba-sensor-packet-33 bstr (+ 11 offset) alist)) (alist (%decode-roomba-sensor-packet-34 bstr (+ 13 offset) alist))) alist)) (define (%decode-roomba-sensor-packet-5 bstr offset alist) (let* ((alist (%decode-roomba-sensor-packet-35 bstr offset alist)) (alist (%decode-roomba-sensor-packet-36 bstr (+ 1 offset) alist)) (alist (%decode-roomba-sensor-packet-37 bstr (+ 2 offset) alist)) (alist (%decode-roomba-sensor-packet-38 bstr (+ 3 offset) alist)) (alist (%decode-roomba-sensor-packet-39 bstr (+ 4 offset) alist)) (alist (%decode-roomba-sensor-packet-40 bstr (+ 6 offset) alist)) (alist (%decode-roomba-sensor-packet-41 bstr (+ 8 offset) alist)) (alist (%decode-roomba-sensor-packet-42 bstr (+ 10 offset) alist))) alist)) (define (%decode-roomba-sensor-packet-6 bstr offset alist) ; 7-42 (let* ((alist (%decode-roomba-sensor-packet-0 bstr offset alist)) ; 7-26 (alist (%decode-roomba-sensor-packet-4 bstr (+ 26 offset) alist)) ; 27-34 (alist (%decode-roomba-sensor-packet-5 bstr (+ 40 offset) alist))) ; 35-42 alist)) (doc (def-roomba-packet 7 all ((bump-right? boolean?) (bump-left? boolean?) (wheeldrop-right? boolean?) (wheeldrop-left? boolean?) (wheeldrop-caster? boolean?)))) (define (%decode-roomba-sensor-packet-7 bstr offset alist) (let ((byt (bytes-ref bstr offset))) `((bump-right? . ,(bitwise-bit-set? byt 0)) (bump-left? . ,(bitwise-bit-set? byt 1)) (wheeldrop-right? . ,(bitwise-bit-set? byt 2)) (wheeldrop-left? . ,(bitwise-bit-set? byt 3)) (wheeldrop-caster? . ,(bitwise-bit-set? byt 4)) ,@alist))) (doc (def-roomba-packet 8 all ((wall? boolean?)))) (define (%decode-roomba-sensor-packet-8 bstr offset alist) `((wall? . ,(bitwise-bit-set? (bytes-ref bstr offset) 0)) ,@alist)) (doc (def-roomba-packet 9 all ((cliff-left? boolean?)))) (define (%decode-roomba-sensor-packet-9 bstr offset alist) `((cliff-left? . ,(bitwise-bit-set? (bytes-ref bstr offset) 0)) ,@alist)) (doc (def-roomba-packet 10 all ((cliff-front-left? boolean?)))) (define (%decode-roomba-sensor-packet-10 bstr offset alist) `((cliff-front-left? . ,(bitwise-bit-set? (bytes-ref bstr offset) 0)) ,@alist)) (doc (def-roomba-packet 11 all ((cliff-front-right? boolean?)))) (define (%decode-roomba-sensor-packet-11 bstr offset alist) `((cliff-front-right? . ,(bitwise-bit-set? (bytes-ref bstr offset) 0)) ,@alist)) (doc (def-roomba-packet 12 all ((cliff-right? boolean?)))) (define (%decode-roomba-sensor-packet-12 bstr offset alist) `((cliff-right? . ,(bitwise-bit-set? (bytes-ref bstr offset) 0)) ,@alist)) (doc (def-roomba-packet 13 all ((virtual-wall? boolean?)))) (define (%decode-roomba-sensor-packet-13 bstr offset alist) `((virtual-wall? . ,(bitwise-bit-set? (bytes-ref bstr offset) 0)) ,@alist)) (doc (def-roomba-packet 14 all ((side-brush-overcurrent? boolean?) (vacuum-overcurrent? boolean?) (main-brush-overcurrent? boolean?) (drive-right-overcurrent? boolean?) (drive-left-overcurrent? boolean?)))) (define (%decode-roomba-sensor-packet-14 bstr offset alist) (let ((byt (bytes-ref bstr offset))) `((side-brush-overcurrent? . ,(bitwise-bit-set? byt 0)) (vacuum-overcurrent? . ,(bitwise-bit-set? byt 1)) (main-brush-overcurrent? . ,(bitwise-bit-set? byt 2)) (drive-right-overcurrent? . ,(bitwise-bit-set? byt 3)) (drive-left-overcurrent? . ,(bitwise-bit-set? byt 4)) ,@alist))) (doc (def-roomba-packet 15 all ((dirt-detect-left boolean?)))) (define (%decode-roomba-sensor-packet-15 bstr offset alist) ;; TODO: This is always 0 for coi. `((dirt-detect-left . ,(bytes-ref bstr offset)) ,@alist)) (doc (def-roomba-packet 16 all ((dirt-detect-right boolean?)))) (define (%decode-roomba-sensor-packet-16 bstr offset alist) ;; TODO: This is always 0 for coi. Maybe don't include it. `((dirt-detect-right . ,(bytes-ref bstr offset)) ,@alist)) (doc (def-roomba-packet 17 all ((remote-control-command byte?) (infrared-byte byte?)))) (define (%decode-roomba-sensor-packet-17 bstr offset alist) ;; TODO: COI renamed this to "infrared byte", and calling it remote control ;; command is misleading, so for now we duplicate the value with the two ;; different names? (let ((byt (bytes-ref bstr offset))) `((remote-control-command . ,byt) (infrared-byte . ,byt) ,@alist))) (doc (def-roomba-packet 18 all ((max-button? boolean?) (clean-button? boolean?) (spot-button? boolean?) (power-button? boolean?)))) (define (%decode-roomba-sensor-packet-18 bstr offset alist) (let ((byt (bytes-ref bstr offset))) `((max-button? . ,(bitwise-bit-set? byt 0)) (clean-button? . ,(bitwise-bit-set? byt 1)) (spot-button? . ,(bitwise-bit-set? byt 2)) (power-button? . ,(bitwise-bit-set? byt 3)) ,@alist))) (doc (def-roomba-packet 19 all ((distance exact-integer?)))) (define (%decode-roomba-sensor-packet-19 bstr offset alist) `((distance . ,(%decode-roomba-sint16-bytes bstr offset)) ,@alist)) (doc (def-roomba-packet 20 all ((angle exact-integer?)))) (define (%decode-roomba-sensor-packet-20 bstr offset alist) `((angle . ,(%decode-roomba-sint16-bytes bstr offset)) ,@alist)) (doc (def-roomba-packet 21 all ((battery-charging-state (or/c #f 'not-charging 'charging-recovery 'charging 'trickle-charging 'waiting 'charging-error))))) (define (%decode-roomba-sensor-packet-21 bstr offset alist) `((battery-charging-state . ,(case (bytes-ref bstr offset) ((0) 'not-charging) ((1) 'charging-recovery) ((2) 'charging) ((3) 'trickle-charging) ((4) 'waiting) ((5) 'charging-error) (else #f))) ,@alist)) (doc (def-roomba-packet 22 all ((battery-voltage exact-nonnegative-integer?)))) (define (%decode-roomba-sensor-packet-22 bstr offset alist) `((battery-voltage . ,(%decode-roomba-uint16-bytes bstr offset)) ,@alist)) (doc (def-roomba-packet 23 all ((battery-current exact-integer?)))) (define (%decode-roomba-sensor-packet-23 bstr offset alist) `((battery-current . ,(%decode-roomba-sint16-bytes bstr offset)) ,@alist)) (doc (def-roomba-packet 24 all ((battery-temperature signed-byte?)))) (define (%decode-roomba-sensor-packet-24 bstr offset alist) `((battery-temperature . ,(%roomba:signed-byte->integer (bytes-ref bstr offset))) ,@alist)) (doc (def-roomba-packet 25 all ((battery-charge exact-nonnegative-integer?)))) (define (%decode-roomba-sensor-packet-25 bstr offset alist) `((battery-charge . ,(%decode-roomba-uint16-bytes bstr offset)) ,@alist)) (doc (def-roomba-packet 26 all ((battery-capacity exact-nonnegative-integer?)))) (define (%decode-roomba-sensor-packet-26 bstr offset alist) `((battery-capacity . ,(%decode-roomba-uint16-bytes bstr offset)) ,@alist)) (doc (def-roomba-packet 27 (coi) ((wall-signal exact-nonnegative-integer?)))) (define (%decode-roomba-sensor-packet-27 bstr offset alist) `((wall-signal . ,(%decode-roomba-uint16-bytes bstr offset)) ,@alist)) (doc (def-roomba-packet 28 (coi) ((cliff-left-signal exact-nonnegative-integer?)))) (define (%decode-roomba-sensor-packet-28 bstr offset alist) `((cliff-left-signal . ,(%decode-roomba-uint16-bytes bstr offset)) ,@alist)) (doc (def-roomba-packet 29 (coi) ((cliff-front-left-signal exact-nonnegative-integer?)))) (define (%decode-roomba-sensor-packet-29 bstr offset alist) `((cliff-front-left-signal . ,(%decode-roomba-uint16-bytes bstr offset)) ,@alist)) (doc (def-roomba-packet 30 (coi) ((cliff-front-right-signal exact-nonnegative-integer?)))) (define (%decode-roomba-sensor-packet-30 bstr offset alist) `((cliff-front-right-signal . ,(%decode-roomba-uint16-bytes bstr offset)) ,@alist)) (doc (def-roomba-packet 31 (coi) ((cliff-right-signal exact-nonnegative-integer?)))) (define (%decode-roomba-sensor-packet-31 bstr offset alist) `((cliff-right-signal . ,(%decode-roomba-uint16-bytes bstr offset)) ,@alist)) (doc (def-roomba-packet 32 (coi) ((digital-input-0? boolean?) (digital-input-1? boolean?) (digital-input-2? boolean?) (digital-input-3? boolean?) (device-detect? boolean?)))) (define (%decode-roomba-sensor-packet-32 bstr offset alist) (let ((byt (bytes-ref bstr offset))) `((digital-input-0? . ,(bitwise-bit-set? byt 0)) (digital-input-1? . ,(bitwise-bit-set? byt 1)) (digital-input-2? . ,(bitwise-bit-set? byt 2)) (digital-input-3? . ,(bitwise-bit-set? byt 3)) (device-detect? . ,(bitwise-bit-set? byt 4)) ,@alist))) (doc (def-roomba-packet 33 (coi) ((cargo-bay-analog-signal byte?)))) (define (%decode-roomba-sensor-packet-33 bstr offset alist) `((cargo-bay-analog-signal . ,(bytes-ref bstr offset)) ,@alist)) (doc (def-roomba-packet 34 (coi) ((internal-charger? boolean?) (home-base-charger? boolean?)))) (define (%decode-roomba-sensor-packet-34 bstr offset alist) (let ((byt (bytes-ref bstr offset))) `((internal-charger? . ,(bitwise-bit-set? byt 0)) (home-base-charger? . ,(bitwise-bit-set? byt 1)) ,@alist))) (doc (def-roomba-packet 35 (coi) ((oi-mode (or/c 'off 'passive 'safe 'full byte?))))) (define (%decode-roomba-sensor-packet-35 bstr offset alist) ;; Note: Our version of the COI spec is confused on packet 35, having ;; duplicated the description of packet 34 for 35, but the table for 35 ;; appears correct, so that's what we go with. `((oi-mode . ,(let ((byt (bytes-ref bstr offset))) (case byt ((0) 'off) ((1) 'passive) ((2) 'safe) ((3) 'full) (else byt)))) ,@alist)) (doc (def-roomba-packet 36 (coi) ((song-number byte?)))) (define (%decode-roomba-sensor-packet-36 bstr offset alist) `((song-number . ,(bytes-ref bstr offset)) ,@alist)) (doc (def-roomba-packet 37 (coi) ((song-playing? boolean?)))) (define (%decode-roomba-sensor-packet-37 bstr offset alist) `((song-playing? . ,(let ((byt (bytes-ref bstr offset))) (case byt ((0) #false) ((1) #true) (else byt)))) ,@alist)) (doc (def-roomba-packet 38 (coi) ((number-of-stream-packets byte?)))) (define (%decode-roomba-sensor-packet-38 bstr offset alist) `((number-of-stream-packets . ,(bytes-ref bstr offset)) ,@alist)) (doc (def-roomba-packet 39 (coi) ((requested-velocity exact-integer?)))) (define (%decode-roomba-sensor-packet-39 bstr offset alist) `((requested-velocity . ,(%decode-roomba-sint16-bytes bstr offset)) ,@alist)) (doc (def-roomba-packet 40 (coi) ((requested-radius exact-integer?)))) (define (%decode-roomba-sensor-packet-40 bstr offset alist) `((requested-radius . ,(%decode-roomba-sint16-bytes bstr offset)) ,@alist)) (doc (def-roomba-packet 41 (coi) ((requested-right-velocity exact-integer?)))) (define (%decode-roomba-sensor-packet-41 bstr offset alist) `((requested-right-velocity . ,(%decode-roomba-sint16-bytes bstr offset)) ,@alist)) (doc (def-roomba-packet 42 (coi) ((requested-left-velocity exact-nonnegative-integer?)))) (define (%decode-roomba-sensor-packet-42 bstr offset alist) `((requested-left-velocity . ,(%decode-roomba-sint16-bytes bstr offset)) ,@alist)) (doc (subsection "Sensor Utilities")) (doc (defproc (roomba-infrared-byte->name (infrared-byte byte?)) (or/c #f symbol? byte?) (para "Maps the " (racket 'infrared-byte) " sensor value to a symbol, or, if no infrared signal, to " (racket #f) ". If it cannot be mapped, then the original byte is returned.") (para "The symbols that might be returned in the current version of this package are the following, (although note that later versions might return additional symbols, and your program should accommodate that possibility):") (nested #:style 'inset ;; TODO: Add short explanation for each. Or rename to more descriptive before release. (tabular (list (list (racket 'left)) (list (racket 'forward)) (list (racket 'right)) (list (racket 'spot)) (list (racket 'max)) (list (racket 'small)) (list (racket 'medium)) (list (racket 'large-or-clean)) (list (racket 'pause)) (list (racket 'power)) (list (racket 'arc-forward-left)) (list (racket 'arc-forward-right)) (list (racket 'drive-setup)) (list (racket 'send-all)) (list (racket 'seek-dock)) (list (racket 'force-field)) (list (racket 'green-buoy)) (list (racket 'green-buoy-and-force-field)) (list (racket 'red-buoy)) (list (racket 'red-buoy-and-force-field)) (list (racket 'red-and-green-buoys)) (list (racket 'red-and-green-buoys-and-force-field))))) (para "Note that " (racket read-roomba-sensors) " does not do this mapping automatically because some applications might wish to use the infrared byte values for other purposes, such as for a 7-bit communication channel."))) (provide roomba-infrared-byte->name) (define roomba-infrared-byte->name (let ((hash (make-immutable-hasheq '((129 . left) (130 . forward) (131 . right) (132 . spot) (133 . max) (134 . small) (135 . medium) (136 . large-or-clean) (137 . pause) (138 . power) (139 . arc-forward-left) (140 . arc-forward-right) (141 . drive-setup) (142 . send-all) (143 . seek-dock) (242 . force-field) (244 . green-buoy) (246 . green-buoy-and-force-field) (248 . red-buoy) (250 . red-buoy-and-force-field) (252 . red-and-green-buoys) (254 . red-and-green-buoys-and-force-field) (255 . #f))))) (lambda (infrared-byte) (hash-ref hash infrared-byte infrared-byte)))) (doc (section "Cargo Bay Connector") (para "This section lists operations specific to the iRobot Create's Cargo Bay Connector. For the connector pinout, see " (hyperlink "http://www.irobot.com/filelibrary/pdfs/hrd/create/Create%20Open%20Interface_v2.pdf" (italic "iRobot Create Open Interface (OI) Specification")) ", page 4.")) (doc (defproc (set-roomba-digital-outputs (#:roomba roomba roomba? (current-roomba)) (#:digital-out-0? digital-out-0? boolean? #false) (#:digital-out-1? digital-out-1? boolean? #false) (#:digital-out-2? digital-out-2? boolean? #false)) void? (para "Sets the digital output pins on the Cargo Bay Connector, where " (racket #true) " is high, and " (racket #false) " is low. For more information, see " (hyperlink "http://www.irobot.com/filelibrary/pdfs/hrd/create/Create%20Open%20Interface_v2.pdf" (italic "iRobot Create Open Interface (OI) Specification")) ", page 10. Works in protocols: " (tech "COI") ". Works in modes: " (racket 'safe) ", " (racket 'full) "."))) (provide set-roomba-digital-outputs) (define (set-roomba-digital-outputs #:roomba (roomba (current-roomba)) #:digital-out-0? (digital-out-0? #false) #:digital-out-1? (digital-out-1? #false) #:digital-out-2? (digital-out-2? #false)) (log-roomba-debug "(set-roomba-digital-outputs #:digital-out-0? ~S #:digital-out-1? ~S #:digital-out-2? ~S)" digital-out-0? digital-out-1? digital-out-2?) (%roomba-protocol-ecase #:error-name 'set-roomba-digital-outputs #:roomba roomba #:cases ((roomba-coi) (%assert-roomba-mode 'set-roomba-digital-outputs roomba '(safe full)) (%send-byte-string-to-roomba roomba (bytes 147 (bitwise-ior (if digital-out-0? #b00000001 0) (if digital-out-1? #b00000010 0) (if digital-out-2? #b00000100 0))))))) (doc (defproc (set-roomba-pwm-low-side-drivers (#:roomba roomba roomba? (current-roomba)) (#:driver-0-voltage-fraction driver-0-voltage-fraction nonnegative-number? 0) (#:driver-1-voltage-fraction driver-1-voltage-fraction nonnegative-number? 0) (#:driver-2-voltage-fraction driver-2-voltage-fraction nonnegative-number? 0)) void? (para "Set the variable voltage levels of the Create's three low side drivers. Each is specified as number from 0.0 to 1.0, representing the fraction of battery voltage to use. For more information, see " (hyperlink "http://www.irobot.com/filelibrary/pdfs/hrd/create/Create%20Open%20Interface_v2.pdf" (italic "iRobot Create Open Interface (OI) Specification")) ", page 10. Works in protocols: " (tech "COI") ". Works in modes: " (racket 'safe) ", " (racket 'full) "."))) (provide set-roomba-pwm-low-side-drivers) (define (set-roomba-pwm-low-side-drivers #:roomba (roomba (current-roomba)) #:driver-0-voltage-fraction (driver-0-voltage-fraction 0.0) #:driver-1-voltage-fraction (driver-1-voltage-fraction 0.0) #:driver-2-voltage-fraction (driver-2-voltage-fraction 0.0)) (log-roomba-debug "(set-roomba-pwm-low-side-drivers #:driver-0-voltage-fraction ~S #:driver-1-voltage-fraction ~S #:driver-2-voltage-fraction ~S)" driver-0-voltage-fraction driver-1-voltage-fraction driver-2-voltage-fraction) (%roomba-protocol-ecase #:error-name 'set-roomba-pwm-low-side-drivers #:roomba roomba #:cases ((roomba-coi) (%assert-roomba-mode 'set-roomba-pwm-low-side-drivers roomba '(safe full)) (%send-byte-string-to-roomba roomba (bytes 144 (%roomba-arg-pwm-128 'set-roomba-pwm-low-side-drivers 'driver-2-voltage-fraction driver-2-voltage-fraction) (%roomba-arg-pwm-128 'set-roomba-pwm-low-side-drivers 'driver-1-voltage-fraction driver-1-voltage-fraction) (%roomba-arg-pwm-128 'set-roomba-pwm-low-side-drivers 'driver-0-voltage-fraction driver-0-voltage-fraction)))))) (doc (defproc (send-roomba-ir-byte (#:roomba roomba roomba? (current-roomba)) (#:byte byte byte?)) void? (para "Send a byte to the iRobot Create's IR receiver. For more information, see " (hyperlink "http://www.irobot.com/filelibrary/pdfs/hrd/create/Create%20Open%20Interface_v2.pdf" (italic "iRobot Create Open Interface (OI) Specification")) ", page 11. Works in protocols: " (tech "COI") ". Works in modes: " (racket 'safe) ", " (racket 'full) "."))) (provide send-roomba-ir-byte) (define (send-roomba-ir-byte #:roomba (roomba (current-roomba)) #:byte byte) (log-roomba-debug "(send-roomba-ir-byte #:roomba ~S #:byte ~S)" roomba byte) (%roomba-protocol-ecase #:error-name 'send-roomba-ir-byte #:roomba roomba #:cases ((roomba-coi) (%assert-roomba-mode 'send-roomba-ir-byte roomba '(safe full)) (%send-byte-string-to-roomba roomba (bytes 151 (%roomba-arg-byte 'send-roomba-ir-byte 'byte byte)))))) (doc (section "Cables") (para "At time of this writing, if you do not already have a cable/adapter to connect PC to Roomba, your options are:") (itemlist (item "Obtain an " (bold (hyperlink "http://irobot.com/create" "iRobot Create")) ", which is an educational/hobby platform variant of the Roomba, which does not include cleaning functionality, and use the included RS232-to-Roomba-mini-DIN cable. Then connect the RS232 cable to your PC, perhaps with an USB-to-RS232 adapter. Or, if you can obtain the no-longer-made iRobot Command Module for the Create, you " (italic "might") " be able to disregard RS232 and rig up the microcontroller to let you use an ordinary USB cable between the Command Module and a PC (and please let us know if you do). The Create is available new, " (hyperlink "http://store.irobot.com/family/index.jsp?categoryId=2591511&s=A-ProductAge" "direct from iRobot") " (model 4400 without recharging for 130 USD, model 4418 with recharging for 220 USD). Note that neither of the Create models currently available new from iRobot contain the Command Module, although used ones often have it.") (item "Attempt to obtain an " (bold "off-the-shelf cable/adapter") ", probably on the used market, since few new ones are currently available:" (itemlist (item (bold "iRobot RS232-to-Roomba-mini-DIN cable") " (model 4814). These were once sold individually by iRobot for, we believe, 20 USD, without having to buy a Create. Now they are sold new only with a Create, perhaps because iRobot would prefer that people just used the Create for education projects. If you can find one of these cables, to plug it into a modern PC, you most likely also want a USB-to-RS232 adapter (approx. 10 USD).") (item (bold "iRobot USB-to-Roomba-mini-DIN cable") ". We have seen a product photo of these, but they are not currently sold by iRobot.") (item (bold "RoboDynamics RooStick") ", a USB-to-Roomba-mini-DIN adapter. Note that we believe these are no longer available new because it seems that RoboDynamics was developing its own robot platform and seems to have gone on hiatus. RoboDynamics did Roomba business as Roomba Dev Tools.") (item (bold "RoboDynamics Roo232") ", an RS232-to-Roomba-mini-DIN adapter. Like the RooStick, new Roo232 units are not available.") (item (bold "RoboDynamics RooTooth") ", a Bluetooth-to-Roomba-mini-DIN adapter. Sparkfun has a small quantity of some version of these (" (hyperlink "https://www.sparkfun.com/products/10980" "Sparkfun item DEV-10980") ", 100 USD). Some changes to this package might be necessary to work with any version of RooTooth. If you have a RooTooth, please contact the package author.") (item (bold (hyperlink "http://www.elementdirect.com/product_info.php?products_id=44" "Element Direct Bluetooth Adapter Module (BAM)")) ", which provides a Bluetooth interface for the iRobot Create, but not the Roomba. It appears to be available currently " (hyperlink "http://www.acroname.com/robotics/parts/I19-10542.html" "from Acroname Robotics") " (part number I19-10542, 60 USD).")) "We're working on getting a particular vendor to make some particular new off-the-shelf cables and adapters, but do not assume that these new products will appear soon. Please contact the author if you can help with this.") (item (bold "Make your own cable/adapter") ". A Web search will turn up many different examples of these that various people have made. To categorize these:" (itemlist (item "Make your own cable/adapter that plugs into the " (bold "mini-DIN connector") " that is on most Roombas and on the iRobot Create. You can find the pinout for this in " (hyperlink "http://www.usna.edu/Users/weapsys/esposito/roomba.matlab/Roomba_SCI.pdf" (italic "iRobot Roomba Serial Command Interface (SCI) Specification")) ", in section ``Physical Connections,'' on page 2. Note that this uses 5V TTL logic levels, so you can't just wire it up to an RS232 port. Your options for connecting this to a computer include:" (itemlist (item "Convert it to " (bold "RS232") ", using a voltage level converter, and wiring up a 25-pin or 9-pin D-sub connector.") (item "Convert it to " (bold "USB") ", such as using an FTDI chip.") (item "Hook it up directly to 5V " (bold "I/O pins") " on a Rasperry Pi, Arduino, or other low-power computer. This is more an option if the computer is onboard the Robot; otherwise you probably want to go to RS232 or USB first."))) (item "Make your own cable/adapter that plugs into the " (bold "Create's Cargo Bay Connector") ", which is a 25-pin " (hyperlink "http://en.wikipedia.org/wiki/D-subminiature" "D-sub connector") " with a pinout that is specific to the Create. (Note that the same kind of connector traditionally is used for RS232 and for parallel printer port connectors on IBM PCs, but the connector on the Create is neither of those.) The Cargo Bay Connector is documented in document " (hyperlink "http://www.irobot.com/filelibrary/create/Create%2520Manual_Final.pdf" (italic "iRobot Create Owner's Guide")) ", in section ``Cargo Bay Connector,'' on page 10. Note that, in addition to providing a serial interface needed by this package, the Cargo Bay Connector also provides additional sensor inputs and considerable power, which could be used to power an onboard adapter or low-power computer. Options for using the Cargo Bay connector:" (itemlist (item "Build an " (bold "RS232, USB, or Bluetooth") " interface for interfacing with an offboard or onboard PC. This is an option, but if you're only going to use the serial interface, you might as well connect to the mini-DIN (see above) rather than the Cargo Bay Connector, so that your cable/adapter works with most Roombas rather than just the Create.") (item "Build a " (bold "serial-and-power") " interface for a Raspberry Pi, Arduino, or other low-power computer. We believe there is enough current to power a Pi plus USB devices like WiFi adapter, in addition to the Create itself. This onboard computer could then run your program on itself and/or provide a WiFi link to offboard computers.")))))) (para "Note that most of the above options have not yet been tested with this package, and a small number of them might require modifications to this package.") (para "The excutive summary on cables/adapaters at the moment is that most people's educational/hobby project lives would be easier if they can afford an iRobot Create. Especially if you can put a Raspberry Pi onboard the Create. But, with a little work or luck, you can also get an old Roomba hooked up to a computer for using this package. And hopefully a hobby-oriented electronics company will soon make things easier.") (para "If you have any updates to the above information, please contact the author of this package.")) (doc (section #:tag "Association List Primer" "Association List Primer") (para "For returning values from " (racket read-roomba-sensors) ", this package use an " (deftech "association list") " (also known as an " (deftech "alist") "), which is an old-school Lisp way of representing small keyed-accessed sets, among other things. (In the future, there might be other, even more efficient, ways to access Roomba sensors from this package, but alists are a good initial method.) Since hobbyists and students new to Racket might be familiar with pairs and lists, but not with alists, here is a quick intro.") (para "Let's say you received an alist like this:") (racketinput (define result (read-roomba-sensors #:packet-code 3))) (racketinput result) (racketresultblock ((battery-capacity . 973) (battery-charge . 889) (battery-temperature . 30) (battery-current . -176) (battery-voltage . 13888))) (para "If you use the Racket " (racket assq) " procedure alone to look up the alist pair with the key " (racket 'battery-charge) ", you get the entire pair:") (racketinput (assq 'battery-charge result) #,(racketresult (battery-charge . 889))) (para "As you probably know from prior study of Racket pairs and lists, to get the right-hand side of the pair, which has the value for the key, you use the Racket " (racket cdr) " procedure:") (racketinput (cdr (assq 'battery-charge result)) #,(racketresult 889)) (para "One difficulty is that, if " (racket assq) " doesn't find the key, it will return " (racket #f) " rather than a pair. So, say that on some Roombas you get a " (racket 'battery-coolness) " sensor result, but on others you don't. So, if you try to look up that key in our example alist:") (racketinput (assq 'battery-coolness result) #,(racketresult #f)) (racketinput (cdr (assq 'battery-coolness result))) (nested #:style 'inset (racketerror "cdr: contract violation\n expected: pair?\n given: #f")) (para "If you want your code to be robust against that, you can use this code pattern of " (racket cond) " and " (racket =>) ", which will give you either the value of the the alist pair for key " (racket 'battery-coolness) ", or a default value of " (racket 777) ":") (racketinput (cond ((assq 'battery-coolness result) => cdr) (else 777)) #,(racketresult 777)) (para "You can also get fancier, such as adding a helpful error message and moving the code that uses the " (racket 'battery-coolness) " into a the " (racket cond) ", like so:") (racketblock (cond ((assq 'battery-coolness result) => (lambda (battery-coolness) #,(italic "...CODE-THAT-USES-BATTERY-COOLNESS-VALUE..."))) (else (error "Roomba has an uncool battery!")))) (para "For most purposes, with Roomba sensor values, you'll only need the code pattern " (racket (cdr (assq #,(italic "SYMBOL") #,(italic "ALIST")))) ", but " (racket cond) " is there if you need it.")) (doc (section "Troubleshooting") (para "Here are a few troubleshooting tips.") (para "First things first:") (itemlist #:style 'ordered (item "Ensure that the serial cable or other interface is firmly attached in all places it could become loose.") (item "If you built a serial interface using instructions found on the Web, be aware that some pinout diagrams for the mini-DIN were published with pins reversed. Double-check against different pinouts.") ;; TODO: We really should document the correct pinout, at least ;; until there's a currently-available standard cable. (item "If you're connecting to an iRobot Create using the Command Module, make sure that you follow the boot-time procedures documentd in the " (hyperlink "http://www.irobot.com/filelibrary/pdfs/hrd/create/Command%20Module%20Manual_v2.pdf" (italic "iRobot Command Module Owners Manual")) ". Also note that the developers of this package have not yet tested use through the Command Module.")) (para "If the PC's serial port or other interface on the PC side is not working:") (itemlist #:style 'ordered (item "Consider whether you have the right device file for your " (racket #:device) " argument. For example, if you're specifying device " (racket "/dev/ttyS0") ", maybe the correct device is " (racket "/dev/ttyS1") ", " (racket "/dev/ttyUSB0") ", or something else.") (item "If you're using a USB interface on the PC side, perhaps using a USB-to-RS232 adapter with an iRobot RS232-to-Roomba cable, check whether the USB device is actually recognized by the PC. On GNU/Linux, you can use the " (tt "lsusb") " shell command to list recognized USB devices, and you can also check the " (tt "syslog") " log files for the time that you plugged in the device.") (item "If the PC's serial port is an RS232 port on a laptop dock, consider that a hardware or operating system bug might be causing the serial port to ``disappeared''. This has been known to happen with a ThinkPad T60 plugged into a dock, for example, and the solution in that case is to reboot the laptop while plugged into the dock.")) (para "If the PC's serial port or other interface on the PC side seems OK, but the Roomba is still not communicating:") (itemlist #:style 'ordered (item "On at least some Roomba models (including the 400), the Clean or Power button should be solid green before the Roomba can be accessed via this package. If button is not solid green, try pressing it, in hopes of it turning solid green. Be prepared to lift up the Roomba if pressing the button starts a clean cycle.") (item "If the Roomba's Clean or Power button is not solid green and pressing does not correct that, try removing and reattaching the cable from the Roomba's serial port.") (item "If all else fails, try removing the cable from the Roomba's mini-DIN, removing the Roomba's battery, waiting a few seconds, reattaching the Roomba's battery, and finally reattaching the cable to the Roomba's mini-DIN.") (item "Consider that the Roomba is refusing to communicate because its battery desperately needs charging, even if it appears to have some charge left.")) (para "Please contact the author of this package with additional tips that should be mentioned here.")) ;; Note: Command Module identifies as USB device: ;; ;; lsusb ;; Bus 002 Device 003: ID 0403:6001 Future Technology Devices International, Ltd FT232 USB-Serial (UART) IC ;; And plugging in Command Module USB looks in /var/log/syslog like: ;; Sep 3 22:57:18 computer kernel: [332036.933086] usb 2-2: new full speed USB device using uhci_hcd and address 4 ;; Sep 3 22:57:18 computer kernel: [332037.129132] usb 2-2: New USB device found, idVendor=0403, idProduct=6001 ;; Sep 3 22:57:18 computer kernel: [332037.129140] usb 2-2: New USB device strings: Mfr=1, Product=2, SerialNumber=3 ;; Sep 3 22:57:18 computer kernel: [332037.129145] usb 2-2: Product: FT232R USB UART ;; Sep 3 22:57:18 computer kernel: [332037.129150] usb 2-2: Manufacturer: FTDI ;; Sep 3 22:57:18 computer kernel: [332037.129154] usb 2-2: SerialNumber: A3000E67 ;; Sep 3 22:57:18 computer kernel: [332037.129326] usb 2-2: configuration #1 chosen from 1 choice ;; Sep 3 22:57:18 computer kernel: [332037.136176] ftdi_sio 2-2:1.0: FTDI USB Serial Device converter detected ;; Sep 3 22:57:18 computer kernel: [332037.136219] usb 2-2: Detected FT232RL ;; Sep 3 22:57:18 computer kernel: [332037.136224] usb 2-2: Number of endpoints 2 ;; Sep 3 22:57:18 computer kernel: [332037.136229] usb 2-2: Endpoint 1 MaxPacketSize 64 ;; Sep 3 22:57:18 computer kernel: [332037.136233] usb 2-2: Endpoint 2 MaxPacketSize 64 ;; Sep 3 22:57:18 computer kernel: [332037.136238] usb 2-2: Setting MaxPacketSize 64 ;; Sep 3 22:57:18 computer kernel: [332037.137190] usb 2-2: FTDI USB Serial Device converter now attached to ttyUSB1 (doc (section "Known Issues") (itemlist (item "Needs initial testing, with different models.") (item "Figure out why DrRacket is prompting for input in the Interactions pane under some unclear circumstances.") (item "Create operations not yet implemented: Sensors (142) new sensors, Query List (149), Stream (148), Pause/Resume Stream (150) Script (152, 153, 154), Wait (155, 156, 157, 158).") (item "Add more detailed documentation for sensors, such that the iRobot manuals are unlikely to be necessary for most purposes.") (item "Finish adding support for Create operations.") (item "Add support for any ROI features not in SCI, rather than limiting 500/600 series to 2nd generation features.") (item "Test use of USB interface of Create Command Module, once we have a working one.") (item "Improve how stdio error messages are handled when calling " (tt "/bin/stty") ".") (item "We might be able to do better waking of the Roomba, using RTS. However, we cannot test this at this time, since, on our test setup at the moment (Roomba 400, plugged into iRobot brand cable, plugged into RS232 port of ThinkPad dock), even example code does not wake the Roomba.") (item "Any any special support needed for other off-the-shelf Roomba hardware interfaces, such as those by RoboDynamics. We are aware that some of them are reported to need special handling, but we do not presently have use of them for testing.") (item "A " (racket let-roomba-sensors) " would be nice, so you could do things like this efficiently on SCI (OI makes it easier):" (racketblock (let-roomba-sensors (wall battery-charge distance angle) ...)) "We have an example but have not coded it yet, til we look more closely at the different OI specs. Until then, we expect that the form would expand to code that looked at the protocol at runtime, and did different optimizations for SCI, ROI and COI.") (item "Support a little bit more of Common Music Notation, especially for meter.") (item "Add convenience for compiling and playing songs longer than 16 notes.") (item "Test on Mac OS X.") (item "Possibly add support for Microsoft Windows. Especially if Windows 7 and later have filesystem path devices for serial ports.") (item "Put Raspberry Pi with WiFi onboard an iRobot Create. Hook up development tools so that Roomba programs can run onboard, on the Pi, as well as offboard on PC (say, in DrRacket for debugging), with the Pi gatewaying the OI protocol received over SSH WiFi."))) (doc history (#:planet 1:4 #:date "2013-09-04" (itemlist (item "Documentation tweaks."))) (#:planet 1:3 #:date "2013-09-02" (itemlist (item "Added documentation section " (secref "Association List Primer") ".") (item "Documentation tweaks."))) (#:planet 1:2 #:date "2013-09-01" (itemlist (item "Added sensor support for iRobot Create (aka protocol " (racket irobot-coi) ").") (item "Added operations for iRobot Create: " (racket start-roomba-demo) ", " (racket stop-roomba-demo) ", " (racket set-roomba-wheels) ", " (racket set-roomba-digital-outputs) ", " (racket set-roomba-pwm-low-side-drivers) ", " (racket send-roomba-ir-byte) ".") (item "Added more documentation for sensors.") (item "The default parameter value of " (racket current-default-roomba-device) " has changed on some platforms, from " (racket "/dev/ttyS0") " to " (racket "/dev/ttyUSB0") ", since we expect more people will be using a USB-to-RS232 adapter on Linux than a more direct RS232 port.") (item "Added exception " (racket exn:fail:roomba:unsupported) ".") (item "Documentation tweaks.") (item "Title of package changed slightly."))) (#:planet 1:1 #:date "2012-08-19" (itemlist (item "Added section " (secref "Cables") ". (Thanks to Jens Axel S\u00F8gaard for pointing out the need for this.)") (item "Minor documentation tweaks."))) (#:planet 1:0 #:date "2013-08-18" (itemlist (item "Initial release. Still needs some initial testing with various different Roombas, and we are releasing now for that purposes."))))