;; work on canon for Diapason (March 2005)

(load "nudruz.lisp")
(load "tiling.lisp")
(load "selfsim.lisp")
(load "modes.lisp")
(load "spacegrp.lisp")
(load "nondet.lisp")

;; NOTE: use old version 'cm-2.4.0' for "midi2cs.lisp"
 
; (define cyclops3x8 '(a b c b d e c e))
; 5 members

; for testing
; (define ss3x8
;   (selfsim cyclops3x8 '(0 2 4 5 7) '(9 11 19) '(62 54 47) .45))
; (events ss3x8 "ss3x8.midi")
; 
; (define ssvec3x8
;  (selfsimvec cyclops3x8 '(0 2 4 5 7) '(9 11 19) '(62 54 47)))

(define vec3rpts (reduce #'lcm '(9 11 19)))

; not used
; (define myferncyc (new cycle of (ferney '(1) (strums 10 2 2 1 3 3))))
; (define myfernlist (copylist (ferney '(1) (strums 110 2 2 1 3 3)) 20))

(define (simpl2 pits basedurs)
  (let* ((sd (slots->durs pits))
         (sdpits (first sd))
         (sddurs (second sd)))
    (process for x in sdpits
             for dur in (sum-across basedurs sddurs)
             when (or (numberp x) (listp x))
             output (multievent 'midi :keynum
                                :keynum x
                                :time (now)
                                :duration dur
                                :amplitude (between .4 .6))
             wait dur)))


(define intpick (new random of '(5 7 4 8)))

(defun randdbl (alist rints)
  (loop for x in alist collect
        (if (eql x 'r) 'r (+ x (next rints)))))

(define bscale '(0 1 3 5 7))


;;;;;;;;;;; tonnetz etc.

(load "tonnetz.lisp")

(define tonpits
  (make-poly
   (placereg 
    (loop for x in (tzrandchain '(0 3 7) 100) append (shuffle x))
    (new heap of '(5 4 3 2)))
   (transp (heapvec 100 3) 1)))


; (define myfernlist2 
;  (sum-across 
;   (ferney '(1) (strums 400 2 2 1 3 3))
;   (copylist
;    (shuffle (append '(35) (loop repeat 107 collect (+ 20 (random 5)))))
;    8)))

;; now hardcoded -- 108 atx * 8 sections
(load "myfernlist2.lisp")

; (reduce #'+ myfernlist2) = 7197.6
; (length myfernlist2) = 864

(define (simpl3 pits durs)
  (process for x in pits
           for dur in durs
           when (or (numberp x) (listp x))
           output (multievent 'midi :keynum
                              :keynum x
                              :time (now)
                              :amplitude (between .4 .6)
                              :duration dur)
           wait dur))

;;; 

; (* 8 (reduce #'lcm '(9 11))) = 792

;(define myfern1 
;  (copylist 
;   (ferney 
;    (shuffle (copylist '(1 1.5) 9))
;    (strums 10 2 2 1 2 3)) 20))

;; now hard-coded in....canon length 7192.16 (not including rpt atk at end)
(load "myfern1.lisp")

(define bivscale '(0 2 4 6 7))

(define tonpits2
  (subseq
   (make-poly
    (placereg 
     (loop for x in (tzrandchain '(0 1 3) 100) append (shuffle x))
     (new heap of '(5 4 3 2)))
    (transp (heapvec 100 3) 1)) 0 108))


;; best prototype
(events 
 (list
  (simpl3 tonpits2 myfernlist2)
  (simpl2 (append (s-sim->slots cyclops3x8 bscale 9 63 (/ vec3rpts 9)) '(63)) myfern1)
  (simpl2 (layout .2 
                  (randdbl 
                   (s-sim->slots cyclops3x8 bscale 9 63 (/ vec3rpts 9)) intpick)
                  ) myfern1)
  (simpl2 (append 
           (s-sim->slots cyclops3x8 bivscale 11 55 (/ vec3rpts 11)) '(55)) myfern1)
  ) "tonz2.midi")



;; embed etc.
; (embell-triad '(0 2 4)) etc. for the two "others"? (0 2 4) & (0 2 7)

;(define emb024 (copylist 
;                (shuffle (append (embell-triad '(0 2 4) 4) (list '(0 2 4))))
;        10))
;(define emb027 (copylist 
;                (shuffle (append (embell-triad '(0 2 7) 4) (list '(0 2 7))))
;        10))

;; emb024 & emb027 now hardcoded in tonsembs.lisp


;;; constructing sections
; (loop for x from 0 to 8 collect (* 108 x))
; (0 108 216 324 432 540 648 756 864)

(define mflist2p1 (subseq myfernlist2 0 108))
(define mflist2p2 (subseq myfernlist2 108 216))
(define mflist2p3 (subseq myfernlist2 216 324))
(define mflist2p4 (subseq myfernlist2 324 432))
(define mflist2p5 (subseq myfernlist2 432 540))
(define mflist2p6 (subseq myfernlist2 540 648))
(define mflist2p7 (subseq myfernlist2 648 756))
(define mflist2p8 (subseq myfernlist2 756))



;; section lengths
; (loop for x in '(108 216 324 432 540 648 756) collect
;      (reduce #'+ (subseq myfernlist2 0 x)))
(define secstarts 
  '(0 899.00006 1798.0 2698.6667 3599.4993 4498.999 5397.6646 6296.9976))

(define (tonetzpits trich)
  (subseq
   (make-poly
    (placereg 
     (loop for x in (tzrandchain trich 100) append (shuffle x))
     (new heap of '(5 4 3 2)))
    (transp (heapvec 100 3) 1)) 0 108))

(define (embedpits emblist)
  (subseq 
   (make-poly
    (placereg 
     (transp (flatten emblist) 24)
     (new heap of '(5 4 3 2)))
    (transp (heapvec 100 3) 1)) 0 108))

; = (0 1 6) (0 1 5) (0 3 7) (0 2 5) (0 2 7) (0 1 3) (0 2 4) (0 2 6)

;; fix tonz pits for all runs -- now hardcoded in tonsembs.lisp
;(define tz1 (tonetzpits '(0 1 6)))
;(define tz2 (tonetzpits '(0 1 5)))
;(define tz3 (tonetzpits '(0 3 7)))
;(define tz4 (tonetzpits '(0 2 5)))
;(define embed027 (embedpits emb027))
;(define tz6 (tonetzpits '(0 1 3)))
;(define embed024 (embedpits emb024))
;(define tz8 (tonetzpits '(0 2 6)))

(load "tonsembs.lisp")

;; making master tonz file
(define tonzlist
  (list (append tz1 tz2 tz3 tz4 embed027 tz6 embed024 tz8)
        (append mflist2p1 mflist2p2 mflist2p3 mflist2p4
                mflist2p5 mflist2p6 mflist2p7 mflist2p8)))

; (melint->line 0 (second tonzlist))

;; CREATING MIDI FILES

;; tonetz/embed only
(events 
 (list
  (simpl3 tz1 mflist2p1)
  (simpl3 tz2 mflist2p2)
  (simpl3 tz3 mflist2p3)
  (simpl3 tz4 mflist2p4)
  (simpl3 embed027 mflist2p5)
  (simpl3 tz6 mflist2p6)
  (simpl3 embed024 mflist2p7)
  (simpl3 tz8 mflist2p8))
 "paptonz.midi" secstarts)

; checking
; (reduce #'+ (second (midi-in "paptonz.midi")))

; fix intpick canon voice -- saved in "tonsembs.lisp"
;(define intpickvc
;  (layout .2 (randdbl 
;              (s-sim->slots cyclops3x8 bscale 9 63 (/ vec3rpts 9)) intpick)))

; canon only
(events
 (list
  (simpl2 (append 
           (s-sim->slots cyclops3x8 bscale 9 63 (/ vec3rpts 9)) '(63)) myfern1)
  (simpl2 intpickvc myfern1)
  (simpl2 (append 
           (s-sim->slots cyclops3x8 bivscale 11 55 (/ vec3rpts 11)) '(55)) myfern1)
  ) "papcan.midi")

; checking
; (reduce #'+ (second (midi-in "papcan.midi")))

; both together
(events 
 (list
  (simpl3 tz1 mflist2p1)
  (simpl3 tz2 mflist2p2)
  (simpl3 tz3 mflist2p3)
  (simpl3 tz4 mflist2p4)
  (simpl3 embed027 mflist2p5)
  (simpl3 tz6 mflist2p6)
  (simpl3 embed024 mflist2p7)
  (simpl3 tz8 mflist2p8)
  (simpl2 (append (s-sim->slots cyclops3x8 bscale 9 63 (/ vec3rpts 9)) '(63)) myfern1)
  (simpl2 intpickvc myfern1)
  (simpl2 (append 
           (s-sim->slots cyclops3x8 bivscale 11 55 (/ vec3rpts 11)) '(55)) myfern1))
 "papboth.midi" (append secstarts '(0 0)))



;; now breaking off into subfiles

(events
 (list
  (simpl2 (append 
           (s-sim->slots cyclops3x8 bscale 9 63 (/ vec3rpts 9)) '(63)) myfern1)
  ) "topcan.midi")

(events
 (list
  (simpl2 intpickvc myfern1)
  ) "candbl.midi")

(events
 (list
  (simpl2 (append 
           (s-sim->slots cyclops3x8 bivscale 11 55 (/ vec3rpts 11)) '(55)) myfern1)
  ) "bcan.midi")






;; some notes

(scf bscale cyclops3x8) = (0 1 3 1 5 7 3 7)

(subsequences (scf bscale cyclops3x8) 3) == (0 1 3) (1 5 7)

(subsets-len (scf bscale cyclops3x8) 3) == 
(define cycsubs '((5 3 7) (1 3 7) (1 5 7) 
(1 5 3) (0 3 7) (0 5 7) (0 5 3) (0 1 7) (0 1 3) (0 1 5)))

(loop for x in cycsubs collect (prime-form x))
; tonnetz-able: (0 2 6) (0 3 7)   (0 2 5) (0 1 6)     (0 1 3) (0 1 5)
; others:                    (0 2 4)            (0 2 7)

(define trichs '((0 2 6) (0 3 7) (0 2 5) (0 1 6) (0 1 3) (0 1 5) (0 2 4) (0 2 7)))
; sum               8       10      7       7       4       6       6       9            
; ints          ((2 4 6) (3 4 5) (2 3 5) (1 5 6) (1 2 3) (1 4 5)  (2 4)   (2 5))

;; sorted by sum = 
(define trichs2 '((0 1 3) (0 1 5) (0 2 4) (0 2 5) (0 1 6) (0 2 6) (0 2 7) (0 3 7)))

;; FINAL best path by common interval content:
;     156  -> 145  -> 345  -> 235  -> 25   -> 123  -> 24   -> 246 
; = (0 1 6) (0 1 5) (0 3 7) (0 2 5) (0 2 7) (0 1 3) (0 2 4) (0 2 6)



;;;;ETC .

; CHECKING CANON LENGTH
(define nontonz-durs
  (sum-across myfern1
              (second (slots->durs 
                       (s-sim->slots cyclops3x8 bscale 11 55 (/ vec3rpts 11))))))
(apply #'+ nontonz-durs)

(define nontonz-durs2
  (sum-across myfern1
              (second (slots->durs (s-sim->slots cyclops3x8 bscale 9 63 (/ vec3rpts 9))))))
(apply #'+ nontonz-durs2)



;;;;;;;; scratch, discarded, etc. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; !!!!
(define cyclops5x12 '(a b c d e b f g e h c g))
; 8 members

(define ss5x12
  (selfsim cyclops5x12 '(0 5 10 3 8 1 6 11) '(5 12 17) '(70 63 56) .6))
(events ss5x12 "ss5x12.midi")

(* 12 (reduce #'lcm '(5 12 17)))



;; problem: atkpoints need to be rational in order to coincide


(define papboth (midi-in "diap-in/papboth2.mid"))

(reduce #'+ (second papboth))

(rationalize 0.333)

(melint->line 0 myfern1)

;;;