;;********************************************

;;********************************************

;;////////////////////////////////////////////

;;Lisp Additive Synthesis Tool - LAST

;;////////////////////////////////////////////

;;Mauricio Rodriguez - 2011

;;////////////////////////////////////////////

;;marod@ccrma.stanford.edu

;;////////////////////////////////////////////

;;********************************************

;;********************************************

 

#|

******************************

******************************

Use and copying of this software and preparation of derivative works

based upon this software are prohibited unless permission of the author.

Suggestions, comments and bug reports are welcome. Please address email to:

marod@ccrma.stanford.edu

******************************

******************************

|#

 

(make-package :last)

 

(in-package :last)

 

;;Main:

 

;;spear-formatting [note-sequence(s)] / Note-event=[onset pitch duration channel velocity]

;;(spear-formatting (create-sequence '((0 58.5 20000 7 32) (0 60.5 10000 7 32))))

 

;;Code:

 

(defun harmonic-series (partials fundamental)

  (do ((counter 0 (incf counter))

       (output nil (cons (* counter fundamental) output)))

      ((= counter partials) (reverse output))))

 

(defun invert-harmonic-ratio (n)

  (let* ((series (loop for x from 1 to n

                       collect x))

         (grouping (reverse (make-pairs series))))

    (cons 1.0 (loop for y in grouping

                    collect (/ (float (second y)) (float (first y)))))))

 

(defun invert-harmonic-series* (fundamental input)

  (if (endp input)

    'nil

    (cons (* fundamental (first input))

          (invert-harmonic-series* (* fundamental (first input)) (rest input)))))

 

(defun invert-harmonic-series (partials fundamental)

  (invert-harmonic-series* fundamental (invert-harmonic-ratio partials)))

 

(defun distorted-harmonic-series (fundamental n percentage)

  (let ((power (if (< percentage 0)

                 (+ 1 (/ percentage 100.0))

                 (+ 1 (abs (/ percentage 100.0))))))

    (loop for x from 1 to n

          collect (* fundamental (expt x power)))))

 

(defun distort-harmonic-series (fundamental percentage ratio-list)

  (let ((power (if (< percentage 0)

                   (+ 1 (/ percentage 100.0))

                 (+ 1 (abs (/ percentage 100.0))))))

    (loop for x in ratio-list

          collect (* fundamental (expt x power)))))

 

(defun convert-midi-to-frequency (midi-value)

  (* 440 (expt 2 (/ (- midi-value 69) 12.0))))

 

(defun convert-frequency-to-midi (frequency)

  (+ 69 (* 12 (/ (log (/ frequency 440.0) 10) (log 2 10)))))

 

(defun midi-to-frequency (input-list)

  (mapcar #'convert-midi-to-frequency input-list))

 

(defun frequency-to-midi (input-list)

  (mapcar #'convert-frequency-to-midi input-list))

 

(defun partial-index (list index-list)

  (cond ((eql index-list :all-partials) list)

        ((endp index-list) nil)

        ((endp list) nil)

        ((> (first index-list) (length list)) nil)

        (t (cons (elt list (- (first index-list) 1))

                 (partial-index list (rest index-list))))))

 

(defun potentiation-list (n value)

  (do* ((counter n (- counter 1))

        (exponent -1 (+ exponent 1))

        (output nil (cons (expt value exponent) output)))

       ((zerop counter) (reverse output))))

 

(defun amplitude-squared-inverse* (n)

  (let ((squared-inverse (potentiation-list n 2)))

    (loop for x in squared-inverse

          collect (/ 1 x))))

 

(defun amplitude-inverse* (n)

  (loop for x from 1 to n

        collect (/ 1 x)))

 

(defun amplitude-squared-inverse (n)

  (let ((squared-inverse (potentiation-list n 2)))

    (loop for x in squared-inverse

          collect (/ 1.0 x))))

 

(defun amplitude-inverse (n)

  (loop for x from 1 to n

        collect (/ 1.0 x)))

 

#|

 

(defun sieve-duration (duration resolution)

  (let ((output (loop for x from 0.0 to (* duration 1000) by 50

                      collect x)))

    (loop for y in output

          collect (/ y (* resolution 10000.0)))))

 

|#

 

(defun sieve-duration (duration resolution)

  (let ((output (loop for x from 0.0 to (* duration 1000) by (* resolution 1000.0)

                      collect x)))

    (loop for y in output

          collect (/ y 1000.0))))

 

(defun scale-milisec-duration (value)

  (/ 1000.0 value))

 

(defun shift-duration (duration-list offset)

  (mapcar #'(lambda (x) (+ offset x)) duration-list))

 

(defun move-onset* (offset input)

  (let* ((offsetting (/ offset 1000.0))

         (new-first (mapcar #'(lambda (x) (+ offsetting x)) (first input))))

    (cons new-first (rest input))))

 

(defun move-onset (offset list)

  (mapcar #'(lambda (x) (move-onset* offset x)) list))

 

(defun alea (low high)

  (+ (min low high)

     (if (= high low)

       0

       (random (+ (abs (- high low ))

                          (if (or (floatp low) (floatp high))

                            0

                            1))))))

 

(defun deviate (threshold percentage)

  (let ((amount (* threshold percentage .01)))

    (+ threshold (alea (- amount) amount))))

 

(defun deviate-percentage (threshold percentage)

  (if (= threshold 0)

    threshold

    (let ((value (+ threshold (* threshold percentage .01))))

      (if (> value 127)

        127

        value))))

 

(defun permute-list (list)

  (let* ((current-list list)

        (current-value (unless (endp current-list) (elt current-list (random (length current-list))))))

  (if (endp current-list) nil

      (cons current-value (permute-list (delete current-value current-list :count 1))))))

 

(defun normalize-duration (duration)

  (read-from-string (format nil "~,1f" duration)))

 

(defun scale-envelope (duration input)

  (let* ((target-duration (normalize-duration duration))

         (maximum (first (first (last input))))

         (x-values (mapcar #'(lambda (alpha) (normalize alpha 0.0 maximum 0.0 target-duration))

                           (loop for x in input

                                 collect (first x))))

         (y-values (loop for y in input

                        collect (second y))))

    (mapcar #'list x-values y-values)))

 

(defun normalize-scaling (input)

  (if (null input)

    'nil

    (cons (list (read-from-string (format nil "~,1f" (first (first input))))

                (second (first input)))

          (normalize-scaling (rest input)))))

 

(defun add-ratio (n ratio)

  (do ((current-n (decf n) (decf current-n))

       (times-value 1 (incf times-value))

       (added-ratio ratio (* ratio times-value))

       (output (list ratio) (cons added-ratio output)))

      ((= current-n 0) (rest (reverse output)))))

 

(defun partition-list (n segment-value)

  (add-ratio n (/ (float segment-value) n)))

 

(defun segment-interpolation* (segment-1 segment-2 subdivisions)

  (let ((segment-difference (abs (- segment-1 segment-2)))

        (offset-value (min segment-1 segment-2)))

    (mapcar #'(lambda (x) (+ x offset-value))

            (partition-list subdivisions segment-difference))))

 

(defun segment-interpolation (segment-1 segment-2 subdivisions)

  (let ((interpolation-list (segment-interpolation* segment-1 segment-2 subdivisions)))

    (if (or (equal segment-1 segment-2) (< segment-1 segment-2))

      interpolation-list

      (reverse interpolation-list))))

 

(defun x-increment (start end)

  (append (loop for x from start to end by 0.05

                collect x)

          (list end)))

 

#|

 

(defun x-increment (start end resolution)

  (append (loop for x from start to end by resolution

                collect x)

          (list end)))

 

|#

 

(defun inter-break-points (a b)

  (if (<= (- (- (first b) (first a)) 0.05) 0.00000001)

    (list a b)

    (let* ((n (round (/ (- (first b) (first a)) 0.05)))

           (interpolation-list (append (list (second a)) (segment-interpolation (second a) (second b) n) (list (second b))))

           (x-list (x-increment (first a) (first b))))

      (mapcar #'list x-list interpolation-list))))

 

#|

 

(defun inter-break-points (a b resolution)

  (let* ((n (/ (- (first b) (first a)) resolution))

         (interpolation-list (append (list (second a)) (segment-interpolation (second a) (second b) n) (list (second b))))

         (x-list (x-increment (first a) (first b) resolution)))

    (mapcar #'list x-list interpolation-list)))

 

|#

 

(defun make-pairs* (list)

  (if (endp list)

    nil

    (cons (list (first list) (second list))

          (make-pairs* (rest list)))))

 

(defun make-pairs (list)

  (let ((current-list (make-pairs* list)))

    (loop for x in current-list

          when (not (equal (second x) nil))

          collect x)))

 

(defun sort-index (list)

  (sort (loop for x in list

              collect (first x)) #'<))

 

(defun order-index* (index-list list)

  (do ((current-index

        index-list

        (rest current-index))

       (current-list

        list

        (remove

         (find-if #'(lambda (x) (= (first current-index) (first x)))

                  current-list)

         current-list :test #'equal))

       (output

        nil

        (cons

         (find-if #'(lambda (x) (= (first current-index) (first x)))

                  current-list)

         output)))

      ((endp current-index) (reverse output))))

 

(defun order-index (index-list)

  (let ((sorting (sort-index index-list)))

    (order-index* sorting index-list)))

 

(defun expand-envelope-coordinates (break-points)

  (order-index (remove-duplicates

                       (loop for x in (make-pairs break-points)

                             append (inter-break-points (first x) (second x))) :test #'equal)))

 

#|

 

(defun expand-envelope-coordinates (break-points resolution)

  (order-index (remove-duplicates

                       (loop for x in (make-pairs break-points)

                             append (inter-break-points (first x) (second x) resolution)) :test #'equal)))

 

|#

 

(defun envelope-values (break-points)

  (let ((envelope (expand-envelope-coordinates break-points)))

    (loop for x in envelope

          collect (second x))))

 

#|

 

(defun envelope-values (break-points resolution)

  (let ((envelope (expand-envelope-coordinates break-points resolution)))

    (loop for x in envelope

          collect (second x))))

 

|#

 

(defun normalize (x a b c d)

  (+ c (* (- x a) (/ (float (- d c)) (- b a)))))

 

(defun map-freq (x a b c d)

  (let ((value (+ c (* (- x a) (/ (float (- d c)) (- b a))))))

    (format t "~&~10,6f" value)))

 

(defun map-amp (x)

  (* x (/ 0.100000 1.0)))

 

(defun fibo-process (list)

  (do ((sum (first list) (+ sum (first local-list)))

       (local-list (rest list) (rest local-list))

       (output-list nil (cons sum output-list)))

      ((not local-list) (reverse (cons (+ (first (last list)) (first output-list)) output-list)))))

 

(defun index-check (index input)

  (if (>= (- index 1) (length input))

    (reverse input)

    input))

 

(defun index-check-p (index input)

  (if (>= (- index 1) (length input))

    't

    'nil))

 

(defun gather-from-index (indexing-list input)

  (if (null indexing-list)

    'nil

    (cons (nth (- (first indexing-list) 1) input)

          (gather-from-index (rest indexing-list) input))))

 

(defun all-numbers (n)

  (loop for x from 1 to n

        collect x))

 

(defun delete-from-index (index list)

  (gather-from-index (remove index (all-numbers (length list))) list))

 

(defun reverse-rotate (list)

  (append (rest (reverse list)) (list (first (reverse list)))))

 

(defun collect-n (n input)

  (do ((counter 0 (+ counter 1))

       (current-input input (if (= (length current-input) 1)

                              input

                              (rest current-input)))

       (output nil (cons (first current-input)

                         output)))

      ((= counter n) (reverse output))))

 

(defun additive-process (n input)

  (let* ((additive-list* (loop for alpha in

                               (reverse (loop for x on (reverse input)

                                              collect (reverse x)))

                               append alpha))

         (additive-list** (append additive-list* (reverse additive-list*)))

         (additive-list (collect-n (- n 1) additive-list**)))

    (append additive-list (last input))))

 

(defun get-onset (input)

  (first input))

 

(defun get-pitch (input)

  (second input))

 

(defun get-duration (input)

  (third input))

 

(defun get-channel (input)

  (fourth input))

 

(defun get-velocity (input)

  (fifth input))

 

(defun map-onset (input)

  (mapcar #'(lambda (x) (get-onset x)) input))

 

(defun map-pitch (input)

  (mapcar #'(lambda (x) (get-pitch x)) input))

 

(defun map-duration (input)

  (mapcar #'(lambda (x) (get-duration x)) input))

 

(defun map-channel (input)

  (mapcar #'(lambda (x) (get-channel x)) input))

 

(defun map-velocity (input)

  (mapcar #'(lambda (x) (get-velocity x)) input))

 

(defun note-event** (onset pitch duration channel velocity)

  (list onset pitch duration channel velocity))

 

(defun note-event-sequence** (onset-list pitch-list duration-list channel-list velocity-list)

  (if (or (null onset-list) (null pitch-list) (null duration-list) (null channel-list) (null velocity-list))

    'nil

    (cons (note-event** (first onset-list)

                        (first pitch-list)

                        (first duration-list)

                        (first channel-list)

                        (first velocity-list))

          (note-event-sequence** (rest onset-list)

                                 (rest pitch-list)

                                 (rest duration-list)

                                 (rest channel-list)

                                 (rest velocity-list)))))

 

;;(note-event-sequence** '(0 1000) '(60 64) '(1000 1000) '(1 1) '(64 127))

;;(note-event-sequence** '(0 1000) '(60 64) '(2000 1000) '(1 1) '(32 32))

 

(defun map-value (x a b c d)

  (round (+ c (* (- x a) (/ (- d c) (- b a))))))

 

(defun map-value-list (list a b c d)

  (if (null list)

    'nil

    (cons (map-value (first list) a b c d)

          (map-value-list (rest list) a b c d))))

 

(defun delta-increment* (list &optional (current-value 0))

  (if (null list)

    'nil

    (cons (+ (first list) current-value)

          (delta-increment* (rest list) (setq current-value (+ current-value (first list)))))))

 

(defun delta-increment (list)

  (cons 0 (butlast (delta-increment* list))))

 

(defun convert-duration-to-onset (list)

  (delta-increment list))

 

;;(note-event-sequence** (delta-increment '(1000 1000)) '(60 64) '(2000 1000) '(1 1) '(32 32))

;;(additive-process 20 '(2000 800 1400))

 

(defun generate-additive-process* (n onset-list pitch-list duration-list channel-list velocity-list)

  (note-event-sequence**

   (delta-increment (additive-process n onset-list))

   (additive-process n pitch-list)

   (additive-process n duration-list)

   (additive-process n channel-list)

   (additive-process n velocity-list)))

 

;;(generate-additive-process* 20 '(1000 800 1400 50) '(58.5 78 60) '(2000 1000) '(1) '(32 16))

 

(defun choose-file-dialog (&key (prompt "Open file")  (operation :open))

  (let ((screen (capi:convert-to-screen)))

    (capi:screen-width screen)

    (capi:screen-height screen)

    (capi:prompt-for-file prompt

                          :operation operation

                          :owner screen

                          :filters '("All Files" "*.*"))))

 

(defun choose-new-file-dialog (&key (prompt "Save File") (operation :save))

  (choose-file-dialog :prompt prompt :operation operation))

 

(defun spear-formatting (input)

  (with-open-file (output (choose-new-file-dialog)

                          :direction :output

                          :if-exists :supersede)

    (do ((input-list input (rest input-list))

         (partial-number 0 (+ partial-number 1))

         (printing

          (progn

            (format output "~&~a"  "par-text-partials-format")

            (format output "~&~a ~a ~a ~a"  "point-type" "time" "frequency" "amplitude")

            (format output "~&~a ~a"  "partials-count" (length input))

            (format output "~&~a"  "partials-data"))

          (progn

            (format output "~&~a ~a ~a ~a"

                    partial-number

                    (length (first (first input-list)))

                    (first (first (first input-list)))

                    (first (last (first (first input-list)))))

            (loop for x in (mapcar #'list (first (first input-list)) (second (first input-list)) (third (first input-list)))

                  for string = "~&~,6f ~,6f ~,6f" then " ~,6f ~,6f ~,6f"

                  do (format output string

                             (float (first x))

                             (float (second x))

                             (float (third x)))))))

        ((endp input-list) 't))))

 

(defun note-event (n-partials

                   fundamental

                   duration

                   amplitude

                   &key

                   (envelope *constant-envelope*)

                   (distortion 0)

                   (invert-frequency 'nil)

                   (invert-amplitude 'nil)

                   (deviate-frequency 0)

                   (deviate-amplitude 0)

                   (partial-indexing :all-partials))

  (let* ((total-duration (normalize-duration (/ duration 1000.0)))

         (raw-envelope (envelope-values (normalize-scaling (scale-envelope total-duration envelope))))

         (ratio-list (if invert-frequency

                       (invert-harmonic-ratio n-partials)

                       (loop for ratio from 1.0 to n-partials

                             collect ratio)))

         (partials (partial-index (distort-harmonic-series (convert-midi-to-frequency fundamental) distortion ratio-list) partial-indexing))

         (raw-amplitude (partial-index (if invert-amplitude

                                         (let ((amplitude-values (reverse (mapcar #'map-amp (amplitude-squared-inverse n-partials)))))

                                           (append (last amplitude-values) (butlast amplitude-values)))

                                         (mapcar #'map-amp (amplitude-squared-inverse n-partials))) partial-indexing))

         (onset (sieve-duration total-duration 0.05))

         (expand-partials (loop for x in partials

                                collect (loop repeat (length onset)

                                              collect (deviate x deviate-frequency))))

         (expand-amplitude (loop for y in raw-amplitude

                                 collect (mapcar #'* (loop repeat (length onset)

                                                           collect (* (normalize amplitude 0.0 127.0 0.0 1.0)

                                                                      (deviate y deviate-amplitude))) raw-envelope))))

    (loop for alpha in expand-partials

          for beta in expand-amplitude

          collect (list onset alpha beta))))

 

#|

 

(spear-formatting

 (note-event 10 60 1000 64

             :distortion 10

             :envelope *triangle-envelope*

             :deviate-frequency 2

             :deviate-amplitude 10

             :invert-frequency 't))

 

(spear-formatting

 (note-event 20 60 500 64

             :distortion 20

             :envelope *triangle-envelope*

             :deviate-frequency 80

             :deviate-amplitude 50

             :invert-frequency 't

             :invert-amplitude 't))

 

(spear-formatting

 (note-event 10 60 20000 64

             :distortion 10

             :envelope *triangle-envelope*

             :deviate-frequency 2

             :deviate-amplitude 10

             :invert-frequency 't))

 

|#

 

(defmacro define-instrument (instrument-name

                             n-partials

                             &key

                             (envelope *trapezoid-envelope*)

                             (distortion 0)

                             (invert-frequency 'nil)

                             (invert-amplitude 'nil)

                             (deviate-frequency 0)

                             (deviate-amplitude 0)

                             (partial-indexing :all-partials))

  `(eval (list 'defun ,instrument-name '(pitch duration velocity)

               '(note-event ,n-partials pitch duration velocity

                            :envelope ,envelope

                            :distortion ,distortion

                            :invert-frequency ,invert-frequency

                            :invert-amplitude ,invert-amplitude

                            :deviate-frequency ,deviate-frequency

                            :deviate-amplitude ,deviate-amplitude

                            :partial-indexing ,partial-indexing))))

 

;;(define-instrument 'cicada 20 :distortion -10 :invert-amplitude 't)

;;(cicada 69 1000 32)

;;(apply #'cicada '(69 1000 32))

 

(defun spear-output (input &optional (counter 0))

  (if (endp input)

    't

    (progn

      (with-open-file

          (output (make-pathname :directory '(:absolute "users" "home" "directory")

                                 :name (format nil "~a-~a" "spear-format" counter)

                                 :type "txt")

                  :direction :output

                  :if-exists :supersede)

        (do ((input-list (first input) (rest input-list))

             (partial-number 0 (+ partial-number 1))

             (printing

              (progn

                (format output "~&~a"  "par-text-partials-format")

                (format output "~&~a ~a ~a ~a"  "point-type" "time" "frequency" "amplitude")

                (format output "~&~a ~a"  "partials-count" (length (first input)))

                (format output "~&~a"  "partials-data"))

              (progn

                (format output "~&~a ~a ~a ~a"

                        partial-number

                        (length (first (first input-list)))

                        (first (first (first input-list)))

                        (first (last (first (first input-list)))))

                (loop for x in (mapcar #'list (first (first input-list)) (second (first input-list)) (third (first input-list)))

                      for string = "~&~,6f ~,6f ~,6f" then " ~,6f ~,6f ~,6f"

                      do (format output string

                                 (float (first x))

                                 (float (second x))

                                 (float (third x)))))))

            ((endp input-list) 't)))

      (spear-output (rest input) (+ counter 1)))))

 

(defun create-note-event (input)

  (move-onset (first input) (apply (eval (list 'function (instrument-table (fourth input))))

                                   (list (second input) (third input) (fifth input)))))

 

#|

 

(defun create-note-event* (input)

  (move-onset (first input) (apply (eval (list 'function (instrument-table (fourth input))))

                                   (list (second input) (third input) (fifth input)))))

 

(defun create-sequence* (&rest input)

  input)

 

(defun create-sequence** (input)

  (if (endp input)

    'nil

    (append (create-note-event (first input))

            (create-sequence** (rest input)))))

 

(defun create-sequence (&rest input)

  (create-sequence** (apply #'create-sequence* input)))

 

|#

 

(defun create-sequence (input)

  (if (endp input)

    'nil

    (append (create-note-event (first input))

            (create-sequence (rest input)))))

 

;;(create-sequence '((500 69 2000 1 32) (500 69 2000 1 32)))

 

(defvar *constant-envelope* '((0.0 1.0) (1.0 1.0)))

(defvar *triangle-envelope* '((0.0 0.0) (0.5 1.0) (1.0 -0.5)))

(defvar *trapezoid-envelope* '((0.0 0.0) (0.1 1.0) (0.9 1.0) (1.0 -0.5)))

(defvar *line-down-envelope* '((0.0 0.0) (0.1 1.0) (1.0 -0.5)))

(defvar *line-up-envelope* '((0.0 0.0) (0.9 1.0) (1.0 -0.5)))

(defvar *bell-down-envelope* '((0.0 0.0) (0.1 1.0) (0.3 0.4) (1.0 -0.5)))

(defvar *bell-up-envelope* '((0.0 -0.5) (0.7 0.4) (0.9 1.0) (1.0 -1.0)))

(defvar *gaussian-envelope* '((0.0 0.0) (0.2 0.15) (0.4 0.8) (0.5 1.0) (0.6 0.8) (0.8 0.15) (1.0 -0.5)))

 

(define-instrument 'cicada

                   20

                   :distortion 10

                   :envelope *trapezoid-envelope*

                   :deviate-frequency 0.5

                   :deviate-amplitude 0.5

                   :invert-amplitude 't

                   :partial-indexing '(1 3 6 7 8 15 16 17 18 19 20))

 

(define-instrument 'magnet

                   6

                   :distortion 10

                   :envelope *triangle-envelope*

                   :deviate-frequency 2

                   :deviate-amplitude 10

                   :invert-frequency 't)

 

(defun bell (pitch duration velocity)

  (append (note-event 25 pitch duration velocity

                      :distortion 10

                      :envelope *bell-down-envelope*

                      :deviate-amplitude 0.5

                      :partial-indexing '(2 3 7 9 11 13 17 19 21 23 25))

          (note-event 25 pitch duration velocity

                      :distortion 12.5

                      :envelope *bell-down-envelope*

                      :deviate-amplitude 1

                      :invert-amplitude 't

                      :deviate-frequency 5

                      :partial-indexing '(2 3 7 9 11 13 17 19 21 23 25))

          (note-event 25 (+ pitch 0.5) duration velocity

                      :distortion 10

                      :envelope *bell-down-envelope*

                      :deviate-amplitude 0.5

                      :partial-indexing '(2 3 7 9 11 13 17 19 21 23 25))

          (note-event 25 (+ pitch 0.5) duration velocity

                      :distortion 12.5

                      :envelope *bell-down-envelope*

                      :deviate-amplitude 1

                      :invert-amplitude 't

                      :deviate-frequency 1

                      :partial-indexing '(2 3 7 9 11 13 17 19 21 23 25))))

 

(defun boreal (pitch duration velocity)

  (append

   (note-event 6 pitch duration velocity

               :distortion 5

               :envelope *line-up-envelope*

               :deviate-frequency 1

               :deviate-amplitude 50

               :invert-frequency 't

               :invert-amplitude 't)

   (note-event 6 pitch duration velocity

               :distortion 35

               :envelope *line-up-envelope*

               :deviate-frequency 1.5

               :deviate-amplitude 50

               :invert-frequency 't)))

 

(defun crystal (pitch duration velocity)

  (append

   (note-event 4 pitch duration velocity

               :distortion 5

               :envelope *gaussian-envelope*

               :deviate-frequency 0.1

               :deviate-amplitude 10

               :invert-amplitude 't

               :partial-indexing '(2 3 4))

   (note-event 6 pitch duration (deviate-percentage velocity -20)

               :envelope *gaussian-envelope*

               :deviate-frequency 0.25

               :deviate-amplitude 10

               :partial-indexing '(2 3 4 5 6))))

 

(defun spark (pitch duration velocity)

  (append

   (note-event 20 pitch duration velocity

               :distortion 5

               :envelope *line-down-envelope*

               :deviate-frequency 5

               :deviate-amplitude 10

               :partial-indexing '(2 3 4 5 6 7 8 9 10))

 (move-onset 100

             (note-event 20 pitch duration velocity 

                         :distortion 10

                         :envelope *bell-down-envelope*

                         :deviate-frequency 10

                         :deviate-amplitude 50

                         :partial-indexing '(2 3 4 5 6 7 8 9 10)))

 (move-onset 400

             (note-event 20 pitch duration velocity

                         :distortion 20

                         :envelope *line-down-envelope*

                         :deviate-frequency 20

                         :deviate-amplitude 100

                         :partial-indexing '(2 3 4 5 6 7 8 9 10)))))

 

(defun soil (pitch duration velocity)

  (append

   (note-event 10 pitch duration velocity

               :distortion 10

               :envelope *line-down-envelope*

               :deviate-amplitude 0.5

               :invert-amplitude 't)

   (note-event 10 pitch duration velocity

               :distortion 12.5

               :envelope *line-down-envelope*

               :deviate-amplitude 0.5

               :invert-amplitude 't)

   (note-event 10 (+ pitch 0.5) duration velocity

               :distortion 10

               :envelope *bell-up-envelope*

               :deviate-amplitude 0.5

               :invert-amplitude 't)

   (note-event 10 (+ pitch 0.5) duration velocity

               :distortion 12.5

               :envelope *bell-up-envelope*

               :deviate-amplitude 0.5

               :invert-amplitude 't)))

 

(defun instrument-table (instrument-number)

  (case instrument-number

    (1 'cicada)

    (2 'magnet)

    (3 'bell)

    (4 'boreal)

    (5 'crystal)

    (6 'spark)

    (7 'soil)))

 

#|

 

(spear-formatting

 (append (create-sequence '((0 58.5 20000 7 32)))

         (move-onset 52000 (create-sequence '((0 60.5 10000 7 32))))

         (move-onset 12400 (create-sequence (generate-additive-process* 50

                                                                        '(1000 800 1400 100)

                                                                        '(48 66.5 59 63.25)

                                                                        '(2000 1000 3000 500)

                                                                        '(1 2 3 4 5 6)

                                                                        '(32 16 32 16 32))))

         (move-onset 16000 (create-sequence (generate-additive-process* 50

                                                                       (permute-list '(1000 800 1400 100))

                                                                       (permute-list '(48 66.5 59 63.25))

                                                                       (permute-list '(2000 1000 3000 500))

                                                                       (permute-list '(1 2 3 4 5 6))

                                                                       (permute-list '(32 16 32 16 32)))))))

 

|#