(load "nudruz.lisp")
(load "selfsim.lisp")
(load "rewrite.lisp")
(load "graphs.lisp")
(load "modes.lisp")
(load "tiling.lisp")
(load "tonnetz.lisp")
(load "spacegrp.lisp")

;; (defun rwgen (rwrules initgen gennbr)
;; 

(define rwferns (copylist (ferney '(1) '(4 3) '(1 1 1 2)) 100))

(defun rwlines (tlevel rules initg gen)
  (let* ((thismel (slots->durs 
                  (randrests (melint->line tlevel
                                           (rwgen rules initg gen)) 162)))
         (durmults (sum-across rwferns (second thismel))))
    (process
      for x in (first thismel)
      for dur in durmults
      when (or (numberp x) (listp x));; needed for rests
      output (multievent 'midi :keynum
                         :keynum x
                         :time (now)
                         :duration dur)
      wait dur)))

(events (list
         (rwlines 40 steprules1 '(-1 1) 1)
         (rwlines 50 steprules1 '(-1 1) 2)
         (rwlines 60 steprules1 '(-1 1) 3)
         (rwlines 70 steprules1 '(-1 1) 4))
        "rwlines.midi")


(defun rwlines2 (tlevel rules initg gen)
  (let* ((thismel (slots->durs 
                  (randrests (melint->line tlevel
                                           (rwgen rules initg gen)) 162)))
         (durmults (sum-across rwferns (second thismel))))
    (process
      for x in (tintab (first thismel) stravmode)
      for dur in durmults
      when (or (numberp x) (listp x));; needed for rests
      output (multievent 'midi :keynum
                         :keynum x
                         :time (now)
                         :duration dur)
      wait dur)))

(events (list
         (rwlines2 40 steprules1 '(-1 1) 1)
         (rwlines2 50 steprules1 '(-1 1) 2)
         (rwlines2 60 steprules1 '(-1 1) 3)
         (rwlines2 70 steprules1 '(-1 1) 4))
        "rwlines2.midi")

;;;;;;;;;;

(defun arp ()
  (process
    for dur in (ferney '(1) (strums 30 3 3 6 13 4))
    for x in (arpegg (transp (heapvec 300 16) 70) '(2 3) '(5 4 7))
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (arp) "arp.midi")

;;;;;;;

(define indxcyc (makecyc (indices 10)))
(define myfern  (ferney '(1) '(4) (strums 15 2 4 5 10)))
(define bigdurs (copylist '(3 4) 10))
(define dkmodes (copylist '(octatonic symmetric6 mlt4 mlt6 stravmode) 10))
(define vbtmodes (valbytime bigdurs dkmodes myfern))

(defun vbt ()
  (process
    for n from 0 to (- (length myfern) 1)
    for dur = (nth n myfern)
    for nowmode = (nth n vbtmodes)
    for x = (car (play-mode (list (next indxcyc)) (eval nowmode) 30))
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (vbt) "vbt.midi")

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

(defun tz ()
  (process
    for durmult in (strums 50 2 5 5 10)
    for dur = (* .25 durmult)            
    for x in (transp (tzrandchain '(5 15 21) 30) 50)
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (tz) "tz.midi")

;;;;;

(defun emb ()
  (process
    for durmult in (strumfit (transp (copylist (indices 10) 4) 5) 4)
    for dur = (* .25 durmult)            
;    for x in (embell-triad '(55 65 71))
    for x in 
    (norpt
     (flatten 
      (loop for q in (shuffle (embell-triad '(55 65 71))) collect
            (shuffle q))))
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (emb) "emb.midi")

;;;;;;;;;;; 

(define ferns (copylist (ferney '(1) '(4 4 3)) 50))

(sum-across ferns (copylist '(3 2) 100))

(define esets
  (sort 
   (matchreg-chds
    (loop for y in (shuffle (embell-triad '(55 65 71) 2)) collect
          (pickl (stack-by y 4))))
   #'lowerchord))

(define ghosts 
  (transp 
   (no-nils (bz-ghosts '(55 65 71) esets)) 12))

(defun emb2 (chdlist)
  (process
    for dur = 2
    for x in chdlist
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (list (emb2 esets)
              (emb2 ghosts)) "emb2.midi")


;;;;;;;; using life

(defun life->slots2 (lifematx)
  (let ((inlist (array->list (cllib:matrix-transpose lifematx))))
    (shufflebymod
     (loop for x to (- (length inlist) 1) collect
           (if (not (set-difference (nth x inlist) '(0))) 'r
               (no-nils (loop for y to (- (length (nth x inlist)) 1) collect
                              (if (= (nth y (nth x inlist)) 1)
                                (+ (mod (* 7 y) 12) 
                                   -24 (* 12 (mod (+ y x) 4))))))))
     7 12)))

(defun life->slots3 (lifematx)
  (let ((inlist (array->list (cllib:matrix-transpose lifematx))))
    (shufflebymod
     (loop for x to (- (length inlist) 1) collect
           (if (not (set-difference (nth x inlist) '(0))) 'r
               (no-nils (loop for y to (- (length (nth x inlist)) 1) collect
                              (if (= (nth y (nth x inlist)) 1)
                                (+ (mod (* 7 y) 12) 
                                   -24 (* 12 (mod (- y x) 4))))))))
     9 16)))

(define tis (rand01array 12 12 .3))
;#2A((0 1 0 0 0 1 1 1 1 0 1 0)
;    (0 0 0 1 1 1 1 0 1 1 0 1)
;    (0 0 1 0 0 0 0 0 1 1 1 1)
;    (0 0 0 1 0 0 0 0 0 0 1 0)
;    (1 0 0 1 0 0 0 0 0 0 0 0)
;    (0 0 0 0 0 0 1 0 1 0 1 0)
;    (0 0 1 1 1 0 1 0 0 0 1 0)
;    (0 0 0 1 0 0 1 0 1 0 1 0)
;    (0 0 0 0 0 0 0 0 0 0 0 0)
;    (0 1 0 1 0 0 0 0 0 0 1 0)
;    (0 1 0 1 0 0 0 0 0 0 0 0)
;    (0 1 0 0 0 1 0 0 0 1 0 1))

;(define tispits
;  (no-nils
;  (transp
;   (loop for x to 7 append
;         (life->slots3 (life2dgen tis x))) 60)))

(define tispits
  '((40) (43 50 65) (38 42) (67 74 41) (55 66) (60 79 83 42 49) (36 55 62 59 73)
    (72 39 58 65) (60 38 57 83 42 49 75) (67 45 52 78 37 63 82) (55)
    (76 47 61 80 65) (60 79 38 57 83 42 49 68) (48 67 74 52 71 78)
    (55 59 66 73 70 77) (42) (62 77) (58 65) (57 42 46 53) (67 45 78 37)
    (55 62 59 77) (72 69 76 47 54 61 65) (60 79 57 64 83 68 53)
    (48 67 74 45 52 71 78 41) (55 40 59 44 70 77) (83 49)
    (36 81 40 59 73 44 70 77) (54 61 65) (79 38 57 46 53) (45 41) (73 70 77)
    (61 80 39) (38 57 64 83 42 49 46 53) (71 78) (40 59 66 51) (83 49 53)
    (36 81 44 70) (69 54 61 58 65) (49 46) (67 45 63) (59 73 70 77) (61 58 65)
    (60 83 49 68 75 53) (78 37 82 41) (40 59 66 73) (60 49 53) (70 77)
    (72 50 69 80 39) (49 75) (37 56 63) (36 73) (80 39 65) (60 79 42 53)
    (37 63 41) (59) (42 49) (73) (72 43 76) (49 75) (52 63 82) (36 55 44 77)
    (61 39 58) (79 83 46 53) (78 37 82) (40 59 66 51) (75 46 53) (73 70) R (49 75)
    (48 71 82 41) (36 73 77) (54 61 39 58) (46) (48 78 37 63 82 41) (36 40)
    (46 53) (44 51 70) (43 58) (49 75) (48 63)))

(define tis2 (rand01array 17 12 .15))

(define tispits2
  (no-nils
  (transp
   (loop for x to 7 append
         (life->slots3 (life2dgen tis2 x))) 60)))


(define myfern (makecyc (ferney '(1) '(4 3 3) '(2 1 1 1))))
; (define fernlist (next myfern 100))

(define fernlist 
  '(0.5 0.25 0.25 0.33333334 0.6666667 0.33333334 0.33333334 0.33333334 0.5 0.25
    0.25 0.33333334 0.6666667 0.33333334 0.33333334 0.33333334 0.5 0.25 0.25
    0.33333334 0.6666667 0.33333334 0.33333334 0.33333334 0.5 0.25 0.25 0.33333334
    0.6666667 0.33333334 0.33333334 0.33333334 0.5 0.25 0.25 0.33333334 0.6666667
    0.33333334 0.33333334 0.33333334 0.5 0.25 0.25 0.33333334 0.6666667 0.33333334
    0.33333334 0.33333334 0.5 0.25 0.25 0.33333334 0.6666667 0.33333334 0.33333334
    0.33333334 0.5 0.25 0.25 0.33333334 0.6666667 0.33333334 0.33333334 0.33333334
    0.5 0.25 0.25 0.33333334 0.6666667 0.33333334 0.33333334 0.33333334 0.5 0.25
    0.25 0.33333334 0.6666667 0.33333334 0.33333334 0.33333334 0.5 0.25 0.25
    0.33333334 0.6666667 0.33333334 0.33333334 0.33333334 0.5 0.25 0.25 0.33333334
    0.6666667 0.33333334 0.33333334 0.33333334 0.5 0.25 0.25 0.33333334))

(defun tismid ()
  (process
    for dur in fernlist
    for x in tispits
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (tismid) "tismid8.midi")

;;;;;;;
(defun tismid2b ()
  (process
    for dur in fernlist
    for x in tispits2
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (tismid2b) "tismid2b.midi")



;;;;

(define tis3 (rand01array 17 12 .2))

(defun life->slots4 (lifematx)
  (let ((inlist (array->list (cllib:matrix-transpose lifematx))))
    (shufflebymod
     (loop for x to (- (length inlist) 1) collect
           (if (not (set-difference (nth x inlist) '(0))) 'r
               (no-nils (loop for y to (- (length (nth x inlist)) 1) collect
                              (if (= (nth y (nth x inlist)) 1)
                                (+ (mod (* 7 y) 12) 
                                   -24 (* 12 (mod (- y x) 4))))))))
     5 17)))


(define tispits3
  (no-nils
  (transp
   (loop for x to 7 append
         (life->slots4 (life2dgen tis3 x))) 60)))


(defun tismid2c ()
  (process
    for dur in fernlist
    for x in tispits3
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (tismid2c) "tismid2c.midi")

;; and more runs ...
(events (tismid2c) "tismid2d.midi")

(events (tismid2c) "tismid2e.midi")

(events (tismid2c) "tismid2f.midi")



;;;;;

;(define tischds 
;  (no-nils
;   (loop for x in tispits collect 
;         (if (and (listp x) (> (length x) 2)) x))))

(define tischds
  ' ((43 50 65) (67 74 41) (60 79 83 42 49) (36 55 62 59 73) (72 39 58 65)
     (60 38 57 83 42 49 75) (67 45 52 78 37 63 82) (76 47 61 80 65)
     (60 79 38 57 83 42 49 68) (48 67 74 52 71 78) (55 59 66 73 70 77)
     (57 42 46 53) (67 45 78 37) (55 62 59 77) (72 69 76 47 54 61 65)
     (60 79 57 64 83 68 53) (48 67 74 45 52 71 78 41) (55 40 59 44 70 77)
     (36 81 40 59 73 44 70 77) (54 61 65) (79 38 57 46 53) (73 70 77) (61 80 39)
     (38 57 64 83 42 49 46 53) (40 59 66 51) (83 49 53) (36 81 44 70)
     (69 54 61 58 65) (67 45 63) (59 73 70 77) (61 58 65) (60 83 49 68 75 53)
     (78 37 82 41) (40 59 66 73) (60 49 53) (72 50 69 80 39) (37 56 63) (80 39 65)
     (60 79 42 53) (37 63 41) (72 43 76) (52 63 82) (36 55 44 77) (61 39 58)
     (79 83 46 53) (78 37 82) (40 59 66 51) (75 46 53) (48 71 82 41) (36 73 77)
     (54 61 39 58) (48 78 37 63 82 41) (44 51 70)))

(define mylongfern (makecyc (ferney '(1) '(4 3 3) '(15 14 14 14))))

(define longfern (next mylongfern 100))

(defun tischds1 ()
  (process
    for dur in longfern
    for x in tischds
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (tischds1) "tischds1.midi")

;;; 

(define tzmel
  (transp   
   (norpt  (arpegg 
            (flatten (tzrandchain '(43 50 65) 20))
            '(3 2) '(7 4 3 5 4)))
   24))

(defun tzmelmid ()
  (process
    for dur = (next myfern)
    for x in tzmel
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (tzmelmid) "tzmelmid.midi")

;;; a variation using '(54 61 65))

(define myfern2 (makecyc (ferney '(2 3) '(4 4 4 3) '(5 5 4))))

(define myf2 (next myfern2 100))

; (define tzmchd2
;   (matchreg-chds (loop for x in (subsequences '(67 45 52 78 37 63 82) 3)
;                        append (tzrandchain x 10))))

(define tzmchd2 '((67 45 52) (45 52 66) (49 52 66) (49 52 71) (50 52 71) (50 57 71) (54 57 71)
 (54 56 71) (54 56 75) (54 61 75) (57 64 78) (57 64 79) (62 64 79) (62 64 83)
 (61 64 83) (61 64 78) (61 63 78) (61 63 82) (61 68 82) (61 68 83) (61 64 78)
 (61 63 78) (56 63 78) (56 59 78) (56 59 73) (52 59 73) (52 54 73) (52 54 69)
 (47 54 69) (47 50 69) (49 51 66) (44 51 66) (44 51 65) (48 51 65) (48 50 65)
 (43 50 65) (43 46 65) (43 46 60) (39 46 60) (39 41 60) (37 39 58) (36 39 58)
 (36 39 53) (32 39 53) (32 39 54) (37 39 54) (37 40 54) (33 40 54) (33 35 54)))

(define tzmghosts (bz-ghosts '(43 46 65) tzmchd2))

(defun tzmelmid2 (inpits)
  (process
    for dur in myf2
    for x in inpits
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (tzmelmid2 tzmchd2) "tzmelmid2.midi" )



;;; 

(defun ebt ()
  (process
    for dur = (pick .25 .5)
    for x in (flatten (shuffle (embell-triad '(67 74 41))))
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (ebt) "ebt.midi")


;;;;; ebt3 -- a variation



(define tistriads
  (let ((tris
         (flatten   
          (transp 
           (matchreg-chds 
            (sort-every (make-poly 
                         (norests (flatten tispits)) '(3)))) 12))))
    (consmatch (flatten tispits)
    (make-poly 
     (loop for x to 283 collect
           (nth x tris)) (strums 4 2 2 2 6)))))


(defun ebt3 ()
  (process
    for dur = (pick .25 .5)
    for x in tistriads
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (ebt3) "ebt3.midi")

;;; 

(define tis4
  (myhand
   (myhand
    (transp (flatten 
             (let ((list4s (no-nils
                            (loop for x in tischds collect
                                  (if (= (length x) 4) x)))))
               (loop for x in list4s collect (give-contour-to-mel '(0 2 1 3) x)))) -12)
    -5 10 'end)
   -12 7 'end))

(define tis4b
  (merge-slots (list tis4
                     (layout .4 (transp (tintab tis4 stravmode) 7)))))

(defun ebt4 ()
  (process
    for x in tis4b
    for dur = (* .25 (if (numberp x) 1 (length x)))
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (ebt4) "ebt4.midi")


;; 


(define fernstrum
    (cdr (strums 10 8 8 5 10 4)))

(defun sb ()
  (process
    for dur in fernstrum
    for x in (transp (matchreg-chds tischds) 24)
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (sb) "sb.midi")


;;; 

(define tis4 (nth 4 tischds)) ; (72 39 58 65)

(loop for x in tispits collect
      (reorder-by-melint (mod12 x) 5))

(chdinv-up (safesort tis4))



;;; 
(define tis3mel
  (flatten (loop for x in (norests tispits3) collect
                 (pickl (reorder-by-melint x 5)))))


(define t3polymel (make-poly tis3mel '(3 1 2 1)))

(defun t3mel ()
  (process
    for dur in (transp (strums 30 2 5 3 8) .25 #'*)
    for x in t3polymel
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (t3mel) "t3mel.midi")


(define t4stack (stack-by 
                 (make-poly (flatten tis4) '(5))
                 5))

;;; 

(define npits1 
  (make-poly 
   (norpt (flatten (map 'list #'shuffle 
                        (tzrandchain '(60 61 66) 30)))) '(2 1)))

(define arhyts1
  (car
   (transp (cdr 
            (slots->durs 
             (code->slots 
              (flatten (rw-gens (auto-1d 15) 50)) npits1))) .25 #'*)))

(define npits2
  (make-poly 
   (norpt (flatten (map 'list #'shuffle 
                        (tzrandchain '(41 42 47) 30)))) '(2 1 1)))
(define arhyts2
  (car
   (transp (cdr 
            (slots->durs 
             (code->slots 
              (flatten (rw-gens (auto-1d 17) 50)) npits2))) .25 #'*)))

(define npits3
   (norpt (flatten (map 'list #'shuffle 
                        (tzrandchain '(41 42 47) 30)))))

(define ar3d (ferney '(1) (strums 30 4 4 3 7 3)))

(define arhyts3
  (sum-across ar3d
  (car
   (cdr 
            (slots->durs 
             (code->slots 
              (flatten (rw-gens (auto-1d 17 '(3 5 8 10 13)) 50)) npits3))))))

(define arhyts4
  (sum-across ar3d
  (car
   (cdr 
            (slots->durs 
             (code->slots 
              (flatten (rw-gens (auto-1d 17 '(1 2 4 7 11 12 15)) 50)) npits3))))))


(define autodlist
(car 
  (cdr 
   (slots->durs 
    (code->slots 
     (flatten (rw-gens (auto-1d 17) 50)) npits3)))))

; ????? UNSTRUM -- coalescing 1's in a list
(defun unstrum (alist)
  (loop for x to (- (length alist) 1) collect
        (if (eql (nth x alist) 1) 'nil
            (cons (nth x alist)
            (loop for y from x 

(defun nov1 (p r)
  (process
    for dur in r
    for x in p
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (list (nov1 npits1 arhyts1)
              (nov1 npits2 arhyts2))"nov1.midi")

(events (list (nov1 npits1 arhyts1)
              (nov1 npits3 arhyts3)) "nov2.midi")

(consmatch (topline npits2) npits3)


(events
 (list 
  (nov1 (replace-intv (transp npits3 32) 6 5) arhyts4)
  (nov1 (layout .7 (make-poly (transp npits3 19) (strums 20 2 2 4 8))) ar3d)
  (nov1 (myhand npits3 -6 17) arhyts3)) "nov3.midi")

;;;;

(define pits6 '(0 2 4 6 7 9))

(slots->durs 
(s-sim->slots cyclops5x8 pits6 5 60 8))

(events (selfsim cyclops3p5x14 '(60 62 63 65) '(1 3 5) '(0 -7 -14) .25)
        "newselfsim.midi")


(defun ss (rate tlevel rpts)
  (let* ((ssvec (s-sim->slots cyclops5x8 '(0 2 4 6 7 9) rate tlevel rpts))
        (sspits (first (slots->durs ssvec)))
        (ssdurs (transp (second (slots->durs ssvec)) .25 #'*)))
  (process
    for dur in ssdurs
    for x in sspits
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur)))

(events (list (ss 5 60 (* 8 17))
              (ss 8 53 (* 5 17))
              (ss 17 46 (* 8 5))) "ss.midi")

;;
(defun ss2 (rate tlevel rpts)
  (let* ((ssvec (s-sim->slots cyclops3p5x22 '(0 2 4 5 7 9) rate tlevel rpts))
        (sspits (first (slots->durs ssvec)))
        (ssdurs (transp (second (slots->durs ssvec)) .25 #'*)))
  (process
    for dur in ssdurs
    for x in sspits
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur)))

(events (list (ss2 3 60 (* 5 22))
              (ss2 5 40 (* 3 22)))
        "ss2.midi")


;;;

(define myscf (scf '(0 2 4 5 7 9) cyclops3p5x22))

(holes '(40 50 51))

(subsequences myscf 5)

;; stravmode variation

(defun ss2b (rate tlevel rpts)
  (let* ((ssvec (s-sim->slots cyclops3p5x22 '(0 2 4 5 7 9) rate tlevel rpts))
        (sspits (tintab (first (slots->durs ssvec)) stravmode))
        (ssdurs (transp (second (slots->durs ssvec)) .25 #'*)))
  (process
    for dur in ssdurs
    for x in sspits
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur)))

(events (list (ss2b 3 60 (* 5 22))
              (ss2b 5 50 (* 3 22))
              (ss2b 22 40 (* 3 5))) "ss2b.midi")


;;;;

(defun ss3 (rate tlevel rpts)
  (let* ((ssvec (s-sim->slots cyclops6x7 '(0 2 4 6) rate tlevel rpts))
        (sspits (first (slots->durs ssvec)))
        (ssdurs (transp (second (slots->durs ssvec)) .25 #'*)))
  (process
    for dur in ssdurs
    for x in sspits
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur)))

(events (list (ss3 6 (+ 55 12) 7)
              (ss3 7 (+ 48 12) 6))
        "ss3.midi")

;; 

(define smode
    (make-poly
    (play-mode (norpt (transp (heapvec 300 25) 25)) stravmode)
  '(1 2)))

(define fndurs (makecyc (ferney '(2 3) '(3 4) '(1 1 1 2 1 3))))

(defun smo ()
  (process
    for dur = (next fndurs)
    for x in smode
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))


(events (smo) "smo.midi")

;;;;

(define tzm5 (tzrandchain '(43 50 65) 10))
(define tzm5pits (loop for x in tzm5 collect (pickl x)))
(define initdurs (loop repeat 50 collect (transp (random 4) 5)))
(define tzwig
  (wigline tzm5pits initdurs '(5 -7 2 -1)))
(define bigfern5 (ferney '(1) (strums 50 3 3 5 10 4)))

(defun tz5m (pits durs)
  (process
    for dur in (sum-across bigfern5 durs)
    for x in (transp pits 12)
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (list
         (tz5m (first tzwig) (second tzwig))
         (tz5m tzm5 initdurs)
         ) "tz5m.midi")

(define tzm5b (tzrandchain '(43 50 64) 20))
(define tzm5bpits (topline tzm5b))
(define initdursb (loop repeat 50 collect (transp (random 4) 5)))
(define tzwigb
  (wigline tzm5bpits initdursb '(5 -7 2 -1)))
(define bigfern5b (ferney '(1) (strums 50 3 3 5 10 4)))

(events (list
         (tz5m (first tzwigb) (second tzwigb))
         (tz5m tzm5b initdursb)
         ) "tz5mb.midi")

(define tzwigc (wigline tzm5bpits initdursb '(5 -7 2)))

(events (list
         (tz5m (first tzwigc) (second tzwigc))
         (tz5m (myhand tzm5b -4 -6) initdursb)
         ) "tz5mc.midi")

(events (list
         (tz5m (first tzwigc) (second tzwigc))
         (tz5m (myhand tzm5b -4 -6) initdursb)
         ) "tz5mc2.midi")

(events (list
         (tz5m (first tzwigc) (second tzwigc))
         (tz5m (myhand tzm5b -4 -6 'end) initdursb)
         ) "tz5mc3.midi")


(define dnbass (transp (reverse (indices 12)) 30))
(define tzm5d (consmatch dnbass (tzrandchain '(43 51 64) 20)))
(define tzm5dpits (topline tzm5d))
(define initdursd (loop repeat 40 collect (transp (random 5) 5)))
(define tzwigd
  (wigline tzm5dpits initdursd '(5 -7 -3 2)))
(define bigfern5d (ferney '(1) (strums 70 3 3 3 7 4)))

(defun tz5md (pits durs)
  (process
    for dur in (sum-across bigfern5d durs)
    for x in (transp pits 12)
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (list
         (tz5md (first tzwigd) (second tzwigd))
         (tz5md (myhand tzm5d -4 -6 'start) initdursd)
         ) "tz5md.midi")

;;;;;;;;;;

(stack-by 
 (make-poly (first tzwigd) '(6)) 5)

;;;;;;;;;;

(define ma (new mode :degrees '(g a bf c d f)))
(define mb (new mode :degrees '(g af bf c ef f)))
(define mc (new mode :degrees '(af bf c df ef f)))
(define md (new mode :degrees '(g a b c e f)))
(define me (new mode :degrees '(g a b d e fs)))
(define mf (new mode :degrees '(fs a b cs d e)))
(define mg (new mode :degrees '(g a bf c d e)))
(define mh (new mode :degrees '(fs as b cs ds e)))
(define mi (new mode :degrees '(gf bf c d ef f)))
(define mj (new mode :degrees '(gf af bf df ef f)))
(define mk (new mode :degrees '(g bf c df ef f)))

(define mcyc 
  (new cycle of
       '(ma mb mc ma mc mb ma md me mf mg mb mc ma mb
         mc ma me mf mh mi mj mk mc ma md mf)))

; (valbytime changedurs vals durs)

(define mdurs (copylist (ferney '(1) '(4 4 3)) 500))
(define mcdurs (loop repeat 500 collect (pickl '(3 4))))


(define randtexture
  (make-poly (transp (heapvec 3000 48) 36) '(1 3 2 4)))

(define mvals
(valbytime mcdurs (next mcyc (length mdurs)) mdurs))

(define valpits
  (loop for x to (- (length randtexture) 1) collect 
        (tintab (nth x randtexture) (eval (nth x mvals)))))


(defun modey ()
  (process
    for dur in mdurs
    for x in valpits
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (modey) "modey.midi")

;;;;;;;;


(defun sbsq-ctr (alist)
  (flatten
  (let* ((sr (stravrot alist))
         (ctr (take-contour alist))
         (sbq (subsequences sr (length alist))))
    (loop for x in sbq collect
          (give-contour-to-mel ctr x)))))

; (define myvec (heapvec 5 12))
(define myvec '(3 5 9 1 6))

(eql-summer 11 '(2 1 3 7))

(define sanums 
  (let ((sum11 (eql-summer 11 '(2 1 3 7))))
    (loop repeat 7 append
          (shuffle (pickl sum11)))))

(define nbfern (ferney '(1) '(4 3 3)))


(defun stax ()
  (process
    for dur in (sum-across nbfern sanums)
    for x in (transp (sbsq-ctr (heapvec 5 12)) 60)
    when (or (numberp x) (listp x));; needed for rests
    output (multievent 'midi :keynum
                       :keynum x
                       :time (now)
                       :duration dur)
    wait dur))

(events (stax) "stax.midi")