view implementations/midi/functions.lisp @ 330:2fbff655ba47 tip

Removed cpitch-adj and cents SQL columns

(cl:in-package #:amuse-midi)

;;;========================================================================
;;; Functions that return features given an event.
;;;========================================================================

(defun midi-event-type (event)
  "Defines an arbitrary ordering for pitched and percussive events."
  (if (pitchedp event) 0 1))

;;;========================================================================
;;; Predicates for conditioning on event attributes.
;;; Useful for sia-datapoint-specs.
;;;========================================================================

;;; midi-drum-sound
(defun midi-drum-sound-eql (event sound)
  (eql (midi-drum-sound event) sound))

(defun make-midi-drum-sound-eql (sound)
  (lambda (event)
    (funcall #'midi-drum-sound-eql event sound)))

(defun midi-drum-sound-any (event &rest sounds)
  (loop for sound in sounds
     do (if (midi-drum-sound-eql event sound)
	    (return t))))

(defun make-midi-drum-sound-any (&rest sounds)
  (lambda (event)
    (apply #'midi-drum-sound-any event sounds)))

;;; midi-channel
(defun midi-channel-eql (event channel)
  (eql (midi-channel event) channel))

(defun make-midi-channel-eql (channel)
  (lambda (event)
    (funcall #'midi-channel-eql event channel)))

(defun midi-channel-any (event &rest channels)
  (loop for channel in channels
     do (if (midi-channel-eql event channel)
	    (return t))))

(defun make-midi-channel-any (&rest channels)
  (lambda (event)
    (apply #'midi-channel-any event channels)))

;;; midi-track
(defun midi-track-eql (event track)
  (eql (midi-track event) track))

(defun make-midi-track-eql (track)
  (lambda (event)
    (funcall #'midi-track-eql event track)))

(defun midi-track-any (event &rest tracks)
  (loop for track in tracks
     do (if (midi-track-eql event track)
	    (return t))))

(defun make-midi-track-any (&rest tracks)
  (lambda (event)
    (apply #'midi-track-any event tracks)))