Skip to content
This repository has been archived by the owner on Jun 22, 2019. It is now read-only.

Commit

Permalink
Sigh. Things work kinda I guess. Don't like how they do, but.. yeah. …
Browse files Browse the repository at this point in the history
…Maybe I'm just too stupid to figure this out proper.
  • Loading branch information
Shinmera committed Aug 25, 2016
1 parent 7dd8dc8 commit 4ac71ab
Show file tree
Hide file tree
Showing 3 changed files with 40 additions and 28 deletions.
4 changes: 3 additions & 1 deletion channel.lisp
Expand Up @@ -53,7 +53,9 @@

(defmethod initialize-instance :after ((channel c-array-channel) &key buffer buffer-size)
(unless buffer
(let ((buffer (cffi:foreign-alloc :unsigned-char :count buffer-size :initial-element 0)))
(let ((buffer (cffi:foreign-alloc (sample-type channel)
:count buffer-size
:initial-element (ctype-zero (sample-type channel)))))
(setf (slot-value channel 'buffer) buffer)
(tg:finalize channel (lambda () (cffi:foreign-free buffer))))))

Expand Down
28 changes: 16 additions & 12 deletions example.lisp
Expand Up @@ -10,8 +10,8 @@
(:use #:cl))
(in-package #:org.shirakumo.fraf.audio-blender.example)

(audio-blender::define-mixer test (out a b)
a)
(audio-blender::define-mixer test (a b) (vol)
(audio-blender::amp vol a))

(defclass mpg-channel (audio-blender::channel)
((file :accessor file))
Expand All @@ -26,13 +26,18 @@
(cl-mpg123:buffer (file channel)))

(defmethod audio-blender::buffer-size ((channel mpg-channel))
(cl-mpg123:buffer-size (file channel)))
(/ (cl-mpg123:buffer-size (file channel))
(cffi:foreign-type-size (audio-blender::sample-type channel))))

(defmethod audio-blender::refresh ((channel mpg-channel) max)
(handler-bind ((cl-mpg123:read-failed (lambda (err)
(when (eql (cl-mpg123:error-code err) :done)
(return-from audio-blender::refresh 0)))))
(cl-mpg123:read-directly (file channel) (audio-blender::buffer channel) max)))
(let ((size (cffi:foreign-type-size (audio-blender::sample-type channel))))
(declare (type fixnum size max))
(handler-bind ((cl-mpg123:read-failed (lambda (err)
(when (eql (cl-mpg123:error-code err) :done)
(return-from audio-blender::refresh 0)))))
(/ (cl-mpg123:read-directly (file channel) (audio-blender::buffer channel)
(* max size))
size))))

(defmethod audio-blender::sample ((channel mpg-channel) pos)
`(cffi:mem-aref ,(audio-blender::buffer channel) ,(audio-blender::sample-type channel) ,pos))
Expand All @@ -50,7 +55,8 @@
(cl-out123:make-output driver :rate 44100 :channels 2 :encoding (audio-blender::sample-type channel)))))

(defmethod audio-blender::refresh ((channel out-channel) max)
(cl-out123:play (output channel) (audio-blender::buffer channel) max))
(cl-out123:play (output channel) (audio-blender::buffer channel)
(* max (cffi:foreign-type-size (audio-blender::sample-type channel)))))

(defmethod (setf audio-blender::sample) (sample (channel out-channel) pos)
`(setf (cffi:mem-aref ,(audio-blender::buffer channel) ,(audio-blender::sample-type channel) ,pos)
Expand All @@ -68,15 +74,13 @@
(chn-o (make-instance 'out-channel :driver output-driver
:buffer-size (audio-blender::buffer-size chn-a)))
(mixer (audio-blender::make-mixer 'test chn-o chn-a chn-b)))
;(start chn-o)
(start chn-o)
(unwind-protect
(loop for a-size = (audio-blender::refresh chn-a (audio-blender::buffer-size chn-a))
for b-size = (audio-blender::refresh chn-b (audio-blender::buffer-size chn-a))
until (and (= 0 a-size) (= 0 b-size))
do (funcall mixer (max a-size b-size))
(break)
;(audio-blender::refresh chn-o (max a-size b-size))
(format T "~&Read ~a ~a" a-size b-size))
(audio-blender::refresh chn-o (max a-size b-size)))
(disconnect chn-o)
(disconnect chn-a)
(disconnect chn-b))))
36 changes: 21 additions & 15 deletions mixer.lisp
Expand Up @@ -11,6 +11,9 @@
(defun enlist (a &rest vals)
(if (listp a) a (list* a vals)))

(defun delist (a &optional (key #'first))
(if (listp a) (funcall key a) a))

(defun mixer (name &optional (error T))
(or (gethash name *mixers*)
(when error (error "No such mixer ~s." name))))
Expand All @@ -22,28 +25,31 @@
(remhash name *mixers*))

(defun make-mixer (name out &rest channels)
(apply (mixer name) (enlist out) (mapcar #'enlist channels)))
(apply (mixer name) out channels))

(defmacro with-mixer ((name out &rest channels) &body body)
`(let ((,name (make-mixer ',name ,out ,@channels)))
,@body))

(defmacro define-mixer (name (out &rest channels) &body body)
(defun make-mixer-lambda (out channels extra-vars body)
(let ((size (gensym "SIZE"))
(i (gensym "I")))
`(lambda (,size ,@extra-vars)
(declare (type fixnum ,size))
(dotimes (,i ,size ,out)
(let ,(loop for (var chan) in channels
collect `(,var ,(sample chan i)))
,(setf (sample out i)
`(progn ,@body)))))))

(defmacro define-mixer (name channels extra-vars &body body)
(let ((out (gensym "OUT")))
`(progn (setf (mixer ',name)
(lambda (,out ,@channels)
(let ,(loop for chan in (cons out channels)
;; For now we discard the extra information.
collect `(,chan (first ,chan)))
(compile NIL
(print
`(lambda (,',size)
(declare (type fixnum ,',size))
(dotimes (,',i ,',size ,,out)
(let ,(list
,@(loop for chan in channels
collect `(list ',chan (sample ,chan ',i))))
,(setf (sample ,out ',i)
`(progn ,@',body))))))))))
(compile NIL (make-mixer-lambda
,out
(list ,@(loop for chan in channels
collect `(list ',chan ,chan)))
',extra-vars
',body))))
',name)))

0 comments on commit 4ac71ab

Please sign in to comment.