88 lines
3.8 KiB
Common Lisp
88 lines
3.8 KiB
Common Lisp
|
(cl:in-package #:osc)
|
||
|
|
|
||
|
|
(defun make-osc-client (&key (protocol :udp) debug-mode
|
||
|
|
(buffer-size *default-osc-buffer-size*)
|
||
|
|
address-tree cleanup-fun)
|
||
|
|
(ecase protocol
|
||
|
|
(:udp (make-instance 'osc-client-udp
|
||
|
|
:debug-mode debug-mode
|
||
|
|
:socket-buffer (make-socket-buffer
|
||
|
|
buffer-size)
|
||
|
|
:address-tree (if address-tree
|
||
|
|
address-tree
|
||
|
|
(make-osc-tree))
|
||
|
|
:cleanup-fun cleanup-fun))
|
||
|
|
(:tcp (make-instance 'osc-client-tcp
|
||
|
|
:debug-mode debug-mode
|
||
|
|
:socket-buffer (make-socket-buffer
|
||
|
|
buffer-size)
|
||
|
|
:address-tree (if address-tree
|
||
|
|
address-tree
|
||
|
|
(make-osc-tree))
|
||
|
|
:cleanup-fun cleanup-fun))))
|
||
|
|
|
||
|
|
(defmethod initialize-instance :after ((client osc-client-udp) &key)
|
||
|
|
(make-client-responders client))
|
||
|
|
|
||
|
|
(defgeneric make-client-responders (server))
|
||
|
|
|
||
|
|
(defmethod make-client-responders ((client osc-client-udp))
|
||
|
|
(add-osc-responder client "/cl-osc/server/registered"
|
||
|
|
(cmd args device address port timetag bundle)
|
||
|
|
(format t "Registered with server at ~A~%"
|
||
|
|
(make-addr+port-string address port)))
|
||
|
|
(add-osc-responder client "/cl-osc/server/quit"
|
||
|
|
(cmd args device address port timetag bundle)
|
||
|
|
(format t "Server ~A has quit~%"
|
||
|
|
(make-addr+port-string address port))))
|
||
|
|
|
||
|
|
(defgeneric register (client)
|
||
|
|
(:method ((client osc-client-udp))
|
||
|
|
(send-msg client "/cl-osc/register" (port client))))
|
||
|
|
|
||
|
|
(defmethod osc-device-cleanup ((device osc-client-udp))
|
||
|
|
(send-msg device "/cl-osc/quit")
|
||
|
|
(call-next-method))
|
||
|
|
|
||
|
|
(defun make-osc-client-endpoint-tcp (socket debug-mode buffer-size
|
||
|
|
address-tree clients &optional
|
||
|
|
cleanup-fun)
|
||
|
|
(socket-make-stream socket
|
||
|
|
:input nil :output t
|
||
|
|
:element-type '(unsigned-byte 8)
|
||
|
|
:buffering :full)
|
||
|
|
(let ((client (make-instance 'osc-client-endpoint-tcp
|
||
|
|
:debug-mode debug-mode
|
||
|
|
:address-tree address-tree
|
||
|
|
:socket-buffer (make-socket-buffer
|
||
|
|
buffer-size)
|
||
|
|
:clients clients
|
||
|
|
:cleanup-fun cleanup-fun)))
|
||
|
|
(set-socket socket client)
|
||
|
|
(set-listening-thread (make-listening-thread client) client)
|
||
|
|
client))
|
||
|
|
|
||
|
|
(defmethod make-listening-thread ((receiver osc-client-tcp))
|
||
|
|
"Creates a listening thread for tcp clients."
|
||
|
|
(sb-thread:make-thread
|
||
|
|
(lambda ()
|
||
|
|
(unwind-protect
|
||
|
|
(loop
|
||
|
|
do (multiple-value-bind (buffer length address port)
|
||
|
|
(socket-receive (socket receiver)
|
||
|
|
(socket-buffer receiver) nil)
|
||
|
|
(when (eq length 0) ; Closed by remote
|
||
|
|
(sb-thread:terminate-thread
|
||
|
|
sb-thread:*current-thread*))
|
||
|
|
(multiple-value-bind (data timetag)
|
||
|
|
(decode-bundle buffer :end length)
|
||
|
|
(when (debug-mode receiver)
|
||
|
|
(print-osc-debug-msg receiver data length
|
||
|
|
(peer-address receiver)
|
||
|
|
(peer-port receiver) timetag))
|
||
|
|
(dispatch (address-tree receiver) data receiver
|
||
|
|
address port))))
|
||
|
|
(osc-device-cleanup receiver)))
|
||
|
|
:name (format nil "osc-client-tcp-connection: ~A~%"
|
||
|
|
(name receiver))))
|