rmap_helper   scheme


Defined in:  https://github.com/digego/extempore/tree/v0.8.9/libs/core/pattern-language.xtm

Implementation

(define rmap_helper
  (lambda (beats offset func beat dur loopcnt looppos . args)
    (let* ((lst (rmap_helper_lst_sym_transform (if (list? (car args))
                                                   (car args)
                                                   (if (pair? (car args))
                                                       (caar args)
                                                       '(_ _ _ _)))))
           (pos (modulo (- looppos offset) beats)) ;;(modulo (- beat offset) beats))
           (one_beat (/ beats (length lst)))
           (lst_positions (range 0 (+ pos beats) one_beat))
           (nextpos (+ pos dur))
           (idx 0)
           (f (lambda (old new)
                (set! idx (+ idx 1))
                (if (and (>= new pos) (< new nextpos))
                    (cons (cons new idx) old)
                    old)))
           (newlst (foldl f '() lst_positions)))
      (map (lambda (t)
             (let* ((tmpargs (map (lambda (l)
                                    (if (list? l)
                                        (set! l (rmap_helper_lst_sym_transform l))
                                        (if (pair? l)
                                            (set! l ((eval (cdr l)) (rmap_helper_lst_sym_transform (car l))))
                                            (set! l (list l))))
                                    (if (< (length l) (cdr t))
                                        (list-ref l (modulo (- (cdr t) 1) (length l)))
                                        (list-ref l (- (cdr t) 1))))
                                  args))
                    (targs (map (lambda (l)
                                  (cond ((vector? l) (map (lambda (x) (eval x)) (vector->list l)))
                                        ((and (symbol? l) (not (member l '(_ |)))) (eval l))
                                        (else l)))
                                tmpargs)))
               (cond
                ((or (list? (car tmpargs)) (pair? (car tmpargs)))
                 (apply rmap_helper one_beat offset func (+ beat (- (car t) pos)) one_beat loopcnt (+ looppos (- (car t) pos)) targs))
                ((member (car tmpargs) '(_ |)) #f) ;; skip these symbols
                (else
                 ;; this is a messy expression, but it just counts the number of
                 ;; '| symbols *after* the current value, and adds them to the
                 ;; duration
                 (let ((note-dur (* one_beat
                                   (+ 1 (length (take-while (lambda (x) (equal? x '|))
                                                            (cl:nthcdr (min (cdr t) (length (car args))) (car args))))))))
                   (apply callback
                          (- (*metro* (+ beat (- (car t) pos))) *RMAP_HELPER_CALLBACK_OFFSET*)
                          func (+ beat (- (car t) pos)) note-dur
                          loopcnt targs))))))
           newlst))))


Back to Index

Similar Entries