mplayp test

untitled

;;;;;;;;;;;;;;; On Beat ;;;;;;;;;;;;;;;;;;;;;

(define-macro (onbeat? b of t . f)
  (if (null? f)
      `(if (= (modulo beat ,of) (- ,b 1))
           ,t)
      `(if (= (modulo beat ,of) (- ,b 1))
           ,t ,(car f))))

;;;;;;;;;;;;;;;; Pattern Player ;;;;;;;;;;;;;;

(define playp_play_list
  (let ((lst_idx (range 0 1000)))
    (lambda (beat dur pclas inst vols durs lst mod_diff step offset poffset args)
      (let ((duration 0) (volume 0)
            (phase 0))
        (for-each (lambda (x idx t)
                    (if (symbol? x) (set! x (eval x)))
                    (if (list? durs)
                        (if (and (symbol? (car durs))
                                 (defined? (car durs))
                                 (or (closure? (eval (car durs)))
                                     (procedure? (eval (car durs)))
                                     (macro? (eval (car durs)))))
                            (set! duration durs)
                            (if (= (length durs) (length lst))
                                (set! duration (list-ref durs idx))
                                (set! duration step)))
                        (set! duration durs))
                    (if (list? vols)
                        (if (and (symbol? (car vols))
                                 (defined? (car vols))
                                 (or (closure? (eval (car vols)))
                                     (procedure? (eval (car vols)))
                                     (macro? (eval (car vols)))))
                            (set! volume vols)
                            (if (= (length vols) (length lst))
                                (set! volume (list-ref vols idx))
                                (set! volume 80)))
                        (set! volume vols))
                    (if (list? x)
                        (playp_play_list beat dur pclas inst volume
                                         duration x mod_diff (/ step (length lst)) (+ t offset) poffset args)
                        (if (> x 0)
                            (begin
                              (set! phase (+ mod_diff t offset))
                              (eval
                               `(mplay ,phase ;(+ mod_diff t offset)
                                      ,inst
                                      ,(pc:quantize (+ x poffset) pclas)
                                      ,volume
                                      ,duration
                                      ,@args))))))
                  lst
                  lst_idx
                  (range 0 step (/ step (length lst))))))))


(define playp_f
  (lambda (beat dur . args)
    (let ((pclas '(0 1 2 3 4 5 6 7 8 9 10 11))
          (offset 0)
          (poffset 0)
          (inst '())
          (data '())
          (vols '())
          (durs '())
          (datal 0)
          (cycle 0)
          (step 0))
      ;; check for quantizer list
      (if (list? (car args))
          (begin (set! pclas (car args))
                 (set! args (cdr args))))
      ;; now cycle
      (if (closure? (car args))
          (set! cycle dur)
          (begin
            (set! cycle (car args))
            (set! args (cdr args))))
      ;; if no instrument must be an offset
      (if (not (closure? (car args)))
          (begin (set! offset (car args))
                 (set! args (cdr args))))
      ;; now instrument (which should be a closure!)
      (set! inst (car args))
      (set! args (cdr args))
      ;; if not pitch list must be offset
      (if (not (list? (car args)))
          (begin (set! poffset (car args))
                 (set! args (cdr args))))
      ;; now must be pitch list
      (set! data (car args))
      (set! args (cdr args))
      (set! datal (length data))
      (set! vols (car args))
      (set! args (cdr args))
      (set! durs (car args))
      (set! args (cdr args))
      (set! step (/ cycle datal))
      (let ((local_beat (modulo beat cycle))
            (mod_diff 0)
            (volume vols)
            (phase 0.0)
            (duration durs)
            (pitch 0))
        (dotimes (i (* 2 datal))
          (set! mod_diff (- (* i step) local_beat))
          (set! pitch (list-ref data (modulo i datal)))
          (if (symbol? pitch) (set! pitch (eval pitch)))
          (if (list? durs)
              (if (and (symbol? (car durs))
                       (defined? (car durs))
                       (or (closure? (eval (car durs)))
                           (procedure? (eval (car durs)))
                           (macro? (eval (car durs)))))
                  (set! duration durs)
                  (if (= (length durs) datal)
                      (set! duration (list-ref durs (modulo i datal)))
                      (set! duration step))))
          (if (list? vols)
              (if (and (symbol? (car vols))
                       (defined? (car vols))
                       (or (closure? (eval (car vols)))
                           (procedure? (eval (car vols)))
                           (macro? (eval (car vols)))))
                  (set! volume vols)
                  (if (= (length vols) datal)
                      (set! volume (list-ref vols (modulo i datal)))
                      (set! volume 80))))
          (if (list? pitch)
              (begin
                (if (and (>= mod_diff 0)
                         (< mod_diff dur)
                         (not (null? pitch)))
                    (playp_play_list beat dur pclas inst volume duration pitch mod_diff step offset poffset args)))
              (begin
                (set! phase (+ mod_diff offset))
                (if (and (>= mod_diff 0)
                         (< mod_diff dur)
                         (> pitch 0))
                    (eval `(mplay ,phase ;(+ mod_diff offset)
                                 ,inst
                                 ,(pc:quantize (+ pitch poffset) pclas)
                                 ,volume
                                 ,duration
                                 ,@args))
                    (begin #f)))))))))


;; this is what you *actually* call
(define-macro (mplayp . args)
  `(playp_f beat dur ,@args))


;; TESTING 

(define mididevice (pm_create_output_stream 4))
(play-midi-note (now) mididevice (random 36 42) 90 44100 0) ;; works ok

(define test
   (lambda (beat dur)
        (mplayp 4 mididevice '(60 80) 80 dur 0)
     (callback (*metro* (+ beat (* 1/2 dur))) 'test (+ beat dur) dur)))

(test (*metro* 'get-beat 4) 1/4)

;; ERROR
function(length): argument 1 must be: pair or '()
argument values: (1/4) #<PROC length>
Trace: playp_f <- test