;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;

;; A SELF REPRODCUING MELODY

;;

;; A melody that pretends to be a DNA strand.

;; The melody acts like a gene sequence 

;; with each note acting as a codon.

;; Stretching the metaphors a little bit but

;; there is some fun self referencing here 

;; whereby a melody is it's own transformation. 

;;

;; c: increment index into melody

;; d: decrement index into melody

;; e: randomly move melody index

;; f: reverse melody

;; g: swap pitch at index with random pitch

;; a: delete note at current index

;; c2: add random note at current index

;;

;; Try messing with the melody and the codons

;;

;; Note that there are couple of useful list functions

;; defined in this example that you might like to

;; keep for future use.

;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; LIST HELPER FUNCTIONS

;;delete from list at index

(define delete-at-index

   (lambda (k lst)

      (cond ((or (null? lst) 

                 (< k 0))

             lst)

            ((= k 0)

             (cdr lst))

            ((>= k (length lst))

             lst)                 

            (else (set-cdr! (cl:nthcdr (- k 1) lst) 

                            (cl:nthcdr (+ k 1) lst))

                  lst))))

; insert into list at index

(define insert-at-index

   (lambda (k lst obj)

      (cond ((or (null? lst)

                 (< k 0))

             lst)

            ((= k 0)

             (cons obj lst))

            ((> k (length lst))

             lst)                 

            (else (set-cdr! (cl:nthcdr (- k 1) lst) 

                            (cons obj (cl:nthcdr k lst)))

                  lst))))

; change list item at index

(define change-at-index

   (lambda (k lst obj)

      (cond ((or (null? lst)

                 (< k 0))

             lst)

            ((>= k (length lst))

             lst)                 

            (else (set-car! (cl:nthcdr k lst) obj)

                  lst))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Setup Audio Graph

(au:clear-graph)

(define *guitar* (au:make-node "aumu" "dls " "appl"))

(define *koto* (au:make-node "aumu" "dls " "appl"))

(define *mixer* (au:make-node "aumx" "smxr" "appl"))

(define *reverb* (au:make-node "aufx" "mrev" "appl"))

(au:connect-node *reverb* 0 *au:output-node* 0)

(au:connect-node *mixer* 0 *reverb* 0)

(au:connect-node *guitar* 0 *mixer* 0)

(au:connect-node *koto* 0 *mixer* 1)

(au:update-graph)

(au:set-param (now) *reverb* 0 0 0 0.5)

(au:midi-out (now) *guitar* *io:midi-pc* 0 24 0)

(au:midi-out (now) *koto* *io:midi-pc* 0 108 0)

; Setup some global vars

(define *go* #t)

(define *pitch-map* '((c . 72) 

                      (d . 74) 

                      (e . 76)

                      (f . 77)

                      (g . 79) 

                      (a . 81)

                      (c2 . 84)))

(define *rhythm-map* '(0.25 0.25 0.25 0.25 0.5 0.5 2.0))

(define *accomp-map* '(60 64 67 60 64 67 60 64 62 65 69 62 65 69 62 65))

; Define codons

(define-macro (c) 

   '(set! index (+ index 1)))

(define-macro (d) 

   '(set! index (- index 1)))

(define-macro (e) 

   '(set! index (random (length melody))))

(define-macro (f)

   '(set! melody (reverse melody)))

(define-macro (g)

   '(set! melody (change-at-index index melody (random '(a c2 c d e f g)))))

(define-macro (a)

   '(set! melody (delete-at-index index melody)))

(define-macro (c2) 

   '(set! melody (insert-at-index index melody (random '(a c2 c d e f g)))))

; A simple pedal point

(define (pedal time)

   (play-note time *guitar* 36 120 (* 8 *second*))

   (play-note time *guitar* 48 120 (* 8 *second*))

   (let ((newtime (+ time (* (* 4 *second*) (random 5)))))

      (if *go* (callback (- newtime 20000) 'pedal newtime))))

; A simple arpeggio 

(define (arp time)

   (map (lambda (p)

           (play-note time *guitar* p (random 35 85) (* *second* 0.75))

           (set! time (+ time 11025)))

        *accomp-map*)

   (if *go* (callback (- time 20000) 'arp time)))

; Apply codons

(define (morph melody)

   (let ((index (random (length melody))))

      (map (lambda (x) ((eval x))) melody)

      melody))

; Loop melody (morphing between each loop)

(define (player time melody)

  (print melody)

  (map (lambda (p)

          (play-note time *koto* (cdr (assq p *pitch-map*)) (random 30 90) *second*)

          (set! time (+ time (* *second* (random *rhythm-map*)))))

       melody)

  (if (and *go*

           (not (null? melody))

      (callback (- time 20000) 'player time (morph melody)))))

(define (stop)

   (set! *go* #f))

(define (start time)

   (set! *go* #t)

   (arp time)

   (pedal time)

   (player time '(c c c d e e d e f g c2 c2 c2 g a g a f e d c)))

(stop)

(start (now))