umtz added by saeftl on Sat Nov 2 16:29:40 2013

(use srfi-1 sdl-mixer loop srfi-18)

(load "umtz-sounds.csi")
(use low-level-macros)
(set! channs 50)

(define threadlist '())

(open-audio)
(if (not (= (mix-allocate-channels channs) channs))
    (print could not allocate  channs  channels))

(define (loads soundfile)
  (let ((sounddir "/home/bauerm/src/umtz/sounds")
        (origdir (current-directory)))
    (begin (change-directory sounddir) (let ((sound (load-sample soundfile)))
        (change-directory origdir) sound))))

;; XXX sound file optional als list, die sounds werden in eine liste geladen,
;; und werden nacheinander abgespielt
;; XXX volumes optional als listen, so dass die lautstaerken auch so nacheinander
;; eingestellt werden
(define (umpf soundfiles freq volumes howmany)
  (if (not (pair? soundfiles)) (umpf (list soundfiles) freq volumes howmany)
  (if (not (pair? volumes)) (umpf soundfiles freq (list volumes) howmany)
  (let* ((sounds (map loads soundfiles))
         (slen (length sounds))
         (vlen (length volumes)))
    (define (play k)
        (let ((s (list-ref sounds (modulo k slen)))
              (v (list-ref volumes (modulo k vlen))))
        (begin
            (mix-volume-chunk s v)
            (play-sample s)
            (thread-sleep! (/ 60 freq)))))
    (thread-start!
      (make-thread
        (lambda ()
            (loop with c = 0 while (or (eq? howmany 'inf) (< c howmany)) do
                  (begin (play c) (set! c (+ c 1)))))))))))

(define (reg-thread t)
    (print "threadlist vorher" threadlist)
    (set! threadlist (append threadlist (list t)))
    (print "threadlist nacher" threadlist))

;; XXX tut nicht
(define (stopit n)
    (thread-suspend! (list-ref threadlist n)))


(begin
;  (umpf (list MarimbaHardC4 MarimbaHardC6) 100 (list 30 120 70) 'inf)
  (reg-thread (umpf (list drum-bass-lo-2 drum-bass-lo-2 drum-bass-lo-2 timbale-hi-crosstick-1) 160 (list 80 80 80
 120) 'inf))
  (reg-thread (umpf tumba-muffled-1 160 120 'inf))
)

(close-audio)