(import (rhs)
        (sosc)
        (rsc3)
        (rsc3 midi))

;; type midi-file

;; midi-file
(define m
  (midi-file-read-file "1080-C01.midi"))

;; [int, int, int]
(equal? (midi-file-header m) (list 1 17 120))

;; int
(= (midi-file-format-type m) 1)

;; int
(= (midi-file-number-of-tracks m) 17)

;; int
(= (midi-file-division m) 120)

;; type event = [float, [int]]

;; [event]
(midi-file-track m 0)

;; event -> bool
(define is-note-on?
  (lambda (e)
    (let* ((d (list-ref e 1))
           (s (car d)))
      (= mc-note-on (midi-status-major s)))))

;; event -> event -> ord
(define event-compare
  (lambda (e1 e2)
    (compare (car e1) (car e2))))

;; [event] -> [event]
(define to-absolute
  (lambda (l f)
    (let ((t (map f (map car l)))
          (m (map cadr l)))
      (zip-with
       list
       (cdr (integrate (cons 0 t)))
       m))))

;; midi-file -> int -> float -> [event]
(define note-list-abs
  (lambda (d n i)
    (sort-by
     event-compare
     (concat
      (map (lambda (track)
             (filter is-note-on?
                     (to-absolute
                      (list-ref d track)
                      (lambda (t) (inexact (/ t i))))))
           (enum-from-to 1 (- n 1)))))))

;; [event]
(define nl
  (note-list-abs
   m
   (midi-file-number-of-tracks m)
   (* 4 (midi-file-division m))))

;; ugen
(define ping
  (letc ((freq 440)
         (ampl 0.1))
    (let ((p (env-perc 0.1 1 1 (list -4 -4))))
      (out 0 (mul (sin-osc ar (mce2 freq (add freq (rand 1 2))) 0)
                  (env-gen kr 1 ampl 0 1 remove-synth p))))))

;; ()
(with-sc3
 (lambda (fd)
   (send-synth fd "ping" ping)
   (send fd (s-new2 "ping" -1 1 1
                    "freq" (midi-cps (random 45 65))
                    "ampl" (random 0.05 0.25)))))

;; socket -> float -> event -> ()
(define ping-midi
  (lambda (fd t m)
    (let* ((d (list-ref m 1))
           (n (list-ref d 1))
           (g (list-ref d 2)))
      (send fd (bundle
                t
                (list
                 (s-new2 "ping" -1 0 1
                         "freq" (midi-cps n)
                         "ampl" (/ g 1280.0))))))))

;; using only scsynth scheduler is straight-forward
;; but can overflow the queue.  C-cC-k clears the
;; schedule queue.
(with-sc3
 (lambda (fd)
   (let ((d (midi-file-read-file "1080-C01.midi"))
         (t (utc)))
     (for-each
      (lambda (m)
        (ping-midi fd (+ t (car m)) m))
      nl))))

;; [event] -> [event]
(define to-relative
  (lambda (nl)
    (let ((f (lambda (pt m)
               (let ((t (car m))
                     (d (cadr m)))
                 (tuple2 t (list (- t pt) d))))))
      (snd (map-accum-l f 0 nl)))))

;; using both scheme & scsynth scheduler is
;; a little extra work but safer.  C-cC-c
;; interrupts the scheme process.
(with-sc3
 (lambda (fd)
   (let ((d (midi-file-read-file "1080-C01.midi"))
         (t (+ (utc) 0.1)))
     (scanl
      (lambda (ct m)
        (ping-midi fd ct m)
        (thread-sleep (car m))
        (+ ct (car m)))
      t
      (to-relative nl)))))