; Lancashire 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 lancamid
    (midi-in "Lancashire-0.mid"))

;; hymn as bare 4pt chords
(define lanca-pits
    '((62 69 50 54) (62 69 50 54) (62 66 50 57) (62 67 50 59) (62 71 50 55)
      (62 69 50 54) (62 66 50 57) (66 74 48 57) (67 74 47 55) (62 67 47 62)
      (62 69 45 61) (62 71 43 59) (61 64 45 57) (61 69 45 55) (62 69 50 54)
      (62 66 50 60) (62 67 50 59) (62 71 50 55) (62 69 50 54) (62 66 50 57)
      (62 66 50 57) (61 64 52 57) (64 73 52 57) (62 71 52 56) (62 68 52 59)
      (61 69 45 57) (61 69 45 55) (62 69 50 54) (62 66 57 60) (57 62 54 60)
      (66 74 50 60) (67 74 43 59) (43 71 62 67) (62 67 55 59) (63 71 54 57) 
      (64 71 52 56)
      (64 68 59 62) (59 64 56 64) (68 76 52 62) (69 76 45 61) (73 57 64 69)
      (64 69 55 61) (57 74 54 62) (62 74 54 57) (64 74 55 59) (66 74 57 60)
      (67 74 59 62) (62 73 55 62) (62 71 43 55) (62 69 45 54) (62 66 45 57)
      (57 64 45 55) (57 61 45 52) (57 62 50 54)))

(define lanca-lines
    (chds->lines
     (mapcar #'safesort lanca-pits)))

(define sopr (nth 3 lanca-lines))
(define alto (nth 2 lanca-lines))
(define tenor (nth 1 lanca-lines))
(define bass (nth 0 lanca-lines))

(define dmajor (transp-mode ionian 2))

(define lanca-durs
    '(1.0 1.0 1.0 1.0 1.0 2.0 1.0 1.0 1.0 1.0 1.0 1.0 3.0 1.0 1.0 1.0 1.0 1.0 2.0
      1.0 1.0 1.0 1.0 1.0 1.0 3.0 1.0 1.0 1.0 1.0 1.0 1.5 0.5 1.0 1.0 1.0 1.0 1.0
      1.0 2.0 1.0 1.0 1.0 1.0 1.0 1.0 2.0 1.0 1.0 1.0 1.0 1.5 0.5 3.0))

(defun theselens (factor)
  (loop for d in (hits->ints lanca-durs) collect
	(floor (vary (* d factor) .3))))

;; FINAL VARIATIONS BELOW

; variation A = 'rgarp' tweaked into 'var1b'

;; A PITCHES
;; paths found between consec chds in hym via Reger transformations.
;;   result is 'smoothed' (repeated pitches removed from chords).
;;   flattened & repeats are removed.
;; A RHYTHM
;; motoric triplets in 'rgrarp'; adjusted to sixteenths in 'var1b'

;(define lanca-rgrbranch
;      (generic-branch #'rgr-alldim1 lanca-pits))

(define lanca-rgrbranch
    '(((62 69 50 54)) ((62 69 50 54) (62 69 50 54))
      ((62 66 50 57) (59 66 50) (55 62 50 59)) ((62 67 50 59) (62 67 50 59))
      ((62 71 50 55) (62 71 54) (62 69 50 66)) ((62 69 50 54) (62 69 50 54))
      ((62 66 50 57) (62 66 48 57)) ((66 74 48 57) (67 74 43 59))
      ((67 74 47 55) (62 74 47 55)) ((62 67 47 62)) ((62 69 45 61) (62 71 47 55))
      ((62 71 43 59) (64 71 43) (60 76 43) (60 76 45) (61 76 45 57))
      ((61 64 45 57) (61 67 45 57)) ((61 69 45 55)) ((62 69 50 54) (62 66 50 48))
      ((62 66 50 60)) ((62 67 50 59) (62 67 50 59))
      ((62 71 50 55) (62 71 54) (62 69 50 66)) ((62 69 50 54) (62 69 50 54))
      ((62 66 50 57)) ((62 66 50 57) (66 69 49) (64 64 49 69))
      ((61 64 52 57) (61 64 52 57)) ((64 73 52 57) (64 74 56 59))
      ((62 74 54 57)) ((64 74 55 59) (65 74 55 59) (66 74 55 59) (66 74 57 59))
      ((66 74 57 60)) ((67 74 59 62)) ((62 73 55 62) (62 71 55 67))
      ((62 71 43 55) (62 71 42) (62 69 45 66)) ((62 69 45 54) (62 69 45 54))
      ((62 66 45 57) (64 67 45 57)) ((57 64 45 55))
      ((62 71 52 56) (62 71 52 56)) ((62 68 52 59) (61 69 57 57)) ((61 69 45 57))
      ((61 69 45 55)) ((62 69 50 54) (62 69 48 54)) ((62 66 57 60) (62 66 57 60))
      ((57 62 54 60) (54 62 50 60)) ((66 74 50 60) (67 74 55 59))
      ((67 74 43 59) (67 74 43 59)) ((43 71 62 67) (43 71 62 67))
      ((62 67 55 59) (63 66 57 59)) ((63 71 54 57)) ((64 71 52 56) (64 71 50 56))
      ((64 68 59 62) (64 68 59 64)) ((59 64 56 64) (56 64 52 62))
      ((68 76 52 62) (69 76 57 61)) ((69 76 45 61) (73 76 45))
      ((73 57 64) (76 57 67 73)) ((64 69 55 61) (62 69 54 62)) ((57 74 54 62))
      ((62 74 54 57)) ((64 74 55 59) (65 74 55 59) (66 74 55 59) (66 74 57 59))
      ((66 74 57 60)) ((67 74 59 62)) ((62 73 55 62) (62 71 55 67))
      ((62 71 43 55) (62 71 42) (62 69 45 66)) ((62 69 45 54) (62 69 45 54))
      ((62 66 45 57) (64 67 45 57)) ((57 64 45 55))
      ((57 61 45 52) (54 61 45) (50 62 45 54)) ((57 62 50 54))))

(events
 (splay
  (norpt
   (flatten
    (mapcar #'safesort
	    (smoothlist
	     (flatter lanca-rgrbranch)))))
  (ferncyc '(1) '(6))) 
 "rgrarp.mid" :play 'nil)

(events
 (let ((min (midi-in "lancashire/var1-0.mid")))
   (splay (first min)
	  (mapcar (lambda (x) (quantize x .25))
		  (transp (second min) 3/2 #'*))))
 "var1b.mid" :play 'nil)

; variation B = 'stretto'

;; B PITCHES
;; soprano melody 3vc self-stretto at P5 down, 3-note delay
;; B RHYTHM
;; durations = size of chord * 16th

(events
 (let ((pits
	(not-flat
	 (self-stretto sopr 3 -7 3))))
   (splay pits (durweight pits .25)))
 "stretto1.mid" :play 'nil)

; variation C = 'jumper'

;; C -- two lines
;; TOP LINE = 2nd-order markov chain of sopr scale deg in D major, w/ties at 16th note
;; BOTTOM LINE = every 5+4 pitches doubled down P5

(events
 (let* ((ipits (play-mode
		(melint->line 39
			      (next (markov-analyze (melint (modenums sopr dmajor)) :order 2) 120))
		dmajor))
	(tpits (make-ties ipits)))
   (list
    (splay (first tpits) (transp (second tpits) .25 #'*))
    (splay (transp (slowline ipits '(5 4)) -7) .25)))
 "jumper.mid" :play 'nil)

; variation D = 'wow'

;; D PITCHES
;; slonim of soprano w/E5,B4 made into three lines
;; D RHYTHM
;; each line takes its own randomized hymn rhythm ('theselens') at 3x by the 16th note

(events
 (loop for lin in
       (mapcar #'make-ties
	       (chds->lines
		(slonim '(64 59) sopr)))
       collect 
       (splay (first lin)
	      (sum-across  
	       (transp (theselens 3) .25 #'*)
	       (second lin))))
 "wow.mid" :play 'nil)

; variation E = 'syncope'

;; E PITCHES
;; 4pt chords directly from hymn, in order
;; E RHYTHM
;; attack points from resclassvec (duration resultant) 5,9 cycled

(events
 (splay lanca-pits
	(makecyc
	 (transp
	  (code->durs
	   (resclassvec 5 9)) .25 #'*)))
 "syncope.mid" :play 'nil)

; variation F = 'tile'

;; F PITCHES
;; "tilevec15" (1 1 2 2 1 3 2 3 4 4 5 5 4 3 5) applied to:
;; 1 = bass, 2 = tenor, 3 = rest, 4 = alto, 5 = sopr
;; F RHYTHM
;; 16th notes; atk points determined by rests in tiling

(events
 (play-ties
  (list
   (make-ties
    (place-tiles
     (list 
      (makecyc bass) 
      (makecyc tenor) 
      'r
      (makecyc alto)
      (makecyc sopr))
     (copylist tilevec15 18))))
  .25)
 "tile.mid" :play 'nil)

; variation G = 'stroll'

;; G -- two coordinated lines: theme (sopr top line) + accompaniment (bass clef)
;; PITCH WORK
;; "lanca-tzbranch" = for each soprano pitch, randomly choose a major or minor
;;    triad containing that pitch. find tonnetz path between each consec
;;    pair of triads.
;; "accpits" = each list in 'lanca-tzbranch' is smoothed, all-shuffled,
;;               and flattened. then corresponding sopr pitch is filtered out.
;; BOTTOM LINE PITCHES ("accties") = short sublists of 'accpits' gathered
;;    using 'reordpatt' poissonvec; 'stack-up' is applied to each. placed into
;;    register 4 and ties made from repeats.  
;; TOP LINE PITCHES = soprano, rpts become ties
;; RHYTHM WORK
;; BOTTOM LINE RHYTHM = ties across "durs" = subdivs 4 & 6 of 
;;     quarter (poissonvec), tied over beat every 3,4,5 cycle
;; TOP LINE RHYTHM = coordinated to each new sublist in bass

;(define lanca-tzbranch
;    (let* ((chds12 (append (alltransp '(0 4 7))
;			   (alltransp '(0 3 7))))
;	   (majmin
;	    (loop for s in sopr collect
;		  (pickl
;		   (filter (lambda (x) (member (mod12 s) x)) chds12)))))
;      (generic-branch 'tonnetz-func majmin)))

(define lanca-tzbranch
    '(((9 1 4))
      ((9 1 4) (8 1 4) (8 11 4) (7 11 4) (7 11 2) (6 11 2) (6 9 2) (5 9 2)
       (5 9 0) (5 8 0) (3 8 0) (3 8 11) (3 6 11) (2 6 11))
      ((2 6 9) (2 5 9) (0 5 9) (0 5 8) (0 3 8) (0 3 7) (10 3 7) (10 2 7) (10 2 5)
       (10 1 5) (8 1 5) (8 1 4) (8 11 4) (7 11 4) (7 11 2))
      ((7 10 2) (5 10 2) (5 10 1) (5 8 1) (4 8 1))
      ((4 8 11) (3 8 11) (3 6 11) (2 6 11) (2 6 9) (1 6 9) (1 4 9) (0 4 9)
       (0 4 7) (11 4 7) (11 2 7) (10 2 7) (10 2 5) (9 2 5) (9 0 5) (8 0 5)
       (8 0 3) (8 11 3) (6 11 3) (6 11 2) (6 9 2) (5 9 2))
      ((5 9 0) (4 9 0) (4 7 0) (4 7 11) (2 7 11) (2 6 11))
      ((2 6 9) (2 5 9) (0 5 9) (0 5 8) (0 3 8) (11 3 8) (11 3 6))
      ((11 2 6) (9 2 6) (9 1 6) (9 1 4) (9 0 4) (7 0 4) (7 11 4))
      ((7 11 2) (6 11 2) (6 9 2) (6 9 1) (4 9 1) (4 9 0) (4 7 0) (3 7 0))
      ((3 7 10) (2 7 10) (2 5 10))
      ((2 5 9) (0 5 9) (0 5 8) (0 3 8) (11 3 8) (11 3 6) (11 2 6) (9 2 6) (9 2 5)
       (9 0 5) (8 0 5) (8 0 3))
      ((8 11 3) (6 11 3) (6 11 2) (6 9 2) (6 9 1) (4 9 1) (4 8 1) (4 8 11)
       (4 7 11) (2 7 11) (2 7 10) (2 5 10) (1 5 10) (1 5 8))
      ((1 4 8) (11 4 8) (11 4 7) (11 2 7) (10 2 7) (10 2 5) (9 2 5) (9 0 5))
      ((9 0 4) (7 0 4) (7 0 3) (7 10 3) (7 10 2) (5 10 2) (5 9 2) (5 9 0) (5 8 0)
       (3 8 0) (3 8 11) (3 6 11) (2 6 11) (2 6 9))
      ((2 5 9) (0 5 9) (0 4 9) (0 4 7) (0 3 7) (10 3 7) (10 2 7) (10 2 5)
       (10 1 5) (8 1 5) (8 0 5) (8 0 3) (8 11 3) (6 11 3) (6 10 3))
      ((6 10 1) (6 9 1) (4 9 1) (4 8 1) (4 8 11) (4 7 11) (2 7 11) (2 6 11)
       (2 6 9) (2 5 9) (0 5 9) (0 4 9))
      ((0 4 7) (11 4 7) (11 2 7)) ((11 2 6) (9 2 6) (9 1 6))
      ((9 1 4) (9 0 4) (7 0 4) (7 0 3) (7 10 3) (6 10 3) (6 10 1))
      ((6 9 1) (4 9 1) (4 8 1) (4 8 11) (4 7 11) (2 7 11) (2 6 11))
      ((2 6 9) (2 6 11) (3 6 11) (3 8 11))
      ((4 8 11) (3 8 11) (3 6 11) (3 6 10) (1 6 10) (1 5 10))
      ((1 5 8) (1 5 10) (2 5 10) (2 7 10) (2 7 11) (4 7 11))
      ((4 8 11) (4 7 11) (2 7 11) (2 7 10) (2 5 10) (1 5 10) (1 5 8) (0 5 8)
       (0 3 8) (11 3 8) (11 3 6) (11 2 6) (9 2 6) (9 2 5) (9 0 5) (8 0 5))
      ((8 0 3) (8 0 5) (9 0 5) (9 0 4))
      ((9 1 4) (8 1 4) (8 11 4) (8 11 3) (6 11 3) (6 11 2) (6 9 2) (5 9 2))
      ((5 9 0) (5 9 2) (6 9 2))
      ((6 9 1) (4 9 1) (4 8 1) (4 8 11) (4 7 11) (2 7 11) (2 6 11)) ((2 6 9))
      ((2 6 9) (2 5 9) (0 5 9) (0 5 8) (0 3 8) (0 3 7) (10 3 7) (10 2 7) (10 2 5)
       (10 1 5) (8 1 5) (8 1 4) (8 11 4) (7 11 4) (7 11 2))
      ((7 10 2) (5 10 2) (5 9 2) (5 9 0) (5 8 0) (3 8 0) (3 8 11) (3 6 11)
       (2 6 11) (2 6 9))
      ((2 5 9) (0 5 9) (0 5 8) (0 3 8) (11 3 8) (11 3 6))
      ((11 2 6) (9 2 6) (9 2 5) (9 0 5) (8 0 5) (8 0 3) (7 0 3) (7 10 3))
      ((7 10 2) (5 10 2) (5 10 1) (5 8 1) (4 8 1) (4 8 11))
      ((4 7 11) (2 7 11) (2 7 10) (2 5 10) (1 5 10) (1 5 8) (1 4 8) (11 4 8)
       (11 3 8))
      ((11 3 6) (11 2 6) (9 2 6) (9 2 5) (9 0 5) (8 0 5) (8 0 3))
      ((8 11 3) (6 11 3) (6 11 2) (6 9 2) (6 9 1) (4 9 1) (4 9 0) (4 7 0) (3 7 0)
       (3 7 10) (3 6 10) (1 6 10) (1 5 10) (1 5 8) (1 4 8) (11 4 8) (11 3 8)
       (11 3 6) (11 2 6) (9 2 6) (9 1 6))
      ((9 1 4) (9 0 4) (7 0 4) (7 0 3) (7 10 3) (6 10 3) (6 10 1) (6 9 1) (4 9 1)
       (4 8 1) (4 8 11) (4 7 11) (2 7 11) (2 6 11) (2 6 9) (2 5 9) (0 5 9)
       (0 4 9))
      ((0 4 7))
      ((0 4 7) (0 3 7) (10 3 7) (10 3 6) (10 1 6) (9 1 6) (9 1 4) (9 0 4) (7 0 4)
       (7 0 3) (7 10 3) (6 10 3) (6 10 1))
      ((6 9 1) (4 9 1) (4 9 0) (4 7 0) (3 7 0) (3 7 10) (2 7 10) (2 5 10))
      ((2 5 9) (0 5 9) (0 5 8) (0 3 8) (11 3 8) (11 3 6))
      ((11 2 6) (9 2 6) (9 1 6) (9 1 4) (9 0 4) (7 0 4) (7 11 4)) ((7 11 2))
      ((7 11 2))
      ((7 10 2) (5 10 2) (5 9 2) (5 9 0) (5 8 0) (3 8 0) (3 8 11) (3 6 11)
       (2 6 11) (2 6 9))
      ((2 5 9) (0 5 9) (0 5 8)) ((1 5 8) (1 5 10) (2 5 10) (2 7 10) (2 7 11))
      ((4 7 11) (2 7 11) (2 6 11) (2 6 9) (1 6 9) (1 4 9) (1 4 8) (11 4 8)
       (11 3 8) (11 3 6) (11 2 6) (9 2 6) (9 1 6))
      ((9 1 4) (9 1 6) (9 2 6))
      ((11 2 6) (9 2 6) (9 2 5) (9 0 5) (9 0 4) (7 0 4) (7 11 4) (7 11 2)
       (7 10 2) (5 10 2) (5 10 1) (5 8 1) (4 8 1) (4 8 11))
      ((4 7 11) (2 7 11) (2 7 10) (2 5 10) (1 5 10))
      ((1 5 8) (1 4 8) (11 4 8) (11 3 8) (11 3 6) (11 2 6) (9 2 6) (9 1 6)
       (9 1 4) (9 0 4) (7 0 4) (7 11 4))
      ((7 11 2))))

(events
 (let* ((accpits
	 (map 'list
	      (lambda (s c) 
		(filter (lambda (x) (not (eql (mod12 s) x))) 
			(flatten (shuffle-all (smoothlist c)))))
	      sopr lanca-tzbranch))
	(lens (mapcar #'length accpits))
	(durs
	 (avoidurs
	  (ferney '(1) (chooser (clip-hi 1 (poissonvec .3 31)) '(4 6)))
	  '(3 4 5)))
	(reordpatt (makecyc (transp (poissonvec .4 50) 1)))
	(sties (make-ties sopr))
	(accties (make-ties
		  (flatten
		   (placereg
		    (not-flat
		     (loop for p in accpits collect 
			   (mapcar #'stack-up
				   (not-flat
				    (make-poly p reordpatt)))))
		    4)))))
   (list
    (splay (first sties) 
	   (sum-across durs (sum-across lens (second sties))))
    (splay (first accties)
	   (sum-across durs (second accties)))))
 "stroll.mid" :play 'nil)

; variation H = 'oyeah'

;; H PITCHES 
;; "lanca-stravbranch" = sopr w/ slonim C#5,E5,F#5 branched via 'stravrot-func'
;; "pits" =  'lanca-stravbranch' & each chord shuffled
;;  --  'pits' matched by consonance with sopr line in bass (augmented 5x)
;; H RHYTHM = each chd in 'pits' is evenly spaced within an 8th note

;(define lanca-stravbranch
;    (generic-branch
;     'stravrot-func
;     (slonim '(61 64 66) sopr)))
(define lanca-stravbranch
    '(((61 64 66 69)) ((61 64 66 69)) ((61 64 69 66) (61 63 70 66)) ((62 64 71 67))
      ((62 64 67 71)) ((61 64 66 69)) ((61 64 69 66) (61 63 70 66) (62 66 71 69))
      ((59 66 69 74)) ((58 65 67 74) (59 64 67 74))
      ((59 64 62 67) (59 64 61 68) (57 62 60 65)) ((53 62 60 69))
      ((56 64 61 71) (55 64 60 69)) ((57 67 60 64))
      ((59 66 62 69) (59 66 63 68) (57 64 60 67)) ((55 64 60 69) (56 66 63 71))
      ((56 59 63 66) (55 58 62 65)) ((53 58 62 67) (54 59 63 68)) ((54 56 63 71))
      ((52 55 60 69) (54 56 63 71)) ((56 59 63 66) (56 60 63 65) (57 61 64 66))
      ((52 57 61 66) (52 57 61 66)) ((54 57 61 64) (56 59 61 64))
      ((56 59 64 73) (56 59 64 73)) ((61 56 64 71) (61 56 64 71))
      ((61 59 64 68) (61 58 65 68)) ((62 59 66 69) (63 59 66 68) (60 57 64 67))
      ((60 55 64 69)) ((61 54 64 69) (61 54 64 69)) ((61 57 64 66) (61 58 63 66))
      ((64 59 67 62) (64 59 68 61) (62 57 65 60)) ((60 57 65 74))
      ((59 57 66 74) (59 57 66 74)) ((57 54 62 71) (56 54 63 71) (55 52 60 69))
      ((57 52 60 67)) ((57 54 62 71)) ((56 54 63 71) (56 54 63 71))
      ((59 54 63 68) (56 48 63 65) (57 49 64 66))
      ((57 54 61 64) (58 54 61 63) (59 55 62 64)) ((59 55 62 76))
      ((59 56 61 76) (59 56 61 76)) ((59 56 64 73) (58 56 65 73) (59 57 66 74))
      ((59 54 62 69) (59 54 63 68) (56 48 63 65) (57 48 62 65)) ((57 53 60 74))
      ((59 57 54 74)) ((58 55 53 74)) ((59 55 52 74) (59 56 52 73) (57 53 50 72))
      ((57 53 48 74) (58 54 49 75)) ((58 54 51 73) (59 55 52 74)) ((55 52 50 71))
      ((54 52 49 69) (54 52 49 69)) ((57 52 49 66) (57 52 49 66))
      ((57 54 49 64) (57 54 49 64)) ((57 54 52 61) (58 54 51 61)) ((59 55 52 62))))

(events
 (let ((pits
	(shuffle-all
	 (smoothlist (flatter lanca-stravbranch)))))
   (splay
    (consmatch
     (menses (transp sopr -24) 5)
     (flatten pits))
    (ornadurs pits .5)))
 "oyeah.mid" :play 'nil)

; variation I = 'zappy' tweaked into 'var9b'

;; I PITCHES
;; each sopr note is transposed by a # randomly-selected from (0 5 10 3),
;;   then '(0 7 2 9) chord is built on that. mod12 taken. then smoothed & flattened, 
;;   placed into 5,6,4-cycled registers, and poly-gathered in 2,1-cycle
;; I DURATION
;; (orig.) quarters alternating with random 3,4,6 subdivisions
;; "var9b" = augmented 2x

(events
 (let ((mychds
	(loop for rm in (mod12 sopr)
	      collect
	      (mod12 
	       (transp '(0 7 2 9)
		       (+ rm (pickl '(0 5 10 3))))))))
   (splay
    (make-poly
     (placereg 
      (flatten (smoothlist mychds))
      (makecyc '(5 6 4)))
     '(2 1))
    (ferney '(1) 
	     (interlock (list 1) 
			(chooser (randvec 50 3) '(3 4 6))
			'(1) '(1)))))
 "zappy.mid" :play 'nil)

(events
 (let ((min (midi-in "lancashire/var9-0.mid")))
   (splay 
    (first min)
    (mapcar (lambda (x) (quantize x 1/12))
	    (transp (second min) 2 #'*))))
 "var9b.mid" :play 'nil)

; variation J = 'sbranch2'

;; J PITCHES
;; sopr line doubled at -P5,-M9, then branched via 'stravrot-func' ("sbranch2").
;;   each chd sorted w/'closest-mod-list' to make conjunct, then split into lines.
;; J RHYTHM
;; attack points @ 8th from all multiples of 3,4,7 ('resclassvec')

; (define sbranch2
;    (generic-branch 'stravrot-func
;		    (mapcar (lambda (x) (list x (- x 7) (- x 14))) sopr)))
(define sbranch2
    '(((69 62 55)) ((69 62 55) (67 60 50) (68 63 46) (66 64 47))
      ((66 59 52) (60 55 50) (60 55 53)) ((67 60 53) (68 61 51) (71 64 45))
      ((71 64 57) (69 62 52)) ((69 62 55) (67 60 50) (68 63 46) (66 64 47))
      ((66 59 52) (62 55 48)) ((74 67 60)) ((74 67 60) (77 67 60))
      ((67 60 53) (68 61 51) (68 61 54) (69 62 52))
      ((69 62 55) (70 63 53) (70 63 56) (71 64 54)) ((71 64 57) (76 62 57))
      ((64 57 50) (67 57 50)) ((69 62 55))
      ((69 62 55) (67 60 50) (68 63 46) (66 64 47))
      ((66 59 52) (60 55 50) (60 55 53)) ((67 60 53) (68 61 51) (71 64 45))
      ((71 64 57) (69 62 52)) ((69 62 55) (67 60 50) (68 63 46) (66 64 47))
      ((66 59 52)) ((66 59 52) (69 59 52))
      ((64 57 50) (67 57 50) (65 58 51) (66 59 49))
      ((73 66 59) (76 66 59) (76 69 59)) ((71 64 57) (69 62 52) (70 60 53))
      ((68 61 54) (69 62 52)) ((69 62 55)) ((69 62 55))
      ((69 62 55) (67 60 50) (68 63 46) (66 64 47)) ((66 59 52))
      ((62 55 48) (62 55 48)) ((74 67 60))
      ((74 67 60) (77 67 60) (75 68 61) (71 69 64)) ((71 64 57))
      ((67 60 53) (68 61 51) (71 64 45)) ((71 64 57))
      ((71 64 57) (69 62 52) (70 60 53)) ((68 61 54) (69 62 52))
      ((64 57 50) (64 57 50)) ((76 69 62))
      ((76 69 62) (79 69 62) (77 70 63) (78 71 61)) ((73 66 59) (74 67 57))
      ((69 62 55) (74 60 55)) ((74 67 60)) ((74 67 60)) ((74 67 60)) ((74 67 60))
      ((74 67 60) (75 68 58)) ((73 66 59) (76 66 59) (76 69 59))
      ((71 64 57) (69 62 52)) ((69 62 55) (67 60 50) (68 63 46) (66 64 47))
      ((66 59 52) (69 59 52)) ((64 57 50) (67 57 50) (65 58 51) (66 59 49))
      ((61 54 47) (62 55 45)) ((62 55 48))))

(events
 (playchds->lines
  (closest-mod-list
   (flatter sbranch2))
  (makecyc
   (transp (code->durs (resclassvec 3 4 7)) .5 #'*)))
 "sbranch2.mid" :play 'nil)

; variation K = 'chorale-ab'

;; K = chorale pits to nearest pit in A major (G becomes G#)

(events
 (playchds->lines
  (mapcar (lambda (x) (tintab x (transp-mode ionian 8)))
	  lanca-pits)
  lanca-durs)
 "chorale-ab.mid" :play 'nil)