; Dover Variations

(load "nudruz.lisp")
(load "beats.lisp")
(load "inflect.lisp")
(load "designs.lisp")
(load "modes.lisp")
(load "diffs.lisp")
(load "rewrite.lisp")
(load "graphs.lisp")
(load "tonnetz.lisp")
(load "selfsim.lisp")
(load "reger.lisp")
(load "scanons.lisp")
(load "nondet.lisp")
(load "motive.lisp")
(load "lewin.lisp")
(load "slonimsky.lisp")
(load "oddities.lisp")
(load "tiling.lisp")
(load "transforms.lisp")

; PRESETS, INPUT DATA, ETC.
; LOAD FIRST

(define dovermid
    (midi-in "Dover-0.mid"))

;; adjusted pitches
(define doverpits
    ' ((60 67 48 52) 
       (60 64 48 55) (60 69 53 53) (60 67 52 55) (62 71 50 53)
       (64 72 48 55) (64 72 48 55) 
       (62 71 55 55) (64 72 48 55) (62 71 50 55) (60 69 50 54) 
       (59 67 43 55) (60 64 48 55) 
       (60 65 45 53) (60 67 48 52) (60 69 53 53) (60 67 52 55) 
       (62 65 47 55) (60 64 48 55) (59 62 43 55) (59 67 53 55) 
       (60 72 52 55) (60 65 53 57) (60 64 55 55) (59 62 43 55)
       (60 55 48 52)))

; durations for 'doverpits' [1/2 length]
(define dover-ryts
    '(1 
      1/2 1/2 1 1 
      2 1 
      1/2 1/2 1 1 
      2 1 
      1/2 1/2 1 1 
      1/2 1/2 1 1 
      1/2 1/2 1 1 
      3))

;; primary phrase duration set as motive (atk/dur pair)
(define dover-motive '((1 1 1 1 1 1) (1 1 2 2 4 2)))

;; adjusted normal-forms
(define doverchds
    '((0 4 7) (0 4 7) (5 9 0) (0 4 7) (11 2 5) (0 4 7) (0 4 7) (7 11 2) (0 4 7)
      (7 11 2) (2 6 9) (7 11 2) (0 4 7) (5 9 0) (0 4 7) (5 9 0) (0 4 7) (7 11 2)
      (0 4 7) (7 11 2) (5 7 11) (0 4 7) (5 9 0) (0 4 7) (7 11 2) (0 4 7)))

(define demult-ryt (second (demultiplied-motive dover-motive)))

(define mult-ryt (second (multiplied-motive dover-motive)))

(define spawns
    (mapcar #'second
	    (spawned-motive dover-motive)))

(define doverlines
    (chds->lines doverpits))

(define bass (nth 0 doverlines))
(define tenor (nth 1 doverlines))
(define alto (nth 2 doverlines))
(define sopr (nth 3 doverlines))

;; randomness with dover-ryts (different each time called)
(defun theselens (factor)
  (loop for d in (hits->ints dover-ryts) collect
	(floor (vary (* d factor) .3))))

;; FINAL VARIATIONS BELOW

; variation A = 'tile2'

;; A PITCHES/RHYTHM
;; 'sop2' = Cmaj scale degrees of sopr line w/repeated pitches removed, grouped into overlapping
;;               3-note sequences of indices (0 1 2) (2 3 4) (4 5 6) etc.
;; 'tilevec6a' = (1 2 3 2 2 4 5 6 5 5 1 4 3 6 4 1 6 3), each # representing members of a 3-atk group
;; 'pits' = each 3-note set in 'sop2' is scale deg. transposed 5 different ways & distributed 
;;             randomly among orig. & adjacent octaves (using randvec). Along with a 'rest vector',
;;             these transpositions are then placed into 'tilevec6a' by index. 
;;             Motoric 8th notes. Rests become ties.

(events
 (let* ((sop2 
	 (butlast
	  (loop for n to 24 by 2 collect
		(subseq (first (make-ties (modenums sopr ionian))) n (+ 3 n)))))
	(pits
	 (play-mode
	  (flatten
	   (loop for so in sop2 collect 
		 (place-cantiles so 
				 (shuffle (cons 'r 
						(shuffle (placereg (indices 5) (randvec 5 3 -1) 7)))) 
				 tilevec6a))
	   ) ionian)))
   (play-sd (slots->durs pits) .25))
 "tile2.mid" :play 'nil)

; variation B = 'susp'

;; B PITCHES/RHYTHM
;; 'rgrdov' = 'slonim' trichords are built from soprano line & opening trichord '(53 60 67). Then
;;               intermediate rgr-transformation chords are found using 'rgr-branch'
;; 'pbr' = 'rgrdov' trichords are shuffled, then the list is flattened. Flattened list is parsed into
;;               slotlists by octave
;; 'pbr2' = lowest 2 octaves in 'pbr' are merged, so 3 lines total
;; Final version: rests become ties, slots move at 8th note

(define rgrdov
    (rgr-branch
     (slonim '(53 60) sopr))) 

(events
 (let* ((pbr
	 (parse-by-reg
	  (flatten
	   (shuffle-all
	    (loop for rd in rgrdov append rd)))
	  12 7))
	(pbr2 (list (merge-slots (list (first pbr) (second pbr)))
		    (third pbr)
		    (fourth pbr)))
	(sds (mapcar #'slots->durs pbr2))
	(mties (mapcar (lambda (x) (make-ties (first x))) sds)))
   (loop for n to (- (length pbr2) 1) collect
	 (splay (first (nth n mties))
		(transp (sum-across (second (nth n sds)) (second (nth n mties))) .25 #'*))))
 "susp.mid" :play 'nil)

; variation C = 'noodleac'

;; 'noodle' = top line 
;; PITCHES: sopr melody is analyzed for 2nd-order markov; 300-note melody is 
;;     generated from the resulting matrix
;; RHYTHM:'mel-stress' distributes 32nd atx according to probability vector 
;;     derived from 'dover-motive': 
;;     (2 1 2 1 2 1 1 1 2 1 1 1 2 1 1 1 1 1 1 1 2 1 1 1)

(events
 (let* ((dm (transp (second dover-motive) 2 #'*))
	(stressvec
	 (slots->code
	  (durs->slots (copylist '(1) (length dm)) dm))))
   (play-sd
    (slots->durs
     (mel-stress 
      (next
       (markov-analyze sopr :order 2)
       300)
      (transp stressvec 1)))
    .125))
 "noodle.mid" :play 'nil)

;; 'acc' = left hand & pedal
;; hymn's bassline is augmented by 1.5 & doubled to nearest 
;;          consonance by contrary motion ('au-contraire')

(events
 (splay
  (merge-slots
   (list bass
	 (au-contraire bass 57)))
  (transp dover-ryts 3 #'*))
 "acc.mid" :play 'nil)

;; C - 'noodle' & 'acc' played simultaneously

(events
 (playmids "noodle.mid" "acc.mid")
 "noodlac.mid" :play 'nil)

; variation D = 'arpg'

;; D = upper arpeggiation, lower line
;; upper line:
;;  PITCH top 3 voices (SAT) merged, then arpeggiated (2 pits -> 3 notes)
;;  RHYTHM 16th pairs w/ occasional triplet (by poisson vector, prob .3)
;; lower line:
;;  hymn bassline with 'theselens' (random variation of hymn duration) augmented by 6, matched to upper atx

(events
 (let* ((ms (merge-slots (list sopr alto tenor)))
	(tlens (theselens 6))
	(bdurs (ferney '(1/2) (transp (clip-hi 1 (poissonvec .3 1500)) 2)))
	) 
   (list
    (splay
     (loop for n to (- (length ms) 1) append
	   (next (makecyc (arpegg (nth n ms) 2 3)) (nth n tlens)))
     bdurs)
    (splay bass (sum-across bdurs tlens))))
 "arpg.mid" :play 'nil)

; variation E = 'float'

; E -- three lines, one main rhythm ['bdurs' = four 16ths + 3 8th-triplets]
; outer lines = soprano & bass on 'theselens'*5 [randomized durs]
; left hand = 'smorph'ed alto+tenor dyads; ie gradual mutation 
;;  between dyads (over same durs as outer parts)

(events
 (let ((lens (theselens 5))
       (bdurs (ferney '(1) '(4 3))))
   (list
    (splay sopr (sum-across bdurs lens))
    (splay bass (sum-across bdurs lens))
    (splay
     (smorph
      (merge-slots (list tenor alto))
      lens)
     (makecyc bdurs))))
 "float.mid" :play 'nil)

; variation F = 'whip'

;; F -- HI PART
;; 'mylints' = soprano melody is divided by phrase (lengths 6 6 5 4 5); 
;;               each phrase is melodically self-expanded twice
;; 'hipits' = 'mylints' are filtered into nearest member of 
;;   randomly-generated 2-octave twelve-tone mode 
;;   (different mode is generated for each phrase)
;; F -- LO PART
;; soprano part is augmented in the bass proportionally to the entire upper part

(events
 (let* ((mylints
	 (mapcar (lambda (x) (self-expand x 3 'f))
		 (make-poly
		  sopr '(6 6 5 4 5))))
	(hipits
	 (norpt (flatten 
		 (loop for m in mylints collect (tintab m (make-ttmode 2)))))))
   (list
    (splay hipits .125)
    (splay (transp sopr -24) (transp (theselens (/ (length hipits)
						   (apply #'+ (hits->ints dover-ryts))))
				     .125 #'*))))
 "whip.mid" :play 'nil)

; variation G = 'ttwind' tweaked into 'var7b'

;; TTWIND 
;; 'slon' = slonimsky patterns interpolated between each note in sopr melody
;; 'demult-ryt' = primary phrase motive 'dover-motive' (1 1 2 2 4 2)
;;                    demultiplied into (cf Boulez) 
;;   (1/12 1/12 1/6 1/6 1/3 1/6 1/12 1/12 1/6 1/6 1/3 1/6 1/6 1/6 1/3 1/3 2/3 1/3
;;        1/6 1/6 1/3 1/3 2/3 1/3 1/3 1/3 2/3 2/3 4/3 2/3 1/6 1/6 1/3 1/3 2/3 1/3)
;;  topline = slon pits w/ cyclic 'demult-ryt'
;;  bottomline = soprano melody against every 7th note in top

(events
 (let* ((slon (slonim-expand sopr))
	(bdurs (next (makecyc demult-ryt) 300)))
   (list
    (splay slon bdurs)
    (splay (transp sopr -24) (sum-across-all bdurs '(7))))) 
 "ttwind.mid" :play 'nil)

;; VAR7B adjustment = multiplied durations by 1.5 & quantized to 32nd notes

(events
 (let ((min (midi-in "dover/var7-0.mid")))
   (splay
    (first min)
    (mapcar (lambda (x) (quantize x .125))
            (transp (second min) 3/2 #'*))))
 "dover/var7b.mid" :play 'nil)

; variation H = 'mess'

;; I -- two simultaneous strands
;; 'spits' = slonimsky-style pattern interpolation between pits in soprano melody (a list from each pitch)
;; 'sdurs' = list of 'dnbeats' w/long first note (hymn note), rest of list to complete dur in 
;;               'theselens'*11 (randomized hymn durs)
;; 'basedurs' = fast background duration set. randomly chooses between:
;;       (multquant '(2 3) (pick 1 1.5 2)) = resultant of divisions 2 & 3 over dur picked from 1, 1.5, or 2 
;;	 (transp (strums 1 2 2 2 3) .25 #'*) = random vector: either '(.5 .25 .25) or '(.5 .25 .25 .25)
;; 'accpits' = the following operations, in order:
;;             STEP 1
;;                 1. start with list (1 4 7)
;;                 2. generate line starting w/first number in list, using (1st 3rd 2nd) number as 
;;                        melodic intervals. Take mod 12 & remove duplicates.
;;                 3. sort result & perform operation (2) on it. repeat 100 times               
;;             STEP 2
;;                 take all chds generated in Step 1 & stack them up maximizing major 3rds. Then place
;;                       into tenor register
;;             STEP 3                    
;;                 smooth Step 2's chords by removing any pits that were part of previous chd
;; TOPLINE = 'spits' with 'sdurs' (hymn proportions) applied across 'basedurs'
;; BOTTOMLINE = 'accpits' (low chords) starting at the beginning of each 'basedurs' list

(events
 (let* ((spits (slonim-expand (transp sopr 12) 'nf))
	(sdurs (dnbeats spits (butlast (theselens 11))))
	(basedurs
	 (loop repeat 200 collect
	       (pick
		(multquant '(2 3) (pick 1 1.5 2))
		(transp (strums 1 2 2 2 3) .25 #'*))))
	(accpits 
	 (smoothlist 
	  (mapcar (lambda (x) (placereg x 4))
		  (mapcar (lambda (x) (car (stack-by x 4)))
			  (recurz 
			   (lambda (input)
			     (let* ((x (safesort (mod12 input))))
			       (remove-duplicates 
				(mod12 (melint->line (car x) (list (first x) (third x) (second x))))))) 
			   '(1 4 7)
			   100))))))
   (list
    (splay (flatten spits) (sum-across (flatten basedurs) sdurs))
    (splay accpits (mapcar (lambda (x) (apply #'+ x)) basedurs))))
 "mess.mid" :play 'nil)

; variation I = 'spacechd'

;; I PITCHES
;; soprano line is distributed into octaves 3,4,5 (in order). 
;; this list is copied 6x, then gathered into 3-note sublists
;; 'chds->lines' separates these chords into 3 lines. Repeats in each line become ties.
;; I RHYTHM
;; Boulez-ian 'multiplied-motive' of basic phrase motive is augmented 1.5x. Rhythm repeats.

(events
 (let ((lines (chds->lines
	       (make-poly
		(copylist 
		 (placereg sopr (new cycle of '(3 4 5)))
		 6)
		3))))
   (play-ties (mapcar #'make-ties lines) 
	      (makecyc (transp mult-ryt 1.5 #'*))))
 "spacechd.mid" :play 'nil)

; variation J = 'strav1'

;; J -- three lines
;; PITCHES
;; 'slots' = soprano is divided into phrases len (6 6 5 4 5). 
;;             all subsequences length 4 are taken in each & 
;;             each subseq is shuffled internally. 
;;             Entire list is flattened and flat-list is distributed in 
;;             3 octaves. this result is then parsed by register, 
;;             made into tied durs in 'sds' and mties
;; RHYTHM
;; 'basedurs' = mostly quarters (1), with occasional dotted-quarters (1.5) 
;;    governed by poissonvec (prob .1)
;;    -- tied pitches in 3 lines expressed across 'basedurs'

(events
 (let* ((slots
	 (parse-by-reg
	  (placereg
	   (flatten
	    (shuffle-all
	     (loop for x in 
		   (make-poly sopr '(6 6 5 4 5))
		   append (if (> (length x) 4) (subsequences x 4) (list x)))))
	   (new heap :of '(3 4 5)))))
	(sds (mapcar #'slots->durs slots))
	(basedurs (chooser (clip-hi 1 (poissonvec .1 200)) '(1 1.5)))
	(mties (loop for s in sds collect (make-ties (first s)))))
   (loop for n to (- (length sds) 1) collect
	 (splay (first (nth n mties))
		(sum-across basedurs
			    (sum-across (second (nth n sds))
					(second (nth n mties)))))))
 "strav1.mid" :play 'nil)