1 ;;; osc.el --- Open Sound Control protocol library
3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
5 ;; Author: Mario Lang <mlang@delysid.org>
7 ;; Keywords: comm, processes, multimedia
9 ;; This program is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
24 ;; OpenSound Control ("OSC") is a protocol for communication among
25 ;; computers, sound synthesizers, and other multimedia devices that is
26 ;; optimized for modern networking technology and has been used in many
29 ;; This package implements low-level functionality for OSC clients and servers.
31 ;; * `osc-make-client' and `osc-make-server' can be used to create process objects.
32 ;; * `osc-send-message' encodes and sends OSC messages from a client process.
33 ;; * `osc-server-set-handler' can be used to change handlers for particular
34 ;; OSC paths on a server process object on the fly.
38 ;; * Timetags and binary blobs are not supported yet.
42 ;; Client: (setq my-client (osc-make-client "localhost" 7770))
43 ;; (osc-send-message my-client "/osc/path" 1.5 1.0 5 "done")
44 ;; (delete-process my-client)
46 ;; Server: (setq my-server (osc-make-server "localhost" 7770
47 ;; (lambda (path &rest args)
48 ;; (message "OSC %s: %S" path args))))
54 (defun osc-insert-string (string)
55 (insert string 0 (make-string (- 3 (% (length string) 4)) 0)))
57 (defun osc-insert-float32 (value)
60 ((string= (format "%f" value) (format "%f" -0.0))
62 ((string= (format "%f" value) (format "%f" 0.0))
65 (setq s 0 e 255 f (1- (expt 2 23))))
67 (setq s 1 e 255 f (1- (expt 2 23))))
68 ((string= (format "%f" value) (format "%f" 0.0e+NaN))
71 (setq s (if (>= value 0.0)
72 (progn (setq f value) 0)
73 (setq f (* -1 value)) 1))
74 (while (>= (* f (expt 2.0 e)) 2.0) (setq e (1- e)))
75 (if (= e 0) (while (< (* f (expt 2.0 e)) 1.0) (setq e (1+ e))))
76 (setq f (round (* (1- (* f (expt 2.0 e))) (expt 2 23)))
78 (insert (+ (lsh s 7) (lsh (logand e #XFE) -1))
79 (+ (lsh (logand e #X01) 7) (lsh (logand f #X7F0000) -16))
80 (lsh (logand f #XFF00) -8)
83 (defun osc-insert-int32 (value)
86 (push (% value 256) bytes)
87 (setq value (/ value 256)))
92 (defun osc-make-client (host port)
93 "Create an OSC client process which talks to HOST and PORT."
102 (defun osc-send-message (client path &rest args)
103 "Send an OSC message from CLIENT to the specified PATH with ARGS."
105 (set-buffer-multibyte nil)
106 (osc-insert-string path)
108 (apply 'concat "," (mapcar (lambda (arg)
113 (t (error "Invalid argument: %S" arg))))
117 ((floatp arg) (osc-insert-float32 arg))
118 ((integerp arg) (osc-insert-int32 arg))
119 ((stringp arg) (osc-insert-string arg))))
120 (process-send-string client (buffer-string))))
122 (defun osc-read-string ()
123 (let ((pos (point)) string)
124 (while (not (= (following-char) 0)) (forward-char 1))
125 (setq string (buffer-substring-no-properties pos (point)))
126 (forward-char (- 4 (% (length string) 4)))
129 (defun osc-read-int32 ()
132 (setq value (logior (* value 256) (following-char)))
136 (defun osc-read-float32 ()
137 (let ((s (lsh (logand (following-char) #X80) -7))
138 (e (+ (lsh (logand (following-char) #X7F) 1)
139 (lsh (logand (progn (forward-char) (following-char)) #X80) -7)))
140 (f (+ (lsh (logand (following-char) #X7F) 16)
141 (lsh (progn (forward-char) (following-char)) 8)
142 (prog1 (progn (forward-char) (following-char)) (forward-char)))))
144 ((and (= e 0) (= f 0))
146 ((and (= e 255) (or (= f (1- (expt 2 23))) (= f 0)))
147 (* 1.0e+INF (expt -1 s)))
148 ((and (= e 255) (not (or (= f 0) (= f (1- (expt 2 23))))))
153 (1+ (/ f (expt 2.0 23))))))))
155 (defun osc-server-set-handler (server path handler)
156 "Set HANDLER for PATH on SERVER.
157 IF HANDLER is nil, remove previously defined handler and fallback to
158 the generic handler for SERVER."
159 (let* ((handlers (plist-get (process-plist server) :handlers))
160 (slot (assoc-string path handlers)))
162 (setcdr slot handler)
164 (process-plist server)
165 :handlers (nconc (list (cons path handler)) handlers)))))
167 (defun osc-server-get-handler (server path)
168 (or (cdr (assoc path (plist-get (process-plist server) :handlers)))
169 (plist-get (process-plist server) :generic)))
171 (defun osc-filter (proc string)
172 (when (= (% (length string) 4) 0)
174 (set-buffer-multibyte nil)
176 (goto-char (point-min))
177 (let ((path (osc-read-string)))
178 (if (not (string= path "#bundle"))
179 (when (looking-at ",")
181 (apply (osc-server-get-handler proc path)
186 (?f (osc-read-float32))
187 (?i (osc-read-int32))
188 (?s (osc-read-string))))
189 (string-to-list (substring (osc-read-string) 1))))))
190 (forward-char 8) ;skip 64-bit timetag
192 (let ((size (osc-read-int32)))
195 (point) (progn (forward-char size) (point)))))))))))
198 (defun osc-make-server (host port default-handler)
199 "Create an OSC server which listens on HOST and PORT.
200 DEFAULT-HANDLER is a function with arguments (path &rest args) which is called
201 when a new OSC message arrives. See `osc-server-set-handler' for more
202 fine grained control.
203 A process object is returned which can be dicarded with `delete-process'."
204 (make-network-process
211 :plist (list :generic default-handler)))
213 (defun osc--test-transport-equality (value)
214 "Test if transporting a certain VALUE via OSC results in equality.
215 This is mostly for testing the implementation robustness."
216 (let* ((osc-test-value value)
217 (osc-test-func (cond ((or (floatp value) (integerp value)) '=)
218 ((stringp value) 'string=)))
221 (server (osc-make-server
224 (setq osc-test-done t
225 osc-test-ok (list v (funcall osc-test-func
226 osc-test-value v))))))
227 (client (osc-make-client
228 (nth 0 (process-contact server)) (nth 1 (process-contact server)))))
229 (osc-send-message client
230 "/test" osc-test-value)
231 (while (not osc-test-done)
232 (accept-process-output server 0 500))
233 (delete-process server) (delete-process client)