Algorithmische Komposition mit Common Lisp

;;; 
;;; 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 version of the
Spectral Canon by James Tenney suggested by Clarence Barlow."
  (let ((original (spectral-canon))
        (total-duration (get-time 384 1)))
    (append
     original
     (loop
       for evt in original
       if (< (sv evt :time) (get-time 384 1))
         collect (let ((new (copy-object evt)))
                   (setf (sv new :time)
                         (- (* 2 total-duration) (sv evt :time)))
                   new)))))