; Carlisle 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")


; PRESETS, INPUT DATA, ETC.
; LOAD FIRST

;; 'carl' = soprano line, divided by phrase into pitch/duration sublist pairs
;; tonality neutral ie 0='do'
(define carl
    '(((0 7 0 4 2 0 -1 0)
       (1 1 1 .5 .5 .5 .5 3))
      ((0 5 7 9 7 0 5 4 2)
       (1 1 .5 .5 1 .5 .5 1 2))
      ((2 4 2 0 5 4 2 7 5 4 9)
       (1 1 .5 .5 1 .5 .5 1 .5 .5 1))
      ((11 12 0 5 4 2 0)
       (1 1 .5 .5 1 1 3))))

; carlmel = all soprano pits, flat
(define carlmel
    (loop for r in carl append (first r)))

; carlryt = all soprano durations, flat
(define carlryt
    (loop for r in carl append (second r)))

;; carl1b = bass part, by phrase
;; configured sim. to soprano above
(define carlb
    '(((12 11 9 5 7 12) (1 1 1 1 1 3)) 
      ((12 10 9 7 5 4 5 7) (.5 .5 1 .5 .5 1 1 3))
      ((7 12 17 16 14 19 17 16 21 19 17) (1 1 .5 .5 1 .5 .5 1 .5 .5 1))
      ((17 16 9 5 7 7 12) (1 1 .5 .5 1 1 4))))

(define carlbmel
    (loop for r in carlb append (first r)))
(define carlbryt
    (loop for r in carlb append (second r)))

(define dmajor (transp-mode ionian 2))
(define ebmajor (transp-mode ionian 3))

; soprano line as expressed as scale degrees in dmajor & ebmajor
(define carlmel-d
    (modenums (transp carlmel 2) dmajor))
(define carlmel-eb
    (modenums (transp carlmel 3) ebmajor))

;; from Cyberhymnal.org
(define midin-carl
    (midi-in "Carlisle-mid0.mid"))

; 'polycarl' = hymn pitches as chords, including passing tones
(define polycarl (first midin-carl))

; 'polycarl-ryts' = rhythms (flat) corresponding to chords in 'polycarl'
(define polycarl-ryts
    '(1 1 1 1/2 1/2 1/2 1/2 3 1/2 1/2 1 1/2 1/2 1 1/2 1/2 1 2 1 1/2 1/2 1/2 
      1/2 1/2 1/2 1/2 1/2 1/2 1/2 1/2 1/2 1 1 1 1/2 1/2 1 1/2 1/2 4))

; 'carlchds' = only the 4-part chords in 'polycarl' [no passing eighths etc.]
(define carlchds
    (no-nils
     (loop for x in (first midin-carl) collect 
	   (if (and (listp x) (eql (length x) 4)) x))))

; 'carlchds-eb' = 'carlchds' expressed as octave-sensitive 
;; scale deg in eb-major
(define carlchds-eb
    (mapcar (lambda (x) (modenums x ebmajor)) carlchds))

; 'thesedurs' = randomized short/med/long filter of durs in 'carlryt'
;; different each time invoked!
(define thesedurs
    (loop for h in (hits->ints carlryt) collect
	  (cond ((< h 2) (pick 1 2))
		((> h 2) (pick 5 6 7))
		(t (pick 3 4)))))

;; FINAL VARIATIONS BELOW

; variation A = 'wire'

;; A topline
;; A - PITCHES: makes nondet path 'wigline' in Eb major between sopr pits 
;;   by only leaping up & down 3 & 4 scale degrees in Eb major
;; A - RHYTHM:
;; 1. makes subdiv pattern of mostly sixteenths; introduces 16th-triplets
;;    by poisson distribution with factor .2
;; 2. each 'wigline' path has total duration four; 
;; so principal sopr pitch is lengthened whenever path is shorter than 4, or impossible
;; A bottomline (pedal): truncated soprano part that finds the next match w/topline at 
;;     imperfect consonance

(events
 (let* ((mline
	 (modenums 
	  (transp carlmel 63)
	  ebmajor))
	(wline
	 (wigline mline (copylist '(4) (length mline)) '(3 -3 4 -4)))
	(wpits (play-mode (first wline) ebmajor))
	(wryts 
	 (ferney '(1) 
		 (chooser (clip-hi 1 (poissonvec .2 20)) '(4 6))
		 (second wline))))
   (splay (consmatch (transp carlmel 51) wpits) wryts))
 "wire.mid" :play 'nil)

; variation B = 'arp'

;; B - PITCHES
;; 'chds' = all chords in hymn ('polycarl'), shuffled then re-taken as 3-note chords,
;;               then normal form is taken of each 3-note chord
;; 'm12rgr' = chordal path is attempted between each 3-note chord in 'chds' 
;;              [intervening chords are computed by 'rgr']
;; 'finpits' = 'm12rgr' is flattened & arpeggiated by following pattern:
;;                    length of each group of orig pits from cycle of '(2 3 4) 
;;                    length of each output set of pits from cycle of '(2 3 4 5 6)
;;              this vector is then placed registrally according to 'following-5'
;; 'finties' = any directly repeated pitches are eliminated from 'finpits' and made into
;;                ties (duration used in rhythm below)
;; B - RHYTHM
;; predominant rhythm: poisson vector of length 31, prob .3 is mapped to subdivisions of eight-note:
;;       0 = 16ths, 1 = 16th-trips, 2 = 32nds, from most to least likely/frequent
;; ties produced by 'finties' above is applied across the rhythm above (ie tied when repeated)

(events
 (let* ((chds
	 (mapcar #'normal-form
;		 (not-flat
		  (make-poly
		   (flatten
		    (shuffle-all
		     (not-flat polycarl)))
		   3)
		  )))
	(m12rgr
	 (loop for n to (- (length chds) 2) append
	       (let ((thischd (nth n chds))
		     (nextchd (nth (+ n 1) chds)))
		 (if (and (> (length thischd) 2) 
			  (eql (length thischd) (length nextchd)))
		     (rgr-path thischd nextchd)
		     thischd))))
	(finpits
	 (placereg
	  (arpegg (flatten m12rgr) (indices 3 2) (indices 5 2) 'f)
	  following-5))
	(finties (make-ties finpits)))
   (splay (first finties)
	  (sum-across
	   (ferncyc '(.5) (transp (poissonvec .3 31) 2))
	   (second finties))))
 "arp.mid" :play 'nil)


; variation C = 'funky'

; C pitch = polycarl 
; C rhythm = 1-slots in the first 17 generations of 7-length 1-dimensional cellular automata
;   to the speed of the sixteenth-note [0s are rests]

(events
 (splay
  (code->slots (flatten (rw-gens (auto-1d 7) 17)) polycarl)
  .25) 
 "funky.mid" :play 'nil)

; variation D = 'jazz'

;; D PITCHES
;; 'polycarl' (hymn as chords) are individually shuffled, the list is flattened, then regrouped into
;;     4-note lists. Each list is then re-ordered to produce the highest frequency of minor thirds
;;      as note-to-note melodic interval within the list. This list is then flattened & then regrouped
;;      polyphonically by a 25-length poisson vector (prob .2)
;; D RHYTHMS
;; 'durweight' scales 16th-note duration by # of notes in each atk (eg dyad = 8th)

(events
 (let ((pits
	(make-poly
	 (flatten
	  (mapcar (lambda (x) (car (reorder-by-melint x 3)))
		  (make-poly
		   (flatten
		    (shuffle-all
		     (not-flat polycarl)))
		   4)))
	 (transp (poissonvec .2 25) 1)))) 
   (splay pits (durweight pits .25)))
 "jazz.mid" :play 'nil)

; variation E = 'wind'

;; E PITCH
;; top line: based on 'treepits' = a  slonimsky-inspired pattern interpolated between each
;;   pair of pits in the hymn's soprano line
;; bottom line: 'au contraire' consonant contrary-motion counterline against every 4,5 (cycled) pitches 
;;   in the top line
;; E RHYTHM 
;; top line: hymn-tune soprano unfolds every two quarters; the slonim pattern is then distributed evenly between
;; these attacks   
;; bottom line is coordinated to attacks in topline

(events
 (let* ((treepits
	 (slonim-expand (transp carlmel 75) 'nf))
	(pits (flatten treepits))
	(durs (ornadurs treepits (makecyc '(2))))
	) 
   (list
    (splay 
     (au-contraire
      (norests (slowline pits '(4 5))) 58)
     (sum-across durs (copylist '(4 5) 100)))
    (splay (flatten treepits) (ornadurs treepits (makecyc '(2))))))
 "wind.mid" :play 'nil)

; variation F = 'bzchd'

;; F PITCHES 
;; 'chds' = hymn as chords, shuffled then recombined as 2,3-note chords (in cycle)
;; 'chd2' = makes 2- or 3-chord recursive Boulez multiplication sequence on each item in 'chds', 
;;           then each chord is shuffled internally
;; 'mties' = repeated notes in 'chd2' become ties
;; F RHYTHM
;; each chord in 'chd2' is distributed evenly within an eight-note according to its size
;; & repeated notes in the flattened monodic sequence are tied instead

(events
 (let* ((chds
	 (make-poly
	  (norpt
	   (flatten
	    (shuffle-all
	     (not-flat polycarl))))
	  '(2 3)))
	(chd2 
	 (loop for n to (- (length chds) 2) append
	       (shuffle-all
		(bzms-chain (nth n chds) (nth (+ n 1) chds) (+ 2 (random 3))))))
	(odurs (ornadurs chd2 .5))
	(cpits (flatten chd2))
	(mties (make-ties cpits)))
   (splay
    (first mties)
    (sum-across odurs (second mties))))
 "bzchd.mid" :play 'nil)

; variation G = 'run1'

;; G PITCHES
;; melodic intervals of the soprano line are computed, 
;;   then repeated randomly according to a poisson vector.
;; these intervals then determine the new line, which starts at the same opening pitch (Eb4)
;; G RHYTHM
;; motoric 32nds, where repeated notes become ties

(events
 (play-ties
  (list
   (make-ties
    (melint->line 63
		  (repeater
		   (melint carlmel)
		   (transp (poissonvec .3 50) 2)))))
  .125)
 "run1.mid" :play 'nil)

; variation H = 'run2'

;; H PITCHES
;; markov probabilities of melodic intervals in soprano melody are computed, 
;; then used to generate a new melody starting at Eb4
;; H RHYTHM
;; motoric 32nds, where repeated notes become ties

(events
 (play-ties
  (list
   (make-ties
    (melint->line 63
		  (next (markov-analyze (melint carlmel)) 100))))
  .125)
 "run2.mid" :play 'nil)

; variation I = 'strike'

;; I PITCH/RHYTHM
;; 2nd-order markov matrix of melodic intervals in sopr tune generates pitches
;; 32nds scaled to size of melodic interval ('leapdur'); repeated notes become ties
;; doubled at P5 above every (7 8 9 10 11) notes

(events
 (let* ((pits
	 (melint->line 63
		       (next
			(markov-analyze
			 (melint carlmel)
			 :order 2)
			200)))
	(mties (make-ties pits))
	(melpits (first mties))
	(meldurs (sum-across (leapdur pits .125) (second mties))))
   (splay
    (merge-slots 
     (list melpits 
	   (transp (slowline melpits (indices 5 7)) 7)))
    meldurs))
 "strike.mid" :play 'nil)

; variation J = 'chimes'

;; J PITCHES
;; hymn as chords is 'smoothed' (consecutive repeats are eliminated), then each is shuffled
;; random-length segments of (2 3 4) in the melody are repeated in 
;;   random-length groups of (4 5 6 7 8)
;; [segments vector length 11; arpg group vector length 12]
;; repeated notes are eliminated
;; J RHYTHM
;; 16th-note pairs occasionally become 16th-triplets 
;;   according to poisson vector (prob .3, length 43)

(events
 (splay
  (remove-rpts
   (arpegg
    (flatten
     (shuffle-all
      (smoothlist 
       (not-flat polycarl))))
    (randvec 11 3 2)
    (randvec 12 5 4)))
  (ferncyc '(.5) (transp (clip-hi 1 (poissonvec .3 43)) 2)))
 "chimes.mid" :play 'nil)

; variation K = 'drone'

;; K PITCHES
;; 'pits' = sopr line is transposed up P4 & copied 5 times
;; 'allslots' = all segments of 'pits' <= m3 are grouped into sublists; 
;;              these are placed randomly (in order) in 3 registers. 
;; K RHYTHM
;;  atk points are determined by 'melstress' where probability of atk is cycled thru 
;;  (5 1 2 1 3 1 2 1 4 1 2 1 3 1 2 1) by 32nd note. 
;;  Rests become ties and the 3 registers are made legato.

(events
 (let* ((pits (copylist (transp carlmel 63) 5))
	(allslots
	 (parse-by-reg
	  (mel-stress
	   (flatten
	    (placereg
	     (conjunct-fragments pits 3)
	     (new heap :of '(2 3 4))))
	   (transp (resclassvec 2 4 8 16) 1))))
	(allsd (loop for a in allslots collect (slots->durs a)))
	(allties (loop for s in allsd collect (make-ties (first s)))))
   (loop for n to 2 collect
	 (splay (first (nth n allties))
		(transp
		 (sum-across (second (nth n allsd)) 
			     (second (nth n allties))) 
		 .125 #'*))))
 "drone.mid" :play 'nil)

; variation L = 'sunrise'

;; L PITCHES
;; 'fromto-stepper' (best path between) interpolates between chords 
;;    represented as scale degr. in Eb. repeated notes become tied
;; L RHYTHM
;; durations between successive atx are a 'curved-path' from 
;;   0 to 5 8th-notes (factor .2) gradually over entire section, 
;; +1, with added poisson randomness

(events
 (let* ((cties
	 (chds->ties
	  (play-mode
	   (append
	    (loop for n to (- (length carlchds-eb) 2) append
		  (butlast (fromto-stepper (nth n carlchds-eb) 
					   (nth (+ n 1) carlchds-eb))))
	    (last carlchds-eb))
	   dmajor)))
	(totalen (apply #'+ (second (first cties)))))
   (play-ties cties
	      (transp 
	       (mapcar #'floor
		       (map 'list #'+
			    (transp (poissonvec .3 totalen) 1) 
			    (timefunc (indices totalen) 
				      (curved-path 0 5 .2 totalen))))
	       .5 #'*)))
 "sunrise.mid" :play 'nil)