;;;; CL-MeltySynth
;;;; Copyright (C) 2022 Remilia Scarlet <remilia@posteo.jp>
;;;; Based on MeltySynth, Copyright (C) 2021 Nobuaki Tanaka (MIT License)
;;;;
;;;; This program is free software: you can redistribute it and/or modify it
;;;; under the terms of the GNU Affero General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or (at your
;;;; option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful, but WITHOUT
;;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public
;;;; License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(in-package :cl-meltysynth-reverbs)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Comb Filter
;;;;
;;;; This reverb implementation is based on Freeverb, a public domain reverb
;;;; implementation by Jezar at Dreampoint.
;;;;
(defstruct (comb-filter (:constructor %make-comb-filter)
(:conc-name comb-))
(buffer (new-array 0 'double-float 0.0d0) :type t/dfloat-array)
(buffer-index 0 :type fixnum)
(filter-store 0.0d0 :type double-float)
(feedback 0.0d0 :type double-float)
(damp-1 0.0d0 :type double-float)
(damp-2 0.0d0 :type double-float))
(define-typed-fn comb-set-damp ((comb-filter filter) (double-float value))
(null t)
(setf (comb-damp-1 filter) value)
(setf (comb-damp-2 filter) (- 1.0d0 value))
nil)
(define-typed-fn comb-damp ((comb-filter filter))
(double-float :always)
(muffling
(comb-damp-1 filter)))
(define-typed-fn make-comb-filter ((fixnum buffer-size))
(comb-filter :always)
(muffling
(%make-comb-filter :buffer (new-array buffer-size 'double-float 0.0d0))))
(define-typed-fn comb-mute ((comb-filter filter))
(null t)
(fill (comb-buffer filter) 0.0d0)
(setf (comb-filter-store filter) 0.0d0)
nil)
(define-typed-fn comb-process ((comb-filter filter) (double-float input-gain)
(t/dfloat-array input-left input-right output-block))
(null)
(loop with len fixnum = (length output-block)
with buff-len fixnum = (length (comb-buffer filter))
with output-len fixnum = (length output-block)
with block-index fixnum = 0
while (< block-index len)
do (when (= (comb-buffer-index filter) buff-len)
(setf (comb-buffer-index filter) 0))
(let* ((src-rem (- buff-len (comb-buffer-index filter)))
(dest-rem (- output-len block-index))
(rem (min src-rem dest-rem)))
(loop for i fixnum from 0 below rem do
(let* ((block-pos (+ block-index i))
(buffer-pos (+ (comb-buffer-index filter) i))
(input (* (+ (aref input-left block-pos)
(aref input-right block-pos))
input-gain))
(output (aref (comb-buffer filter) buffer-pos)))
;; The following ifs are to avoid performance problem due to
;; denormalized number.
(when (< (abs output) least-positive-normalized-double-float)
(setf output 0.0d0))
(setf (comb-filter-store filter)
(+ (* output (comb-damp-2 filter))
(* (comb-filter-store filter) (comb-damp-1 filter))))
(when (< (abs (comb-filter-store filter)) least-positive-normalized-double-float)
(setf (comb-filter-store filter) 0.0d0))
(setf (aref (comb-buffer filter) buffer-pos)
(+ input (* (comb-filter-store filter) (comb-feedback filter))))
(incf (aref output-block block-pos) output)))
(incf (comb-buffer-index filter) rem)
(incf block-index rem)))
nil)