129 lines
3.8 KiB
Common Lisp
129 lines
3.8 KiB
Common Lisp
(cl:in-package #:osc)
|
|
|
|
;;;=====================================================================
|
|
;;; OSC device base class
|
|
;;;=====================================================================
|
|
|
|
(defclass osc-device ()
|
|
((socket
|
|
:reader socket
|
|
:writer set-socket
|
|
:initform nil)
|
|
(debug-mode
|
|
:reader debug-mode
|
|
:writer set-debug-mode
|
|
:initarg :debug-mode)
|
|
(cleanup-fun
|
|
:reader cleanup-fun
|
|
:initarg :cleanup-fun
|
|
:initform nil)))
|
|
|
|
;;;=====================================================================
|
|
;;; OSC device mixin classes
|
|
;;;=====================================================================
|
|
|
|
(defclass udp-device (osc-device) ())
|
|
|
|
(defclass tcp-device (osc-device) ())
|
|
|
|
(defclass listening-device (osc-device)
|
|
((listening-thread
|
|
:reader listening-thread
|
|
:writer set-listening-thread
|
|
:initform nil)))
|
|
|
|
(defclass receiving-device (listening-device)
|
|
((socket-buffer
|
|
:reader socket-buffer
|
|
:initarg :socket-buffer)))
|
|
|
|
(defclass dispatching-device (listening-device)
|
|
((address-tree
|
|
:reader address-tree
|
|
:initarg :address-tree
|
|
:initform (make-osc-tree))))
|
|
|
|
(defclass dispatching-device-udp (dispatching-device receiving-device
|
|
udp-device) ())
|
|
|
|
|
|
;;;=====================================================================
|
|
;;; OSC device abstract classes
|
|
;;;=====================================================================
|
|
|
|
(defclass osc-transmitter (osc-device) ())
|
|
|
|
(defclass osc-client (dispatching-device receiving-device
|
|
osc-transmitter) ())
|
|
|
|
(defclass osc-server (dispatching-device osc-transmitter)
|
|
((buffer-size
|
|
:reader buffer-size
|
|
:initarg :buffer-size)
|
|
(clients
|
|
:reader clients
|
|
:initarg :clients
|
|
:initform (make-clients-hash))))
|
|
|
|
(defclass osc-client-endpoint (osc-client)
|
|
((clients
|
|
:reader clients
|
|
:initarg :clients)))
|
|
|
|
|
|
;;;=====================================================================
|
|
;;; OSC device concrete classes
|
|
;;;=====================================================================
|
|
|
|
(defclass osc-transmitter-udp (osc-transmitter udp-device) ())
|
|
|
|
(defclass osc-client-udp (osc-client dispatching-device-udp) ())
|
|
|
|
(defclass osc-client-tcp (osc-client tcp-device) ())
|
|
|
|
(defclass osc-server-udp (osc-server dispatching-device-udp
|
|
osc-transmitter-udp) ())
|
|
|
|
(defclass osc-server-tcp (osc-server osc-transmitter tcp-device) ())
|
|
|
|
(defclass osc-client-endpoint-tcp (osc-client-endpoint
|
|
osc-client-tcp) ())
|
|
|
|
|
|
;;;=====================================================================
|
|
;;; Device generic functions
|
|
;;;=====================================================================
|
|
|
|
(defgeneric protocol (osc-device)
|
|
(:method ((osc-device udp-device))
|
|
:udp)
|
|
(:method ((osc-device tcp-device))
|
|
:tcp))
|
|
|
|
(defgeneric name (osc-device)
|
|
(:method ((osc-device osc-device))
|
|
(concatenate 'string
|
|
(symbol-name (class-name (class-of osc-device)))
|
|
"-"
|
|
(make-name-string osc-device))))
|
|
|
|
(defmethod buffer-size ((osc-device dispatching-device))
|
|
(length (socket-buffer osc-device)))
|
|
|
|
(defgeneric quit (osc-device))
|
|
|
|
(defgeneric osc-device-cleanup (device)
|
|
(:method :before ((osc-device osc-device))
|
|
(when (cleanup-fun osc-device)
|
|
(funcall (cleanup-fun osc-device) osc-device)))
|
|
(:method ((osc-device osc-device))
|
|
(when (debug-mode osc-device)
|
|
(format t "~%OSC device stopped: ~A~%"
|
|
(name osc-device)))
|
|
(when (socket osc-device)
|
|
(handler-case
|
|
(socket-close (socket osc-device) :abort t)
|
|
(sb-int:simple-stream-error ()
|
|
(when (debug-mode osc-device)
|
|
(warn "Device ~A gone away." (name osc-device)))))
|
|
(set-socket nil osc-device))))
|