;; samba-sheila.lisp
;; by Matt Wright, 3/3/4

(setq *global-amp* 0.5)

;; Vaguely surdo-like sounds

(defun guh (time dur)
  (singer time (* .3 *global-amp*)
	  `((,(* 0.1 dur) ggg.shp lowbass.glt 203.0 0.9 0.0 .01)
	    (,(* 0.9 dur) uhh.shp lowbass.glt 203.0 0.6 0.0 .01))))

(defun dik (time nominal-dur)
  (let ((dur (min nominal-dur 0.3)))
    (singer time (* .375 *global-amp*)
	    `((,(* 0.1 dur) ddd.shp lowbass.glt 163.0 0.8 0.4 .01)
	      (,(* 0.4 dur) ihh.shp lowbass.glt 173.0 0.6 0.0 .01)
	      (,(* 0.4 dur) ihh.shp lowbass.glt 183.0 0.5 0.0 .01)
	      (,(* 0.1 dur) kk+.shp lowbass.glt 193.0 0.3 0.01 .01) ))))

(defun doom (time dur)
  (singer time (* .375 *global-amp*)
	  `((,(* 0.05 dur) bb2.shp lowbass.glt 123.0 0.9 0.2 .01)
	    (,(* 0.05 dur) bb2.shp lowbass.glt 123.0 0.9 0.2 .01)
	    (,(* 0.05 dur) uuu.shp lowbass.glt 113.0 0.6 0.0 .01)
	    (,(* 0.7 dur) uuu.shp lowbass.glt 103.0 0.2 0.0 .01)
	    (,(* 0.15 dur) mmm.shp lowbass.glt 103.0 0.2 0.0 .01) )))


;; Vaguely bell-like sounds

(defun doot (time dur)
  (singer time (* .225 *global-amp*)
	  `((,(* 0.1 dur) ddd.shp test.glt 400.0 0.9 0.0 .01)
	    (,(* 0.6 dur) ooo.shp test.glt 400.0 0.6 0.0 .01)
	    (,(* 0.1 dur) tt+.shp test.glt 400.0 0.6 0.0 .01) )))

(defun deet (time dur)
  (singer time (* .225 *global-amp*)
	  `((,(* 0.1 dur) ddd.shp test.glt 566.0 0.9 0.0 .01)
	    (,(* 0.6 dur) ee-.shp test.glt 566.0 0.6 0.0 .01)
	    (,(* 0.1 dur) tt+.shp test.glt 566.0 0.6 0.0 .01) )))



;; Snare

(defun ta (time nominal-duration)
  (let ((dur (min nominal-duration 0.1))
	(freq (+ 490 (random 30))))
    (singer time (* .19 *global-amp*)
	    `(( ,(* 0.1 dur) tt+.shp test.glt ,freq 0.6 0.4 .01)
	      ( ,(* 0.1 dur) tt+.shp test.glt ,freq 0.6 0.4 .01)		      
	      (, (* 0.8 dur) dhh.shp test.glt ,freq 0.6 0.4 .01) ))))

(defun ka (time nominal-duration)
  (let ((dur (min nominal-duration 0.1))
	(freq (+ 490 (random 30))))
    (singer time (* .11 *global-amp*)
	    `(( ,(* 0.1 dur) kkk.shp test.glt ,freq 0.6 0.4 .01)
	      ( ,(* 0.1 dur) kkk.shp test.glt ,freq 0.6 0.4 .01)
	      (, (* 0.8 dur) dhh.shp test.glt ,freq 0.6 0.4 .01) ))))



;; Repique

(defun tak (time nominal-duration)
  (let ((dur (min nominal-duration 0.2))
	(freq (+ 840 (random 40))))
    (singer time (* .3 *global-amp*)
	    `(( ,(* 0.1 dur) tt+.shp test.glt ,freq 0.6 0.6 .01)
	      ( ,(* 0.1 dur) tt+.shp test.glt ,freq 0.6 0.6 .01)		      
	      (, (* 0.6 dur) aww.shp test.glt ,freq 0.6 0. .01)
	      (, (* 0.1 dur) kk+.shp lowbass.glt ,freq 0.3 0.01 .01) ))))



;; It seems impossible to make Sheila sing my favorite syllable:

(defun goozh (time duration)
  (let ((g-dur (* duration 0.06))
	(uh-dur (* duration 0.03))
	(gliss-dur (* duration 0.39))
	(ooo-dur (* duration 0.3))
	(jjj-dur (* duration 0.2))
	(sh-dur (* duration 0.05))
	(h-dur (* duration 0.05)))
  (singer time (* .8 *global-amp*)
	  `((,g-dur ggg1.shp lowbass.glt 233.0 0.95 0.0 .01)
	    (,uh-dur uhh.shp lowbass.glt 233.0 0.8 0.0 .01)
	    (,gliss-dur uuu.shp lowbass.glt 223.0 0.8 0.0 .01) 
	    (,ooo-dur uuu.shp lowbass.glt 220.0 0.8 0.0 .01) 
	    (,jjj-dur jjj.shp lowbass.glt 218.0 1.0 0.1 .0)
	    (,sh-dur shh.shp lowbass.glt 215.0 0.8 0.01 .01)
	  ; (,h-dur hhh.shp lowbass.glt 215.0 0.8 0.01 .01) 
	    ))))



(defun test-shape (shape)
  (singer 0.(*  1 *global-amp*)
	  `((0.1 ,shape loud.glt 200. 0.8 0. .01)
	    (1.0 ,shape loud.glt 200. 0.8 0. .01))))


;; Play arbitrary lists of syllables and rhythmic durations

(defun play-list (time l)
  (loop for note in l do
    (let ((function-name (first note))
	  (dur (rhythm (second note))))
      (funcall (symbol-function function-name) time (* 0.9 dur))
      (setq time (+ time dur)) )))


;; Some samba rhythms 

(defun surdo-4bars (time)
  (play-list time '((dik e.) (guh s) (doom e.) (guh s) (dik e.) (guh s) (doom e.) (guh s)
		    (dik e.) (guh s) (doom e.) (guh s) (dik e.) (guh s) (doom e.) (guh s)
		    (dik e.) (guh s) (doom e.) (guh s) (dik e.) (guh s) (doom e.) (guh s)
		    (dik e.) (guh s) (doom e.) (guh s) (dik e) (doom e) (dik e) (doom e) )))

(defun partito-alto (time)
    (play-list time '((doot e) (deet e.) (doot e) (doot e) (deet e.) (doot e) (doot e))))


(defun bossa-clave (time)
    (play-list time 
	       (mapcar #'(lambda (X) (list x 's))
		       '(ta ka ka ta ka ka ta ka ka ta ka ka ta ka ta ka))))

(defun n-bars-of (pattern n time)
  (loop for repetition from 0 to (- n 1) do
	(funcall (symbol-function pattern) (+ time (* repetition (rhythm 'w)))) ))

(defun 4bossa (time)
  (n-bars-of 'bossa-clave 4 time))

(defun 4pa (time)
  (n-bars-of 'partito-alto 4 time))


#|

All of this is now obsolete:

(defun 4bossa (time)
  (bossa-clave time)
  (bossa-clave (+ time (rhythm 'w)))
  (bossa-clave (+ time (* 2 (rhythm 'w))))
  (bossa-clave (+ time (* 3 (rhythm 'w)))) )

(defun 4pa (time)
  (partito-alto time)
  (partito-alto (+ time (rhythm 'w)))
  (partito-alto (+ time (* 2 (rhythm 'w))))
  (partito-alto (+ time (* 3 (rhythm 'w)))) )

(defun four-bars-of (pattern time)
  (funcall (symbol-function pattern) time)
  (funcall (symbol-function pattern) (+ time (rhythm 'w)))
  (funcall (symbol-function pattern) (+ time (* 2 (rhythm 'w))))
  (funcall (symbol-function pattern) (+ time (* 3 (rhythm 'w)))) )

|#






(defun callout (time)
    (play-list time (mapcar #'(lambda (x) (list 'tak x))
			    '(e e. e e 32nd 32nd s s e e e))))





;; A rather lame arrangement:

(setq *tempo* 140)

(with-sound (:srate 22050)
  (let ((time 0))
    (play-list time '((doom h) (doom h) (doom h) (doom q)))
    (setq time (+ time (apply #'+ (rhythm '(h h h q)))))

    (play-list time '((dik q) (doom q) (dik q) (doom q) (dik q) (doom q) (dik q.) (doom e)))
    (setq time (+ time (* 2 (rhythm 'w))))

    (surdo-4bars time)
    (4pa time)
    (setq time (+ time (* 4 (rhythm 'w))))

    (surdo-4bars time)
    (4pa time)
    (4bossa time)
    (setq time (+ time (* 4 (rhythm 'w))))

    (surdo-4bars time)
    (4pa time)
    (4bossa time)
    (callout (+ time (* 3 (rhythm 'w))))

    (setq time (+ time (* 4 (rhythm 'w))))
    (dik time (rhythm 'e))
    (deet time (rhythm 'e))
    (ta time (rhythm 'e))
))



#|

;; Various experiments and test sounds

(with-sound () (test-shape 'jjj.shp))
(with-sound () (goozh 0. .5))
(with-sound (:srate 22050) (play-list 0 '((tak q) (tak q) (tak q) (tak q) )))

(with-sound (:srate 22050)
   (play-list 0 '((ta q) (ka q) (ta q) (ka q) (ta q) (ka q) (ta q) (ka q))))

(with-sound ()
	    (guh 0.1 0.05)
	    (dik 0.2 0.25) 
	    (guh 0.5 0.05)
	    (doom 0.6 0.25) )


(with-sound (:srate 22050) (bossa-clave 0))

(with-sound (:srate 22050) (surdo-4bars 0))

(with-sound (:srate 22050) (callout 0))


;; The end:

(with-sound (:srate 22050)
  (let ((time 0))	   
    (surdo-4bars time)
    (4pa time)
    (4bossa time)
    (callout (+ time (* 3 (rhythm 'w))))

    (setq time (+ time (* 4 (rhythm 'w))))
    (dik time (rhythm 'e))
    (deet time (rhythm 'e))
    (ta time (rhythm 'e))
))

|#