#!r6rs
(library (rsc3 osc encode)
(export cstring-length encode-osc encode-bundle-ntp osc->u8t)
(import (rnrs)
	(only (rnrs r5rs) modulo)
	(only (rsc3 collection list) make-list)
	(rsc3 ntp ntp)
	(rsc3 u8 u8t)
	(rsc3 u8 encode)
	(only (rsc3 osc verify) bundle? message?))

(define (padding-of n) (make-list n (encode-u8 0)))

;; OSC strings are C strings padded to a four byte boundary.

(define (cstring-length s)
  (+ 1 (string-length s)))

(define (encode-string s)
  (let ((n (modulo (cstring-length s) 4)))
    (list (encode-cstr s)
	  (if (= n 0)
	      (list)
	      (padding-of (- 4 n))))))

;; OSC byte strings are length prefixed?

(define (encode-bytes b)
  (let* ((n (bytevector-length b))
	 (n* (modulo n 4)))
    (list (encode-i32 n)
	  b
	  (if (= n* 0)
	      (list)
	      (padding-of (- 4 n*))))))

;; Allowable types are <integer>, <real>, <string>, or <u8l>.  Note
;; further that determining if a <real> should be written as a float
;; or a double is non-trivial and not undertaken here, all <real>s are
;; written as floats.

(define (exact-integer? n)
  (and (integer? n) (exact? n)))

(define (encode-value e)
  (cond ((exact-integer? e)   (encode-i32 e))
	((real? e)            (encode-f32 e))
	((string? e)          (encode-string e))
	((bytevector? e)      (encode-bytes e))
	(else                 (error 'encode-value "illegal value" e))))

;; Encode the type string for the Evaluates to the OSC <u8v>
;; indicating the types of the elements of the list `l'.

(define (encode-types l)
  (encode-string
   (list->string
    (cons #\,
	  (map (lambda (e)
		 (cond ((exact-integer? e) #\i)
		       ((real? e)          #\f)
		       ((string? e)        #\s)
		       ((bytevector? e)    #\b)
		       (else               (error 'encode-types "type?" e))))
	       l)))))

;; Encode OSC message.

(define (encode-message m)
  (list (encode-string (car m))
	(encode-types (cdr m))
	(map encode-value (cdr m))))

;; Encode OSC bundle. The first element is a <real> valued UTC
;; 'time-tag', each subsequent element must be an OSC 'message'.

(define (encode-bundle-ntp b)
  (list (encode-string "#bundle")
	(encode-u64 (ntpr->ntp (car b)))
	(map (lambda (e)
	       (if (message? e)
		   (encode-bytes (encode-osc e))
		   (error 'encode-bundle "illegal value" e)))
	     (cdr b))))

(define (encode-bundle b)
  (encode-bundle-ntp (cons (utc->ntpr (car b)) (cdr b))))

;; An OSC packet is either an OSC message or an OSC bundle.

(define (osc->u8t p)
  (if (bundle? p)
      (encode-bundle p)
      (encode-message p)))

(define (encode-osc p)
  (u8t->bytevector (osc->u8t p)))

)