code.delx.au - gnu-emacs-elpa/blob - packages/osc/osc.el

   1 ;;; osc.el --- Open Sound Control protocol library
   2
   3 ;; Copyright (C) 2014  Free Software Foundation, Inc.
   4
   5 ;; Author: Mario Lang <mlang@delysid.org>
   6 ;; Version: 0.1
   7 ;; Keywords: comm, processes, multimedia
   8
   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.
  13
  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.
  18
  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/>.
  21
  22 ;;; Commentary:
  23
  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
  27 ;; application areas.
  28
  29 ;; This package implements low-level functionality for OSC clients and servers.
  30 ;; In particular:
  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.
  35
  36 ;; BUGS/TODO:
  37 ;;
  38 ;; * Timetags and binary blobs are not supported yet.
  39
  40 ;; Usage:
  41 ;;
  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)
  45 ;;
  46 ;; Server: (setq my-server (osc-make-server "localhost" 7770
  47 ;;          (lambda (path &rest args)
  48 ;;            (message "OSC %s: %S" path args))))
  49
  50 ;;; Code:
  51
  52 (require 'cl-lib)
  53
  54 (defun osc-insert-string (string)
  55   (insert string 0 (make-string (- 3 (% (length string) 4)) 0)))
  56
  57 (defun osc-insert-float32 (value)
  58   (let (s (e 0) f)
  59     (cond
  60      ((string= (format "%f" value) (format "%f" -0.0))
  61       (setq s 1 f 0))
  62      ((string= (format "%f" value) (format "%f" 0.0))
  63       (setq s 0 f 0))
  64      ((= value 1.0e+INF)
  65       (setq s 0 e 255 f (1- (expt 2 23))))
  66      ((= value -1.0e+INF)
  67       (setq s 1 e 255 f (1- (expt 2 23))))
  68      ((string= (format "%f" value) (format "%f" 0.0e+NaN))
  69       (setq s 0 e 255 f 1))
  70      (t
  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)))
  77             e (+ (* -1 e) 127))))
  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)
  81             (logand f #XFF))))
  82
  83 (defun osc-insert-int32 (value)
  84   (let (bytes)
  85     (dotimes (i 4)
  86       (push (% value 256) bytes)
  87       (setq value (/ value 256)))
  88     (dolist (byte bytes)
  89       (insert byte))))
  90
  91 ;;;###autoload
  92 (defun osc-make-client (host port)
  93   "Create an OSC client process which talks to HOST and PORT."
  94   (make-network-process
  95    :name "OSCclient"
  96    :coding 'binary
  97    :host host
  98    :service port
  99    :type 'datagram))
 100
 101 ;;;###autoload
 102 (defun osc-send-message (client path &rest args)
 103   "Send an OSC message from CLIENT to the specified PATH with ARGS."
 104   (with-temp-buffer
 105     (set-buffer-multibyte nil)
 106     (osc-insert-string path)
 107     (osc-insert-string
 108      (apply 'concat "," (mapcar (lambda (arg)
 109                                   (cond
 110                                    ((floatp arg) "f")
 111                                    ((integerp arg) "i")
 112                                    ((stringp arg) "s")
 113                                    (t (error "Invalid argument: %S" arg))))
 114                                 args)))
 115     (dolist (arg args)
 116       (cond
 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))))
 121
 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)))
 127     string))
 128
 129 (defun osc-read-int32 ()
 130   (let ((value 0))
 131     (dotimes (i 4)
 132       (setq value (logior (* value 256) (following-char)))
 133       (forward-char 1))
 134     value))
 135
 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)))))
 143     (cond
 144      ((and (= e 0) (= f 0))
 145       (* 0.0 (expt -1 s)))
 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))))))
 149       0.0e+NaN)
 150      (t
 151       (* (expt -1 s)
 152          (expt 2.0 (- e 127))
 153          (1+ (/ f (expt 2.0 23))))))))
 154
 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)))
 161     (if slot
 162         (setcdr slot handler)
 163       (plist-put
 164        (process-plist server)
 165        :handlers (nconc (list (cons path handler)) handlers)))))
 166
 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)))
 170
 171 (defun osc-filter (proc string)
 172   (when (= (% (length string) 4) 0)
 173     (with-temp-buffer
 174       (set-buffer-multibyte nil)
 175       (insert string)
 176       (goto-char (point-min))
 177       (let ((path (osc-read-string)))
 178         (if (not (string= path "#bundle"))
 179             (when (looking-at ",")
 180               (save-excursion
 181                 (apply (osc-server-get-handler proc path)
 182                        path
 183                        (mapcar
 184                         (lambda (type)
 185                           (cl-case type
 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
 191           (while (not (eobp))
 192             (let ((size (osc-read-int32)))
 193               (osc-filter proc
 194                           (buffer-substring
 195                            (point) (progn (forward-char size) (point)))))))))))
 196
 197 ;;;###autoload
 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
 205    :name "OSCserver"
 206    :filter #'osc-filter
 207    :host host
 208    :service port
 209    :server t
 210    :type 'datagram
 211    :plist (list :generic default-handler)))
 212
 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=)))
 219          (osc-test-done nil)
 220          (osc-test-ok nil)
 221          (server (osc-make-server
 222                   "localhost" t
 223                   (lambda (_path v)
 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)
 234     osc-test-ok))
 235
 236 (provide 'osc)
 237 ;;; osc.el ends here