;; type event = [int]

;; int -> [int] -> event
(define make-event
  cons)

;; event -> int
(define event-status
  head)

;; event -> [int]
(define event-data
  tail)

;; event -> int -> int
(define event-data-byte
  (lambda (e n)
    (list-ref (tail e) n)))

;; int -> int -> event
(define make-event1
  (lambda (s b)
    (make-event s (list b))))

;; event -> bool
(define midi-event-channel?
  (lambda (e)
    (let ((status-byte (event-status e)))
      (and (>= status-byte #x80)
	   (<= status-byte #xef)))))

;; event -> bool
(define midi-event-sysex?
  (lambda (e)
    (let ((status-byte (event-status e)))
      (= status-byte #xf0))))

;; event -> bool
(define midi-event-arbitrary?
  (lambda (e)
    (let ((status-byte (event-status e)))
      (= status-byte #xf7))))

;; event -> bool
(define midi-event-meta?
  (lambda (e)
    (let ((status-byte (event-status e)))
      (= status-byte mc-meta-event))))

;; event -> int -> bool
(define midi-meta-event-of-type?
  (lambda (e event-type)
    (and (midi-event-meta? e)
	 (= event-type (event-data-byte e 0)))))

;; event -> bool
(define midi-meta-event-sequence-number?
  (lambda (e)
    (midi-meta-event-of-type? e mc-sequence-number)))

;; event -> bool
(define midi-meta-event-text-event?
  (lambda (e)
    (midi-meta-event-of-type? e mc-text-event)))

;; event -> bool
(define midi-meta-event-copyright-notice?
  (lambda (e)
    (midi-meta-event-of-type? e mc-copyright-notice)))

;; event -> bool
(define midi-meta-event-sequence-name?
  (lambda (e)
    (midi-meta-event-of-type? e mc-sequence-name)))

;; event -> bool
(define midi-meta-event-intrument-name?
  (lambda (e)
    (midi-meta-event-of-type? e mc-instrument-name)))

;; event -> bool
(define midi-meta-event-lyric?
  (lambda (e)
    (midi-meta-event-of-type? e mc-lyric)))

;; event -> bool
(define midi-meta-event-marker?
  (lambda (e)
    (midi-meta-event-of-type? e mc-marker)))

;; event -> bool
(define midi-meta-event-cue-point?
  (lambda (e)
    (midi-meta-event-of-type? e mc-cue-point)))

;; event -> bool
(define midi-meta-event-midi-channel-prefix?
  (lambda (e)
    (midi-meta-event-of-type? e mc-channel-prefix)))

;; event -> bool
(define midi-meta-event-end-of-track?
  (lambda (e)
    (midi-meta-event-of-type? e mc-end-of-track)))

;; event -> bool
(define midi-meta-event-set-tempo?
  (lambda (e)
    (midi-meta-event-of-type? e mc-set-tempo)))

;; event -> bool
(define midi-meta-event-smpte-offset?
  (lambda (e)
    (midi-meta-event-of-type? e mc-smpte-offset)))

;; event -> bool
(define midi-meta-event-time-signature?
  (lambda (e)
    (midi-meta-event-of-type? e mc-time-signature)))

;; event -> bool
(define midi-meta-event-key-signature?
  (lambda (e)
    (midi-meta-event-of-type? e mc-key-signature)))

;; event -> bool
(define midi-meta-event-sequencer-specific?
  (lambda (e)
    (midi-meta-event-of-type? e mc-sequencer-specific)))

;; int -> int -> int -> int -> event
(define encode-midi-meta-event-time-signature
  (lambda (numerator denominator pulse-at bb)
    (let ((make-dd (lambda (denominator)
		     (case denominator
		       ((1) 0)
		       ((2) 1)
		       ((4) 2)
		       ((8) 3)
		       ((16) 4)
		       ((32) 5)
		       (else (error "encode-midi-meta-event-time-signature"
				    "illegal denominator" 
				    denominator))))))
      (make-event 
       mc-meta-event 
       (list mc-time-signature
	     numerator 
	     (make-dd denominator)
	     (exact (round (* pulse-at #x60)) bb))))))

;; event
(define midi-meta-event-end-of-track
  (make-event1 mc-meta-event mc-end-of-track))

;; string -> event
(define encode-midi-meta-event-text-event
  (lambda (text)
    (make-event 
     mc-meta-event 
     (cons 
      mc-text-event
      (map char->integer (string->list text))))))

;; event -> double
(define decode-midi-meta-event-set-tempo
  (lambda (e)
    (midi-upq-to-qpm 
     (decode-i32
      (u8-list->bytevector
       (cons 0 (tail (event-data e))))))))

;; int -> event
(define encode-midi-meta-event-set-tempo
  (lambda (qpm)
    (make-event 
     mc-meta-event 
     (cons 
      mc-set-tempo
      (tail 
       (bytevector->u8-list 
	(encode-i32 
	 (midi-qpm-to-upq qpm))))))))