;; SELFSIM.LISP
;; making self-similar canons with cyclops.lisp and scf (nudruz.lisp)

;; Drew Krause, 2004
;; drkrause@mindspring.com
;; www.wordecho.org

(load "cyclops.lisp")

;; S-SIM -- defines a (motoric) midi selfsim stream
;; January 2006: ties used by default
;; [setting non-nil 'no-ties' will return repeated notes instead]
(defun s-sim (melody pits rate tlevel rpts 
                      &optional (basedur 1) (no-ties nil))
  (if no-ties
      (splay (copylist (scf (transpose pits tlevel) melody) rpts) 
             (* basedur rate))
      (let ((blist (scf (transpose pits tlevel) melody)))
        (splay (copylist (norpt blist) rpts)
               (copylist (transp (tievec blist) (* basedur rate) #'*)
                         rpts)))))

;; SELFSIM -- constructs a set of midi selfsim streams
(defun selfsim (melody pits rates transpvec 
                       &optional (basedur 1) (no-ties nil))
  (let ((rptlen (reduce #'lcm rates)))
    (loop for n to (- (length rates) 1) collect
          (s-sim melody pits (nth n rates) (nth n transpvec)
                 (/ rptlen (nth n rates)) basedur no-ties))))

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

;; S-SIM->SLOTS -- defines a (slotted) selfsim stream
;; ... like s-sim, but makes slot vector
(defun s-sim->slots (melody pits rate transp rpts)
  (let ((durs (loop repeat (length melody) collect rate))
        (scfmel (scf pits melody)))
    (flatten (loop repeat rpts collect
          (durs->slots
           (flatten
            (mapcar (lambda (x) (+ x transp)) scfmel))
           (flatten durs))))))

;; SELFSIMVEC -- constructs slotted selfsim pitch list
(defun selfsimvec (melody pits rates transpvec)
  (let ((rptlen (reduce #'lcm rates)))
    (merge-slots (loop for n to (- (length rates) 1) collect
          (s-sim->slots melody pits (nth n rates) (nth n transpvec)
                 (/ rptlen (nth n rates)))))))

;; SSIM-ATKLEN -- computes length of ssim vector, from mel & rates
(defun ssim-atklen (mel rates)
  (* (length mel)  
     (apply #'lcm rates)))

;; SSIM-TOTALEN -- computes total length of ssim in minutes
(defun ssim-totalen (mel rates &optional (basedur .25))
  (round
   (/ (ssim-atklen mel rates)
      (* (/ 1 basedur) 60))))

;; SSIM? -- testing self-similarity
(defun ssim? (mel rate)
  (let ((lenmel (length mel)))
    (seq-eql mel
	     (butlast (loop for n to (* rate lenmel) by rate collect 
			    (nth (mod n lenmel) mel))))))

;; SSIM-SPEEDS -- returns all rates of self-replication (up to length)
(defun ssim-speeds (mel)
  (no-nils
   (loop for n from 2 to (- (length mel) 1) collect
	 (if (ssim? mel n) n))))

;; TIES? -- does a melody contain ties?
(defun ties? (mel)
  (member 't 
	  (map 'list #'eql mel (cdr mel))))