ported sosc library to Racket
This commit is contained in:
Mustafa
parent
a88c6e0218
commit
2617455b9d
4 changed files with 710 additions and 0 deletions
64
sosc/bytevector.rkt
Normal file
64
sosc/bytevector.rkt
Normal file
|
|
@ -0,0 +1,64 @@
|
|||
#lang racket
|
||||
|
||||
(require "../rhs/rhs.rkt" rnrs/bytevectors-6 rnrs/io/ports-6)
|
||||
|
||||
(provide (all-defined-out)
|
||||
put-bytevector
|
||||
get-bytevector-n
|
||||
bytevector-length)
|
||||
|
||||
;; bytevector -> (port -> any) -> any
|
||||
(define with-input-from-bytevector
|
||||
(lambda (b f)
|
||||
(let* ((p (open-bytevector-input-port b))
|
||||
(r (f p)))
|
||||
(close-port p)
|
||||
r)))
|
||||
|
||||
;; bytevector -> int -> int -> bytevector
|
||||
(define bytevector-section
|
||||
(lambda (v l r)
|
||||
(let* ((n (- r l))
|
||||
(w (make-bytevector n 0)))
|
||||
(bytevector-copy! v l w 0 n)
|
||||
w)))
|
||||
|
||||
;; bytevector -> byte -> int
|
||||
(define bytevector-find-index
|
||||
(lambda (v x)
|
||||
(letrec ((f (lambda (i)
|
||||
(if (= (bytevector-u8-ref v i) x)
|
||||
i
|
||||
(f (+ i 1))))))
|
||||
(f 0))))
|
||||
|
||||
;; Tree bytevector -> bytevector
|
||||
(define flatten-bytevectors
|
||||
(lambda (t)
|
||||
(let* ((l (flatten t))
|
||||
(n (map1 bytevector-length l))
|
||||
(m (sum n))
|
||||
(v (make-bytevector m)))
|
||||
(let loop ((i 0)
|
||||
(l l)
|
||||
(n n))
|
||||
(if (null? l)
|
||||
v
|
||||
(let ((l0 (car l))
|
||||
(n0 (car n)))
|
||||
(bytevector-copy! l0 0 v i n0)
|
||||
(loop (+ i n0) (cdr l) (cdr n))))))))
|
||||
|
||||
;; number a => (bytevector -> int -> a -> ()) -> int -> a
|
||||
(define bytevector-make-and-set1
|
||||
(lambda (f k n)
|
||||
(let ((v (make-bytevector k 0)))
|
||||
(f v 0 n)
|
||||
v)))
|
||||
|
||||
;; number a => (bytevector -> int -> a -> ()) -> int -> a
|
||||
(define bytevector-make-and-set
|
||||
(lambda (f k n)
|
||||
(let ((v (make-bytevector k 0)))
|
||||
(f v 0 n (endianness big))
|
||||
v)))
|
||||
82
sosc/ip.rkt
Normal file
82
sosc/ip.rkt
Normal file
|
|
@ -0,0 +1,82 @@
|
|||
#lang racket
|
||||
|
||||
;; from plt/ip.scm ;;;;;;;;;;
|
||||
|
||||
|
||||
(require (prefix-in plt: racket)
|
||||
(prefix-in plt: racket/udp)
|
||||
"bytevector.rkt"
|
||||
)
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
||||
|
||||
;; data udp
|
||||
(struct udp* (s h p))
|
||||
|
||||
;; any -> bool
|
||||
(define udp:socket?
|
||||
udp*?)
|
||||
|
||||
;; string -> int -> socket
|
||||
(define udp:open
|
||||
(lambda (h p)
|
||||
(udp* (plt:udp-open-socket h p) h p)))
|
||||
|
||||
;; socket -> bytevector -> ()
|
||||
(define udp:send
|
||||
(lambda (u b)
|
||||
(let ((s (udp*-s u))
|
||||
(h (udp*-h u))
|
||||
(p (udp*-p u)))
|
||||
(plt:udp-send-to* s h p b))))
|
||||
|
||||
;; socket -> maybe bytevector
|
||||
(define udp:recv
|
||||
(lambda (u)
|
||||
(let* ((s (udp*-s u))
|
||||
(h (udp*-h u))
|
||||
(p (udp*-p u))
|
||||
(b (bytes 8192))
|
||||
(r (plt:sync/timeout 1.0 (plt:udp-receive!-evt s b))))
|
||||
(if r
|
||||
(plt:subbytes b 0 (plt:car r))
|
||||
#f))))
|
||||
|
||||
;; socket -> ()
|
||||
(define udp:close
|
||||
(lambda (u)
|
||||
(plt:udp-close (udp*-s u))))
|
||||
|
||||
;; data tcp
|
||||
(plt:define-struct tcp* (i o h p))
|
||||
|
||||
;; any -> bool
|
||||
(define tcp:socket?
|
||||
tcp*?)
|
||||
|
||||
;; string -> int -> socket
|
||||
(define tcp:open
|
||||
(lambda (h p)
|
||||
(let-values
|
||||
(((i o) (plt:tcp-connect h p)))
|
||||
(plt:file-stream-buffer-mode i 'none)
|
||||
(plt:file-stream-buffer-mode o 'none)
|
||||
(make-tcp* i o h p))))
|
||||
|
||||
;; socket -> bytevector -> ()
|
||||
(define tcp:send
|
||||
(lambda (fd b)
|
||||
(let ((o (tcp*-o fd)))
|
||||
(put-bytevector o b))))
|
||||
|
||||
;; socket -> int -> maybe bytevector
|
||||
(define tcp:read
|
||||
(lambda (fd n)
|
||||
(get-bytevector-n (tcp*-i fd) n)))
|
||||
|
||||
;; socket -> ()
|
||||
(define tcp:close
|
||||
(lambda (fd)
|
||||
(close-input-port (tcp*-i fd))
|
||||
(close-output-port (tcp*-o fd))))
|
||||
522
sosc/sosc.rkt
Normal file
522
sosc/sosc.rkt
Normal file
|
|
@ -0,0 +1,522 @@
|
|||
#lang racket
|
||||
|
||||
|
||||
|
||||
(require
|
||||
rnrs
|
||||
rnrs/bytevectors-6
|
||||
"../rhs/rhs.rkt"
|
||||
"bytevector.rkt"
|
||||
)
|
||||
|
||||
|
||||
(provide message
|
||||
bundle
|
||||
encode-osc
|
||||
decode-osc
|
||||
encode-u8
|
||||
encode-i16
|
||||
encode-i32
|
||||
encode-f32
|
||||
encode-pstr
|
||||
encode-u32
|
||||
decode-u32 )
|
||||
|
||||
;; bytevector -> int
|
||||
(define decode-u8
|
||||
(lambda (v)
|
||||
(bytevector-u8-ref v 0)))
|
||||
|
||||
;; bytevector -> int
|
||||
(define decode-u16
|
||||
(lambda (v)
|
||||
(bytevector-u16-ref v 0 (endianness big))))
|
||||
|
||||
;; bytevector -> int
|
||||
(define decode-u32
|
||||
(lambda (v)
|
||||
(bytevector-u32-ref v 0 (endianness big))))
|
||||
|
||||
;; bytevector -> int
|
||||
(define decode-u64
|
||||
(lambda (v)
|
||||
(bytevector-u64-ref v 0 (endianness big))))
|
||||
|
||||
;; bytevector -> int
|
||||
(define decode-i8
|
||||
(lambda (v)
|
||||
(bytevector-s8-ref v 0)))
|
||||
|
||||
;; bytevector -> int
|
||||
(define decode-i16
|
||||
(lambda (v)
|
||||
(bytevector-s16-ref v 0 (endianness big))))
|
||||
|
||||
;; bytevector -> int
|
||||
(define decode-i32
|
||||
(lambda (v)
|
||||
(bytevector-s32-ref v 0 (endianness big))))
|
||||
|
||||
;; bytevector -> int
|
||||
(define decode-i64
|
||||
(lambda (v)
|
||||
(bytevector-s64-ref v 0 (endianness big))))
|
||||
|
||||
;; bytevector -> double
|
||||
(define decode-f32
|
||||
(lambda (v)
|
||||
(bytevector-ieee-single-ref v 0 (endianness big))))
|
||||
|
||||
;; bytevector -> double
|
||||
(define decode-f64
|
||||
(lambda (v)
|
||||
(bytevector-ieee-double-ref v 0 (endianness big))))
|
||||
|
||||
;; bytevector -> string
|
||||
(define decode-str
|
||||
(lambda (b)
|
||||
(utf8->string b)))
|
||||
|
||||
;; bytevector -> string
|
||||
(define decode-pstr
|
||||
(lambda (v)
|
||||
(let* ((n (decode-u8 v))
|
||||
(w (bytevector-section v 1 (+ n 1))))
|
||||
(decode-str w))))
|
||||
|
||||
;; bytevector -> string
|
||||
(define decode-cstr
|
||||
(lambda (v)
|
||||
(let* ((n (bytevector-find-index v 0))
|
||||
(w (bytevector-section v 0 n)))
|
||||
(decode-str w))))
|
||||
|
||||
;; int -> bytevector
|
||||
(define encode-u8
|
||||
(lambda (n)
|
||||
(bytevector-make-and-set1
|
||||
bytevector-u8-set!
|
||||
1
|
||||
(exact n))))
|
||||
|
||||
;; int -> bytevector
|
||||
(define encode-u16
|
||||
(lambda (n)
|
||||
(bytevector-make-and-set
|
||||
bytevector-u16-set!
|
||||
2
|
||||
(exact n))))
|
||||
|
||||
;; int -> bytevector
|
||||
(define encode-u32
|
||||
(lambda (n)
|
||||
(bytevector-make-and-set
|
||||
bytevector-u32-set!
|
||||
4
|
||||
(exact n))))
|
||||
|
||||
;; int -> bytevector
|
||||
(define encode-u64
|
||||
(lambda (n)
|
||||
(bytevector-make-and-set
|
||||
bytevector-u64-set!
|
||||
8
|
||||
(exact n))))
|
||||
|
||||
;; int -> bytevector
|
||||
(define encode-i8
|
||||
(lambda (n)
|
||||
(bytevector-make-and-set1
|
||||
bytevector-s8-set!
|
||||
1
|
||||
(exact n))))
|
||||
|
||||
;; int -> bytevector
|
||||
(define encode-i16
|
||||
(lambda (n)
|
||||
(bytevector-make-and-set
|
||||
bytevector-s16-set!
|
||||
2
|
||||
(exact n))))
|
||||
|
||||
;; int -> bytevector
|
||||
(define encode-i32
|
||||
(lambda (n)
|
||||
(bytevector-make-and-set
|
||||
bytevector-s32-set!
|
||||
4
|
||||
(exact n))))
|
||||
|
||||
;; int -> bytevector
|
||||
(define encode-i64
|
||||
(lambda (n)
|
||||
(bytevector-make-and-set
|
||||
bytevector-s64-set!
|
||||
8
|
||||
(exact n))))
|
||||
|
||||
;; double -> bytevector
|
||||
(define encode-f32
|
||||
(lambda (n)
|
||||
(bytevector-make-and-set
|
||||
bytevector-ieee-single-set!
|
||||
4
|
||||
(inexact n))))
|
||||
|
||||
;; double -> bytevector
|
||||
(define encode-f64
|
||||
(lambda (n)
|
||||
(bytevector-make-and-set
|
||||
bytevector-ieee-double-set!
|
||||
8
|
||||
(inexact n))))
|
||||
|
||||
;; string -> bytevector
|
||||
(define encode-str
|
||||
(lambda (s)
|
||||
(string->utf8 s)))
|
||||
|
||||
;; string -> bytevector
|
||||
(define encode-pstr
|
||||
(lambda (s)
|
||||
(let* ((b (encode-str s))
|
||||
(n (encode-u8 (bytevector-length b))))
|
||||
(list n b))))
|
||||
|
||||
;; string -> [bytevector]
|
||||
(define encode-cstr
|
||||
(lambda (s)
|
||||
(let* ((b (encode-str s))
|
||||
(z (encode-u8 0)))
|
||||
(list b z))))
|
||||
|
||||
;; port -> string
|
||||
(define read-pstr
|
||||
(lambda (p)
|
||||
(let* ((n (lookahead-u8 p))
|
||||
(v (read-bstr p (+ n 1))))
|
||||
(decode-pstr v))))
|
||||
|
||||
;; port -> string
|
||||
(define read-cstr
|
||||
(lambda (p)
|
||||
(let loop ((l nil)
|
||||
(b (get-u8 p)))
|
||||
(if (= b 0)
|
||||
(list->string (map1 integer->char (reverse l)))
|
||||
(loop (cons b l) (get-u8 p))))))
|
||||
|
||||
;; port -> int -> bytevector
|
||||
(define read-bstr
|
||||
(lambda (p n)
|
||||
(get-bytevector-n p n)))
|
||||
|
||||
;; port -> int
|
||||
(define read-i16
|
||||
(lambda (p)
|
||||
(decode-i16 (read-bstr p 2))))
|
||||
|
||||
;; port -> int
|
||||
(define read-u16
|
||||
(lambda (p)
|
||||
(decode-u16 (read-bstr p 2))))
|
||||
|
||||
;; port -> int
|
||||
(define read-i32
|
||||
(lambda (p)
|
||||
(decode-i32 (read-bstr p 4))))
|
||||
|
||||
;; port -> int
|
||||
(define read-u32
|
||||
(lambda (p)
|
||||
(decode-u32 (read-bstr p 4))))
|
||||
|
||||
;; port -> int
|
||||
(define read-i64
|
||||
(lambda (p)
|
||||
(decode-i64 (read-bstr p 8))))
|
||||
|
||||
;; port -> int
|
||||
(define read-u64
|
||||
(lambda (p)
|
||||
(decode-u64 (read-bstr p 8))))
|
||||
|
||||
;; port -> double
|
||||
(define read-f32
|
||||
(lambda (p)
|
||||
(decode-f32 (read-bstr p 4))))
|
||||
|
||||
;; port -> double
|
||||
(define read-f64
|
||||
(lambda (p)
|
||||
(decode-f64 (read-bstr p 8))))
|
||||
|
||||
;; int
|
||||
(define seconds-from-1900-to-1970
|
||||
(+ (* 70 365 24 60 60) (* 17 24 60 60)))
|
||||
|
||||
;; double -> int
|
||||
(define ntpr->ntp
|
||||
(lambda (n)
|
||||
(exact (round (* n (expt 2 32))))))
|
||||
|
||||
;; double -> double
|
||||
(define utc->ntpr
|
||||
(lambda (n)
|
||||
(+ n seconds-from-1900-to-1970)))
|
||||
|
||||
;; int -> double
|
||||
(define ntp->utc
|
||||
(lambda (n)
|
||||
(- (/ n (expt 2 32)) seconds-from-1900-to-1970)))
|
||||
|
||||
;; port -> string
|
||||
(define read-ostr
|
||||
(lambda (p)
|
||||
(let* ((s (read-cstr p))
|
||||
(n (mod (cstring-length s) 4))
|
||||
(i (- 4 (mod n 4))))
|
||||
(if (not (= n 0))
|
||||
(read-bstr p i)
|
||||
#f)
|
||||
s)))
|
||||
|
||||
;; port -> bytevector
|
||||
(define read-obyt
|
||||
(lambda (p)
|
||||
(let* ((n (read-i32 p))
|
||||
(b (read-bstr p n))
|
||||
(i (- 4 (mod n 4))))
|
||||
(if (not (= n 0))
|
||||
(read-bstr p i)
|
||||
#f)
|
||||
b)))
|
||||
|
||||
;; datum = int | double | string | bytevector
|
||||
|
||||
;; port -> char -> datum
|
||||
(define read-value
|
||||
(lambda (p t)
|
||||
(cond
|
||||
((equal? t oI32) (read-i32 p))
|
||||
((equal? t oI64) (read-i64 p))
|
||||
((equal? t oU64) (read-u64 p))
|
||||
((equal? t oF32) (read-f32 p))
|
||||
((equal? t oF64) (read-f64 p))
|
||||
((equal? t oSTR) (read-ostr p))
|
||||
((equal? t oBYT) (read-obyt p))
|
||||
((equal? t oMID) (read-u32 p))
|
||||
(else (error "read-value" "bad type" t)))))
|
||||
|
||||
;; port -> [char] -> [datum]
|
||||
(define read-arguments
|
||||
(lambda (p types)
|
||||
(if (null? types)
|
||||
'()
|
||||
(cons (read-value p (car types))
|
||||
(read-arguments p (cdr types))))))
|
||||
|
||||
;; port -> (string:[datum])
|
||||
(define read-message
|
||||
(lambda (p)
|
||||
(let* ((address (read-ostr p))
|
||||
(types (read-ostr p)))
|
||||
(cons address
|
||||
(read-arguments p (cdr (string->list types)))))))
|
||||
|
||||
;; port -> (utc:[message])
|
||||
(define read-bundle
|
||||
(lambda (p)
|
||||
(let ((bundletag (read-ostr p))
|
||||
(timetag (ntp->utc (read-u64 p)))
|
||||
(parts (list)))
|
||||
(if (not (equal? bundletag "#bundle"))
|
||||
(error "read-bundle"
|
||||
"illegal bundle tag"
|
||||
bundletag)
|
||||
(cons timetag
|
||||
(let loop ((parts (list)))
|
||||
(if (eof-object? (lookahead-u8 p))
|
||||
(reverse parts)
|
||||
(begin
|
||||
;; We have no use for the message size...
|
||||
(read-i32 p)
|
||||
(loop (cons (read-packet p) parts))))))))))
|
||||
|
||||
;; byte
|
||||
(define hash-u8
|
||||
(char->integer #\#))
|
||||
|
||||
;; port -> osc
|
||||
(define read-packet
|
||||
(lambda (p)
|
||||
(if (equal? (lookahead-u8 p) hash-u8)
|
||||
(read-bundle p)
|
||||
(read-message p))))
|
||||
|
||||
;; bytevector -> osc
|
||||
(define decode-osc
|
||||
(lambda (b)
|
||||
(with-input-from-bytevector b read-packet)))
|
||||
|
||||
;; [byte] -> ()
|
||||
(define osc-display
|
||||
(lambda (l)
|
||||
(zip-with
|
||||
(lambda (b n)
|
||||
(display (list (number->string b 16) (integer->char b)))
|
||||
(if (= 3 (mod n 4))
|
||||
(newline)
|
||||
(display #\space)))
|
||||
l
|
||||
(enum-from-to 0 (- (length l) 1)))))
|
||||
|
||||
;; string -> int
|
||||
(define cstring-length
|
||||
(lambda (s)
|
||||
(+ 1 (string-length s))))
|
||||
|
||||
;; int -> int
|
||||
;; (equal? (map osc-align (enum-from-to 0 7)) (list 0 3 2 1 0 3 2 1))
|
||||
(define osc-align
|
||||
(lambda (n)
|
||||
(- (fxand (+ n 3) (fxnot 3)) n)))
|
||||
|
||||
;; int -> [bytevector]
|
||||
(define padding-of
|
||||
(lambda (n) (replicate (osc-align n) (encode-u8 0))))
|
||||
|
||||
;; string -> [bytevector]
|
||||
(define encode-string
|
||||
(lambda (s)
|
||||
(list (encode-cstr s) (padding-of (cstring-length s)))))
|
||||
|
||||
;; bytevector -> [bytevector]
|
||||
(define encode-bytes
|
||||
(lambda (b)
|
||||
(let ((n (bytevector-length b)))
|
||||
(list (encode-i32 n)
|
||||
b
|
||||
(padding-of n)))))
|
||||
|
||||
;; datum -> bytevector
|
||||
(define encode-value
|
||||
(lambda (e)
|
||||
(cond ((number? e) (if (integer? e)
|
||||
(encode-i32 e)
|
||||
(encode-f32 e)))
|
||||
((string? e) (encode-string e))
|
||||
((bytevector? e) (encode-bytes e))
|
||||
(else (error "encode-value" "illegal value" e)))))
|
||||
|
||||
;; [datum] -> bytevector
|
||||
(define encode-types
|
||||
(lambda (l)
|
||||
(encode-string
|
||||
(list->string
|
||||
(cons #\,
|
||||
(map1 (lambda (e)
|
||||
(cond ((number? e) (if (integer? e)
|
||||
#\i
|
||||
#\f))
|
||||
((string? e) #\s)
|
||||
((bytevector? e) #\b)
|
||||
(else (error "encode-types" "type?" e))))
|
||||
l))))))
|
||||
|
||||
;; osc -> [bytevector]
|
||||
(define encode-message
|
||||
(lambda (m)
|
||||
(list (encode-string (car m))
|
||||
(encode-types (cdr m))
|
||||
(map1 encode-value (cdr m)))))
|
||||
|
||||
;; osc -> [bytevector]
|
||||
(define encode-bundle-ntp
|
||||
(lambda (b)
|
||||
(list (encode-string "#bundle")
|
||||
(encode-u64 (ntpr->ntp (car b)))
|
||||
(map1 (lambda (e)
|
||||
(if (message? e)
|
||||
(encode-bytes (encode-osc e))
|
||||
(error "encode-bundle" "illegal value" e)))
|
||||
(cdr b)))))
|
||||
|
||||
;; osc -> [bytevector]
|
||||
(define encode-bundle
|
||||
(lambda (b)
|
||||
(encode-bundle-ntp (cons (utc->ntpr (car b)) (cdr b)))))
|
||||
|
||||
;; osc -> bytevector
|
||||
(define encode-osc
|
||||
(lambda (p)
|
||||
(flatten-bytevectors
|
||||
(if (bundle? p)
|
||||
(encode-bundle p)
|
||||
(encode-message p)))))
|
||||
|
||||
;; any | [any] -> datum | [datum]
|
||||
(define purify
|
||||
(lambda (e)
|
||||
(cond ((or (number? e) (string? e) (bytevector? e)) e)
|
||||
((list? e) (map1 purify e))
|
||||
((symbol? e) (symbol->string e))
|
||||
((boolean? e) (if e 1 0))
|
||||
(else (error "purify" "illegal input" e)))))
|
||||
|
||||
;; char
|
||||
(define oI32 #\i)
|
||||
(define oI64 #\h)
|
||||
(define oU64 #\t)
|
||||
(define oF32 #\f)
|
||||
(define oF64 #\d)
|
||||
(define oSTR #\s)
|
||||
(define oBYT #\b)
|
||||
(define oMID #\m)
|
||||
|
||||
;; string -> [any] -> osc
|
||||
(define message
|
||||
(lambda (c l)
|
||||
(if (string? c)
|
||||
(cons c l)
|
||||
(error "message" "illegal address"))))
|
||||
|
||||
;; float -> [any] -> osc
|
||||
(define bundle
|
||||
(lambda (t l)
|
||||
(if (number? t)
|
||||
(cons t l)
|
||||
(error "bundle" "illegal timestamp" t))))
|
||||
|
||||
;; osc -> bool
|
||||
(define message?
|
||||
(lambda (p)
|
||||
(string? (car p))))
|
||||
|
||||
;; osc -> bool
|
||||
(define bundle?
|
||||
(lambda (p)
|
||||
(number? (car p))))
|
||||
|
||||
;; osc -> bool
|
||||
(define verify-message
|
||||
(lambda (m)
|
||||
(and (string? (car m))
|
||||
(all (lambda (e) (or (number? e)
|
||||
(string? e)))
|
||||
(cdr m)))))
|
||||
|
||||
;; osc -> bool
|
||||
(define verify-bundle
|
||||
(lambda (b)
|
||||
(and (integer? (car b))
|
||||
(all (lambda (e) (or (verify-message e)
|
||||
(and (verify-bundle e)
|
||||
(>= (car e) (car b)))))
|
||||
(cdr b)))))
|
||||
|
||||
;; osc -> bool
|
||||
(define verify-packet
|
||||
(lambda (p)
|
||||
(or (verify-message p)
|
||||
(verify-bundle p))))
|
||||
42
sosc/transport.rkt
Normal file
42
sosc/transport.rkt
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
#lang racket
|
||||
|
||||
;; from transport.scm ;;;;;;;
|
||||
|
||||
(require "bytevector.rkt"
|
||||
"sosc.rkt"
|
||||
"ip.rkt")
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
||||
|
||||
|
||||
;; socket -> osc -> ()
|
||||
(define send
|
||||
(lambda (fd m)
|
||||
(let ((b (encode-osc m)))
|
||||
(cond ((udp:socket? fd)
|
||||
(udp:send fd b))
|
||||
((tcp:socket? fd)
|
||||
(tcp:send fd (encode-u32 (bytevector-length b)))
|
||||
(tcp:send fd b))))))
|
||||
|
||||
;; port -> maybe osc
|
||||
(define recv
|
||||
(lambda (fd)
|
||||
(cond ((udp:socket? fd)
|
||||
(let ((b (udp:recv fd)))
|
||||
(and b (decode-osc b))))
|
||||
((tcp:socket? fd)
|
||||
(let* ((b (tcp:read fd 4))
|
||||
(n (decode-u32 b)))
|
||||
(decode-osc (tcp:read fd n)))))))
|
||||
|
||||
;; port -> string -> osc
|
||||
(define wait
|
||||
(lambda (fd s)
|
||||
(let ((p (recv fd)))
|
||||
(cond
|
||||
((not p) (error "wait" "timed out"))
|
||||
((not (string=? (first p) s)) (error "wait" "bad return packet" p s))
|
||||
(else p)))))
|
||||
|
||||
Loading…
Reference in a new issue