; Chordal 3

(init-rnd 0.4153)

(setq sMaterial '((a c d e d c e d b a)))
(setq rMaterial '((1/2 1/4 1/2. 1/2 1/4 1/2. 1/2 1/4 1/4 1/2)))
(setq rMaterial '((1/2 1/2 1/2 1/2 1/2 1/2 1/2 1/2 1/2 1/2)))

(setq sMaterial (flatten (symbol-repeat 10 sMaterial)))
(setq rMaterial (flatten (symbol-repeat 10 rMaterial)))

(setq sTransMat (symbol-repeat (length sMaterial) '((2 4 7))))
(setq sTransMat2 (do-section :all '(symbol-shuffle x) sTransMat))
(setq sTransV3 (do-section :all '(nth 0 x) sTransMat2))
(setq sTransV2 (do-section :all '(nth 1 x) sTransMat2))
(setq sTransV1 (do-section :all '(nth 2 x) sTransMat2))

(setq sTransV1 (substitute 0 7 sTransV1))
(setq sTransV2 (substitute 0 7 sTransV2))

(setq sMaterialV1 (s-transpose sTransV1 sMaterial))
(setq sMaterialV2 (s-transpose sTransV2 sMaterial))
(setq sMaterialV3 (s-transpose sTransV3 sMaterial))

(setq sMaterialV1b (symbol-repeat 4 sMaterialV1))
(setq sMaterialV1c (symbol-divide 4 nil nil sMaterialV1b))
(setq sMaterialTrans (symbol-repeat (length sMaterialV1c) '((0 2 4 3))))
(setq sMaterialTransb (do-section :all '(symbol-shuffle x) sMaterialTrans))
(setq sMaterialV1d (s-transpose (flatten sMaterialTransb) (flatten sMaterialV1c)))
(setq rMaterialV1b (length-repeat 4 rMaterial))

(setq oTransMat (symbol-repeat (length sMaterial) '((1 2 4 8))))
(setq oTransMat (symbol-repeat 5 '((1 1 1 2 2 4 8))))
(setq oTransMat2 (do-section :all '(symbol-shuffle x) oTransMat))
(setq oTransMat2 (symbol-repeat 20 oTransMat2))

(setq sTransV4 (do-section :all '(nth 0 x) oTransMat2))
(setq sTransV3 (do-section :all '(nth 1 x) oTransMat2))
(setq sTransV2 (do-section :all '(nth 2 x) oTransMat2))
(setq sTransV1 (do-section :all '(nth 3 x) oTransMat2))

(setq sMaterialV1b (g-repeat sTransV1 sMaterialV1))
(setq sMaterialV2b (g-repeat sTransV2 sMaterialV2))
(setq sMaterialV3b (g-repeat sTransV3 sMaterialV3))
(setq sMaterialV4b (g-repeat sTransV4 sMaterial))

(setq rMaterialV1b (length-repeat-l sTransV1 rMaterial))
(setq rMaterialV2b (length-repeat-l sTransV2 rMaterial))
(setq rMaterialV3b (length-repeat-l sTransV3 rMaterial))
(setq rMaterialV4b (length-repeat-l sTransV4 rMaterial))
	
(setq sMaterialTransV1 (symbol-repeat (length sMaterialV1c) '((2 4 3))))
(setq sMaterialTransV1b (do-section :all '(symbol-shuffle x) sMaterialTransV1))
(setq sMaterialTransV1c (do-section :all '(append '(0) x) sMaterialTransV1b))
(setq sMaterialTransV2 (symbol-repeat (length sMaterialV1c) '((1 2 3))))
(setq sMaterialTransV2b (do-section :all '(symbol-shuffle x) sMaterialTransV2))
(setq sMaterialTransV2c (do-section :all '(append '(0) x) sMaterialTransV2b))
(setq sMaterialTransV3 (symbol-repeat (length sMaterialV1c) '((2 3 4))))
(setq sMaterialTransV3b (do-section :all '(symbol-shuffle x) sMaterialTransV3))
(setq sMaterialTransV3c (do-section :all '(append '(0) x) sMaterialTransV3b))
(setq sMaterialTransV4 (symbol-repeat (length sMaterialV1c) '((1 4 3))))
(setq sMaterialTransV4b (do-section :all '(symbol-shuffle x) sMaterialTransV3))
(setq sMaterialTransV4c (do-section :all '(append '(0) x) sMaterialTransV4b))

;; need to: trim transposition material to lengths of sMaterialV-b
(setq tLensV1 (collect-items sTransV1 sMaterialTransV1c))
(setq tLensV2 (collect-items sTransV2 sMaterialTransV2c))
(setq tLensV3 (collect-items sTransV3 sMaterialTransV3c))
(setq tLensV4 (collect-items sTransV4 sMaterialTransV4c))



(setq sMaterialTransV1d (s-transpose (flatten tLensV1) (flatten sMaterialV1b)))
(setq sMaterialTransV2d (s-transpose (flatten tLensV2) (flatten sMaterialV2b)))
(setq sMaterialTransV3d (s-transpose (flatten tLensV3) (flatten sMaterialV3b)))
(setq sMaterialTransV4d (s-transpose (flatten tLensV4) (flatten sMaterialV4b)))



(def-tonality
  v1 (activate-tonality (phrygian e 5))
  v2 (activate-tonality (phrygian e 4))
  v3 (activate-tonality (phrygian e 3))
  v4 (activate-tonality (phrygian e 3))
)

(def-symbol
 v1 (flatten sMaterialTransV1d)
 v2 (flatten sMaterialTransV2d)
 v3 (flatten sMaterialTransV3d)
 v4 (flatten sMaterialTransV4d)
)

(def-length
 v1 (flatten rMaterialV1b)
 v2 (flatten rMaterialV2b)
 v3 (flatten rMaterialV3b)
 v4 (flatten rMaterialV4b)
)

(def-zone
 v1 (make-zone (get-lengths-of 'v1))
 v2 (make-zone (get-lengths-of 'v2))
 v3 (make-zone (get-lengths-of 'v3))
 v4 (make-zone (get-lengths-of 'v4))
)

(def-velocity
 v1 (vector-round 40 64 (gen-noise-white (length (flatten sMaterial))))
 v2 (vector-round 40 64 (gen-noise-white (length (flatten sMaterial))))
 v3 (vector-round 40 64 (gen-noise-white (length (flatten sMaterial))))
 v4 (vector-round 40 64 (gen-noise-white (length (flatten sMaterial))))
)

(def-channel
 v1 1
 v2 2
 v3 3
 v4 4 
)

(def-program gm-sound-set
 v1 violin
 v2 reed-organ
 v3 cello
 v4 reed-organ
)

(def-tempo 30)

(compile-instrument-p "ccl;output:" "Chds3b"
   v1
   v2
   v3
   v4
)