;;;
;;; spectral-canon.lisp
;;;
;;; Realization of the Spectral Canon by James Tenney using Clamps.
;;;
;;; **********************************************************************
;;; Copyright (c) 2025 Orm Finnendahl <orm.finnendahl@selma.hfmdk-frankfurt.de>
;;;
;;; Revision history: See git repository.
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the Gnu Public License, version 2 or
;;; later. See https://www.gnu.org/licenses/gpl-2.0.html for the text
;;; of this agreement.
;;;
;;; 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 General Public License for more details.
;;;
;;; **********************************************************************
(let* ((factor (/ 4 (- (log 9 2) (log 8 2)))) ; => 23.5398
(neg-offset-voice-one (* -1 factor (log 8 2))) ; => -70.6194
(section-length (* 24 8)) ; => 192
(section-duration (+ neg-offset-voice-one
(* factor (log (+ section-length 8) 2))))) ; => 109.315445
(defun get-time (idx voice)
"Return the absolute time of note at /idx/ in /voice/ with alternating
sections of accelerando and ritardando, taking the section
length, section duration, factor, section offset and start offset
into account."
(let ((section (floor idx section-length))
(start-offset (+ (* factor (log (* voice 8) 2)) neg-offset-voice-one)))
(if (evenp section)
(+ start-offset (* section section-duration)
(* factor (log (+ (mod idx section-length) 8) 2))
neg-offset-voice-one)
(+ start-offset (* (1+ section) section-duration)
(* -1 (+ (* factor (log (+ (- 192 (mod idx section-length)) 8) 2))
neg-offset-voice-one)))))))
(defun spectral-canon (&optional dur)
"Return a list of sfz Instances for the Spectral Canon by James Tenney."
(loop
for voice from 1 to 24
for keynum = (keynum (* voice (hertz 45)) :hertz)
append (loop
for idx from 0
for last = -4 then time
for time = (get-time idx voice)
for duration = (or dur (* 1.2 (- time last)))
while (<= time (get-time 384 1))
collect (new sfz
:time time
:keynum keynum
:duration duration
:preset :yamaha-grand-piano))))
(defun spectral-canon-barlow (&optional dur)
"Return a list of sfz Instances for the extended Spectral
Canon by James Tenney suggested by Clarence Barlow."
;;; tba
)