;; verlaine &c. 
(load "tiling.lisp")
(load "selfsim.lisp")
(load "modes.lisp")
(load "spacegrp.lisp")
(load "nondet.lisp")
(load "tonnetz.lisp")

;; load these in

(defun poetmult (x)
  (if (listp x) (loop for y in x collect (poetmult y))
  (case x 
    (u 1)
    (e (+ 5 (random 5)))
    (fin 10)
    (s (+ 2 (random 2))))))

(define kaleid-vers '(
                      ((u u s u u u s u e)     ; verse 1
                       (u u s u u s u u s u e)
                       (u u s u u s u s u u u e)
                       (u u u s u u u s u u fin))
                      ((u u s u u s u s u u e) ; verse 2
                       (u u s u s u u s u e)
                       (u u u s u u s u u s u u e)
                       (u u u s u u s u u fin))
                      ((u u s u s u u s u e)   ; verse 3
                       (u u s u u u s u u e)
                       (u u u s u u u s u u u e)
                       (u u u s u u u s u u fin))
                      ((u u s u u s u u u s u e) ; verse 4
                       (u s u u s s u s u e)
                       (u s u u s u u u s u e)
                       (u s u u s u u s u u fin))
                      ((u s u s u u u s u s u e) ; verse 5
                       (u u u s u u u s u u u e)
                       (u u s u u u s u u u e)
                       (u s u u u s u u fin))
                      ((u u u s u s u u u s u e) ; verse 6
                       (u u s u u s u u s u u e)
                       (u u s u u s u u u s u e)
                       (u u s u s u u s u u fin))
                      ((u u s u s u s u s u e) ; verse 7
                       (u u s u u s u u s u u e)
                       (u u s u s u u s u e)
                       (u s u s u u u u s u s u fin))))

(define pier-vers '(((u u s u u s u s u u e) ; verse 1
                     (u u s u u s u u u s u e)
                     (u u s u u u s u s u e)
                     (u u s u u s u s u u fin))
                    ((u u s u u s u u u s u e) ; verse 2
                     (u u s u s u u s u u e)
                     (u u s u u s u u s u e)
                     (u u u s u u u s u fin))
                    ((u u u s u s u u u s u e) ; verse 3
                     (u u s u u s u u e)
                     (u u s u u u s u u fin)) ; verse 4
                    ((u s u s u s u s u u e)
                     (u u u s u s u u s u e)
                     (u s u s u u u s u u u fin))))

(define ete-vers '(((u u s u u s u e) ; verse 1
                    (u u s u s u e)
                    (u u s u u u e)
                    (u u s u u s u fin))
                   ((u u s u s u u e) ; verse 2
                    (u s u s u u e)
                    (u u s u s u e)
                    (u u u s s u fin)) ; verse 3
                   ((u s u s u s e)
                    (u u s u u s u e)
                    (u s u s u s u fin))
                   ((u u s u u u e)
                    (u u s u u u e)
                    (u u s u u s fin))))
;;;;;;;

(loop for x in pier-vers collect
      (loop for y in x collect (length y)))



(define strummer (transp (strums 100 2 2 3 7) 3))


(define fernbase (ferney '(2) strummer))

(define (mulebyvers versenum basepit modename tlevel)
  (let* ((thisvers (flatten (nth versenum kaleid-vers)))
         (verselen (length thisvers)))
    (process 
      for x in 
      (transp (play-mode 
               (transp 
                (randmel (length thisvers) 4) basepit) modename) tlevel)
      for dur in (sum-across fernbase (poetmult thisvers))
      when (or (numberp x) (listp x));; needed for rests
      output (multievent 'midi :keynum
                         :keynum x
                         :time (now)
                         :duration dur)
      wait dur)))

(events (list
         (mulebyvers 0 25 hyperlydian)
         (mulebyvers 0 30 hyperlydian)
         (mulebyvers 0 35 hyperlydian)
         (mulebyvers 0 40 hyperlydian)) "mule0.midi")

(events (list
         (mulebyvers 1 24 hyperlydian)
         (mulebyvers 1 30 hyperlydian)
         (mulebyvers 1 36 hyperlydian)
         (mulebyvers 1 40 hyperlydian)) "mule1.midi")

(events (list
         (mulebyvers 2 25 hyperlydian 0)
         (mulebyvers 2 30 hyperlydian 0)
         (mulebyvers 2 35 hyperlydian 0)
         (mulebyvers 2 40 hyperlydian 2)) "mule2.midi")

(events (list
         (mulebyvers 3 25 hyperlydian 0)
         (mulebyvers 3 30 ionian 0)
         (mulebyvers 3 35 hyperlydian 0)
         (mulebyvers 3 40 hyperlydian 0)) "mule3.midi")

(events (list
         (mulebyvers 4 25 hyperlydian 1)
         (mulebyvers 4 30 hyperlydian 1)
         (mulebyvers 4 35 hyperlydian 1)
         (mulebyvers 4 40 hyperlydian 1)) "mule4.midi")

(events (list
         (mulebyvers 5 24 hyperlydian 1)
         (mulebyvers 5 30 hyperphrygian 1)
         (mulebyvers 5 36 hyperlydian 1)
         (mulebyvers 5 40 hyperlydian 1)) "mule5.midi")

(events (list
         (mulebyvers 6 23 hyperlydian 0)
         (mulebyvers 6 28 hyperlydian 0)
         (mulebyvers 6 35 hyperphrygian 0)
         (mulebyvers 6 40 hyperphrygian 0)) "mule6.midi")

;;;;;;;;;;

(defun protomult (x)
  (if (listp x) (loop for y in x collect (protomult y))
      (case x 
        (u 1)
        (e 5)
        (fin 5)
        (s 3))))

;;;;;;;;

(defun poetchd (inchords vers)
  (let ((chdvec (new cycle of inchords)))
    (loop for x in vers
      (case x 
        (u 1)
        (e 5)
        (fin 5)
        (s 3)))))

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

(defun poetmult2 (x)
  (if (listp x) (loop for y in x collect (poetmult y))
  (case x 
    (u 1)
    (e (+ 4 (random 4)))
    (fin 10)
    (s (+ 2 (random 1))))))

(define pm-pier0 (poetmult2 (flatten (nth 0 pier-vers))))

(define strummer2 (mapcar (lambda (x) (if (= x 1) x 1.5))
                          (strums 20 2 2 3 7)))

(define ferncyc2 (makecyc 
                  (ferney strummer2 '(2 2 2 2 3))))

(define fc1 (next ferncyc2 45))
(define fc2 (next ferncyc2 45))

(define tzpits (tzrandchain '(48 66 76) (length (flatten (nth 0 pier-vers)))))
(define tops0 (topline tzpits))
(define mids0 (midline tzpits))
(define bottoms0 (bottomline tzpits))

(define tenore2 (transp mids0 -14))

(define (muleversp versenum inpits fc)
  (let* ((thisvers (flatten (nth versenum pier-vers)))
         (verselen (length thisvers))
         (pmults (poetmult thisvers)))
    (process 
      for x in inpits
      for durmult in pm-pier0
      for fcmult in fc
      for dur in (sum-across fc pm-pier0)
      when (or (numberp x) (listp x));; needed for rests
      output (multievent 'midi :keynum
                         :keynum x
                         :time (now)
                         :duration dur)
      wait dur)))

(events (list 
         (muleversp 0 tenore2 fc2)
         (muleversp 0 tops0 fc1)
         (muleversp 0 mids0 fc1)
         (muleversp 0 bottoms0 fc1))
        "mulep0.midi" 
        '(0 0 1 0))


;; verse 2
(define pm-pier1 (poetmult2 (flatten (nth 1 pier-vers))))

(define strummer2 (mapcar (lambda (x) (if (= x 1) x 1.5))
                          (strums 20 2 2 3 7)))

(define ferncyc2 (makecyc 
                  (ferney strummer2 '(2 2 2 2 3))))

(define fc1b (next ferncyc2 44))
(define fc2b (next ferncyc2 44))

(define tzpits2 (tzrandchain '(48 56 66) (length (flatten (nth 1 pier-vers)))))
(define tops1 (topline tzpits2))
(define mids1 (midline tzpits2))
(define bottoms1 (bottomline tzpits2))

(define sopra2 (transp bottoms1 26))

(define (muleversp2 versenum inpits fc)
  (let* ((thisvers (flatten (nth versenum pier-vers)))
         (verselen (length thisvers))
         (pmults (poetmult thisvers)))
    (process 
      for x in inpits
      for dur in (sum-across fc pm-pier1)
      when (or (numberp x) (listp x));; needed for rests
      output (multievent 'midi :keynum
                         :keynum x
                         :time (now)
                         :duration dur)
      wait dur)))

(events (list 
         (muleversp2 1 sopra2 fc2b)
         (muleversp2 1 tops1 fc1b)
         (muleversp2 1 mids1 fc1b)
         (muleversp2 1 bottoms1 fc1b))
        "mulep1.midi" 
        '(0 0 1 0))

;; verse 3
(define pm-pier2 (poetmult2 (flatten (nth 2 pier-vers))))

(define strummer2 (mapcar (lambda (x) (if (= x 1) x 1.5))
                          (strums 20 2 2 3 7)))

(define ferncyc2 (makecyc 
                  (ferney strummer2 '(2 2 2 3 3))))

(define fc1c (next ferncyc2 31))
(define fc2c (next ferncyc2 31))

(define tzpits3 (tzrandchain '(48 57 74) (length (flatten (nth 2 pier-vers)))))
(define tops2 (topline tzpits3))
(define mids2 (midline tzpits3))
(define bottoms2 (bottomline tzpits3))

(define updowncyc (makecyc '(1 -1)))
(define altus2
  (loop for x in tops2 collect (nextcons 65 x (next updowncyc))))

(define (muleversp3 versenum inpits fc)
  (let* ((thisvers (flatten (nth versenum pier-vers)))
         (verselen (length thisvers))
         (pmults (poetmult thisvers)))
    (process 
      for x in inpits
      for dur in (sum-across fc pm-pier2)
      when (or (numberp x) (listp x));; needed for rests
      output (multievent 'midi :keynum
                         :keynum x
                         :time (now)
                         :duration dur)
      wait dur)))

(events (list 
         (muleversp3 1 altus2 fc2c)
         (muleversp3 1 tops2 fc1c)
         (muleversp3 1 mids2 fc1c)
         (muleversp3 1 bottoms2 fc1c))
        "mulep2.midi" 
        '(0 0 1 0))

;; verse 4
(define pm-pier3 (poetmult2 (flatten (nth 3 pier-vers))))

(define strummer2 (mapcar (lambda (x) (if (= x 1) x 1.5))
                          (strums 20 2 2 3 7)))

(define ferncyc2 (makecyc 
                  (ferney strummer2 '(2 2 2 2 2 2 3))))

(define fc1d (next ferncyc2 34))
(define fc2d (next ferncyc2 34))

(define tzpits4 (tzrandchain '(59 67 72) (length (flatten (nth 3 pier-vers)))))
(define tops3 (topline tzpits4))
(define mids3 (midline tzpits4))
(define bottoms3 (bottomline tzpits4))

(define updowncyc (makecyc '(1 -1)))
(define bassus2
  (loop for x in bottoms3 collect (nextcons 50 x (next updowncyc))))

(define (muleversp4 versenum inpits fc)
  (let* ((thisvers (flatten (nth versenum pier-vers)))
         (verselen (length thisvers))
         (pmults (poetmult thisvers)))
    (process 
      for x in inpits
      for dur in (sum-across fc pm-pier3)
      when (or (numberp x) (listp x));; needed for rests
      output (multievent 'midi :keynum
                         :keynum x
                         :time (now)
                         :duration dur)
      wait dur)))

(events (list 
         (muleversp4 1 bassus2 fc2d)
         (muleversp4 1 tops3 fc1d)
         (muleversp4 1 mids3 fc1d)
         (muleversp4 1 bottoms3 fc1d))
        "mulep3.midi" 
        '(0 0 1 0))

;;;;;;;; ete


(cllib:nsplit-list '(1 1 2 1 1 1 2 1 2) :pred (lambda (x y) (eql y 2)))
;; = ((1) (1 2) (1) (1) (1 2) (1 2))

(define ete0 (flatten (nth 0 ete-vers)))

(defun etescale (versenum)
  (loop for x in (flatten (nth versenum ete-vers)) collect
                 (case x 
                   (u (pick 1 2))
                   (e 3)
                   (fin 1)
                   (s (next (makecyc '(1 2 3 4)) (+ 2 (random 3)))))))

(defun rhythms-to-scale (etes-list)
    (flatten
     (loop for x in etes-list
           collect (if (numberp x) (if (eql x 3) (pick 2 2.5) (pick 1 .5)) 
                       (loop repeat (length x) 
                         collect (float (/ 1 (length x))))))))


; (apply #'+ (flatten (etescale 0))) = e.g. 75
; (apply #'+ (rhythms-to-scale (etescale 0))) = e.g. 30


(define (etebyvers versenum basepit modename tlevel)
  (let* ((this-etescale (etescale versenum)))
    (process 
      for x in 
      (transp (play-mode 
               (transp 
                (flatten this-etescale) basepit) modename) tlevel)
      for dur in (rhythms-to-scale this-etescale)
      when (or (numberp x) (listp x));; needed for rests
      output (multievent 'midi :keynum
                         :keynum x
                         :time (now)
                         :duration dur)
      wait dur)))


(define (etebyvers2 versenum pitlist)
  (let* ((this-etescale (etescale versenum)))
    (process 
      for x in (give-contour-to-set
                (flatten this-etescale) pitlist)
      for dur in (rhythms-to-scale this-etescale)
      when (or (numberp x) (listp x));; needed for rests
      output (multievent 'midi :keynum
                         :keynum x
                         :time (now)
                         :duration dur)
      wait dur)))

;;; 
(defun etescale2 (versenum)
  (loop for x in (flatten (nth versenum ete-vers)) collect
                 (case x 
                   (u (pick 1 2))
                   (e (pick 3 4))
                   (fin (pick 3 4))
                   (s (pick 3 4)))))

(defun ete-rhyt2 (versenum)
  (loop for x in (flatten (nth versenum ete-vers)) collect
                 (case x 
                   (u (pick 1 2))
                   (e (pick 4 5))
                   (fin 4)
                   (s (pick 2 3 4)))))

; (apply #'+ (sum-across (ferney '(1) '(1 2 3 2)) (ete-rhyt2 0)))


(define (etebyvers3 versenum pitlist)
 (let* ((this-etescale2 (etescale2 versenum))
        (this-rhyt2 (ete-rhyt2 versenum)))
    (process 
      for x in (give-contour-to-set
                (flatten this-etescale2) pitlist)
      for dur in (sum-across (ferney '(1) '(1 2 3 2)) this-rhyt2)
      when (or (numberp x) (listp x));; needed for rests
      output (multievent 'midi :keynum
                         :keynum x
                         :time (now)
                         :duration dur)
      wait dur)))

;;;; (etebyvers versenum basepit modename tlevel)


(events (list
         (etebyvers2 0 (transp '(0 2 5 7) 60))  
         (etebyvers3 0 (transp '(0 2 5 7) 67))  
         (etebyvers3 0 (transp '(0 2 5 7) 53))  
         (etebyvers2 0 (transp '(0 2 5 7) 46))  
         )
        "ete0.midi")

(events (list
         (etebyvers2 1 (transp '(0 2 5 7) 60))  
         (etebyvers3 1 (transp '(0 2 5 7) 67))  
         (etebyvers3 1 (transp '(0 2 5 7) 53))  
         (etebyvers2 1 (transp '(0 2 5 7) 46))  
         )
        "ete1.midi")

(events (list
         (etebyvers2 2 (transp '(0 2 4 7) 60))  
         (etebyvers2 2 (transp '(0 2 5 7) 67))  
         (etebyvers3 2 (transp '(0 2 4 7) 53))  
         (etebyvers2 2 (transp '(0 2 4 7) 46))  
         )
        "ete2.midi")

(events (list
         (etebyvers2 3 (transp '(0 2 4 7) 60))  
         (etebyvers2 3 (transp '(0 2 4 7) 67))  
         (etebyvers3 3 (transp '(0 2 4 7) 53))  
         (etebyvers2 3 (transp '(0 2 4 7) 44))  
         )
        "ete3.midi")