| commit | author | age | ||
| 92c40d | 1 | ;********************************************************************* |
| AN | 2 | ; OM-SoX, (c) 2011-2015 Marlon Schumacher (CIRMMT/McGill University) * |
| 3 | ; http://sourceforge.net/projects/omsox/ * | |
| 4 | ; * | |
| 5 | ; Multichannel Audio Manipulation and Functional Batch Processing. * | |
| 6 | ; DSP based on SoX - (c) C.Bagwell and Contributors * | |
| 7 | ; http://sox.sourceforge.net/ * | |
| 8 | ;********************************************************************* | |
| 9 | ; | |
| 10 | ;This program is free software; you can redistribute it and/or | |
| 11 | ;modify it under the terms of the GNU General Public License | |
| 12 | ;as published by the Free Software Foundation; either version 2 | |
| 13 | ;of the License, or (at your option) any later version. | |
| 14 | ; | |
| 15 | ;See file LICENSE for further informations on licensing terms. | |
| 16 | ; | |
| 17 | ;This program is distributed in the hope that it will be useful, | |
| 18 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 20 | ;GNU General Public License for more details. | |
| 21 | ; | |
| 22 | ;You should have received a copy of the GNU General Public License | |
| 23 | ;along with this program; if not, write to the Free Software | |
| 24 | ;Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,10 USA. | |
| 25 | ; | |
| 26 | ;Authors: M. Schumacher | |
| 27 | ||
| 28 | (in-package :om) | |
| 29 | ||
| 30 | (defclass* sound (simple-score-element internalsound) | |
| 31 | ((tracknum :accessor tracknum :initarg :tracknum :initform 0 :documentation "a track index for multichannel mixing") | |
| 32 | (markers :accessor markers :initarg :markers :initform nil :documentation "a list of markers (s)") | |
| 33 | (vol :accessor vol :initform 1.0) ;NB the default for vol is set to 0 for *all players* in OM when OM-Versions > 6.07 | |
| 34 | (pan :accessor pan :initform 0)) | |
| 35 | (:icon 287) | |
| 36 | (:documentation "Sound file object. | |
| 37 | ||
| 38 | A sound is initialized with a pathname corresponding to an audio file on the disk. | |
| 39 | Connect a pathname to the first input (<self>) to initialize the instance. | |
| 40 | If it is unlocked and unconnected, evaluating the box will open a file chooser dialog and allow the selection of a sound file to load. | |
| 41 | ||
| 42 | The other inputs/outputs correspond to : | |
| 43 | - <tracknum> = a track number on which the sound will be dispatch at playback. Tracknum can also be changed from the sound editor. | |
| 44 | - <markers> = a list of markers (time in seconds). The markers can also be added/moved/removed from the sound editor. | |
| 45 | ||
| 46 | NOTE: These inputs can be connected and will be evaluated even if something is connected to he <self> input of the box. | |
| 47 | ||
| 48 | Press 'space' to play/stop the sound file. | |
| 49 | ")) | |
| 50 | ||
| 51 | ||
| 52 | ; set sox as default sound player | |
| 53 | (defmethod get-default-score-params ((self sound)) | |
| 54 | (pairlis '(approx fontsize staff cmnpref deltapict outport inport player | |
| 55 | zoom notechancolor? grillestep mode winsize winpos score-mode obj-mode show-stems scale) | |
| 56 | (list *global-midi-approx* *music-fontsize* *default-satff* (make-instance 'edition-values) (om-make-point 0 0) | |
| 57 | nil *InMidiPort* :soxplayer | |
| 58 | 1 nil 1000 0 (om-make-point 370 280) (om-make-point 400 20) 0 1 t nil))) | |
| 59 | ||
| 60 | (defmethod save-exepcion ((self sound)) | |
| 61 | (and (om-sound-file-name self) | |
| 62 | (register-resource :sound (om-sound-file-name self)) | |
| 63 | `(let ((thesound (load-sound ,(om-save-pathname-relative (om-sound-file-name self)) | |
| 64 | ,(tracknum self) | |
| 65 | ,(vol self) | |
| 66 | ,(pan self) | |
| 67 | ))) | |
| 68 | (when thesound | |
| 69 | (setf (markers thesound) ',(markers self))) | |
| 70 | thesound))) | |
| 71 | ||
| 72 | ||
| 73 | (defun load-sound (name &optional track vol pan) | |
| 74 | (let ((snd (om-load-if name 'load-sound-file))) | |
| 75 | (unless snd (setf snd (make-instance 'sound :filename name))) | |
| 76 | (when (and snd track) (setf (tracknum snd) track)) | |
| 77 | (when (and snd vol) (setf (vol snd) vol)) | |
| 78 | (when (and snd pan) (setf (pan snd) pan)) | |
| 79 | snd)) | |
| 80 | ||
| 81 | (defmethod audio-player-track-range ((player (eql :soxplayer))) '(0 32)) | |
| 82 | (defmethod audio-player-vol-range ((player (eql :soxplayer))) '(0 4)) ; up to +12 db (headroom) | |
| 83 | ||
| 84 | (defmethod copy-container ((self sound) &optional (pere ())) | |
| 85 | (let ((snd (if (om-sound-file-name self) | |
| 86 | (let ((copy (load-sound-file (om-sound-file-name self))) | |
| 87 | (slots (class-instance-slots (find-class 'simple-container)))) | |
| 88 | (setf (slot-value copy 'parent) pere) | |
| 89 | (loop for slot in slots | |
| 90 | when (not (eq (slot-definition-name slot) 'parent)) | |
| 91 | do (setf (slot-value copy (slot-definition-name slot)) | |
| 92 | (copy-container (slot-value self (slot-definition-name slot)) copy))) | |
| 93 | copy) | |
| 94 | (make-instance 'sound)))) | |
| 95 | (setf (tracknum snd) (tracknum self)) | |
| 96 | (setf (markers snd) (markers self)) | |
| 97 | (setf (pan snd) (pan self)) | |
| 98 | (setf (vol snd) (vol self)) | |
| 99 | (setf (pict-spectre snd) (pict-spectre self)) | |
| 100 | (when (< *om-version* 6.08) (setf (pict-spectre? snd) (pict-spectre? self))) | |
| 101 | snd)) | |
| 102 | ||
| 103 | ; this is kind of a hack to copy the tracknum when connecting a sound obj to another sound obj | |
| 104 | ; while still being able to 'override' this by providing a tracknum to the <tracknum> inlet | |
| 105 | ; NB: the value '0' cannot be provided through the tracknum inlet when self is connected to a sound, i.e. it will take the tracknum of the 'pere' sound obj | |
| 106 | (defmethod cons-new-object ((self sound) args objs) | |
| 107 | (let ((rep (call-next-method))) | |
| 108 | (nth 1 args) | |
| 109 | (when rep | |
| 110 | (setf (tracknum rep) (if (and (integerp (nth 1 args)) (> (nth 1 args) 0)) (nth 1 args) (tracknum rep))) | |
| 111 | (when (consp (nth 2 args)) (setf (markers rep) (nth 2 args)))) | |
| 112 | rep)) | |
| 113 | ||
| 114 | ||
| 115 | ; Support loading audio formats other than .aif or .wav | |
| 116 | ||
| 117 | ; the variable au::*additional-audio-formats* is not bound in OM6.11 anymore, thus replacing here with *additional-audio-formats* from waveform.lisp (now in preferences.lisp) | |
| 118 | #| | |
| 119 | (defparameter *sox-additional-audio-formats* '((:sox-formats "flac" "3gp" "caf" "au" "raw" "f32" "f64" "s8" "s16" "s24" "s32" "u8" "u16" "u24" "u32" "ul" "al" "lu" "la" "cdda" "cdr" "f4" "f8" "s1" "s2" "s3" "s4" "u1" "u2" "u3" "u4" "sb" "sw" "sl" "ub" "uw" "8svx" "aiffc" "aifc" "amb" "amr-nb" "amr-w" "au" "snd" "avr" "cvsd" "cvs" "cvu" "dat" "dvms" "vms" "fap" "paf" "ffmpeg" "flac" "fssd" "gsm" "hcom" "htk" "ircam" "ima" "lpc" "lpc10" "mat" "mat4" "mat5" "m3u" "mp3" "mp2" "mp4" "m4a" "maud" "nist" "sph" "ogg" "vorbis" "prc" "pvf" "sd2" "sds" "sf" "sph" "nist" "smp" "sndr" "sndt" "sndfile" "sndio" "sndr" "sndt" "sou" "txw" "vms" "dvms" "voc" "w64" "wav" "waveaudio" "wavpcm" "wv" "wve" "xa" "xi"))) | |
| 120 | |# | |
| 121 | ||
| 122 | ;; study this | |
| 123 | (loop for item in (cdr (find :sox-formats *additional-audio-formats* :key 'car)) do | |
| 124 | (eval | |
| 125 | `(defmethod get-obj-from-file ((type (eql ',(interne item))) filename) | |
| 126 | (load-sound-file filename)) | |
| 127 | )) | |
| 128 | ||
| 129 | ; ADD MORE METHODS HERE (for all the supported filetypes) | |
| 130 | ||
| 131 | (defmethod draw-obj-in-rect ((self sound) x x1 y y1 edparams view) | |
| 132 | (let ((picture (if (>= *om-version* 6.08) | |
| 133 | (if (and (pict-spectre self) (get-param edparams :show-spectrum)) | |
| 134 | (thepict (pict-spectre self)) | |
| 135 | (sound-get-pict self)) | |
| 136 | (pic-to-draw self))) | |
| 137 | ) | |
| 138 | (om-with-focused-view view | |
| 139 | (if picture | |
| 140 | (let ((dur (/ (om-sound-n-samples self) (om-sound-sample-rate self))) | |
| 141 | (pos x) (w (- x1 x)) (h (h view))) | |
| 142 | (om-with-fg-color view *om-dark-gray-color* | |
| 143 | (if (< *om-version* 6.09) | |
| 144 | (om-draw-picture view picture (om-make-point x y) (om-make-point (- x1 x) (- y1 y)))) | |
| 145 | (om-draw-picture view picture :pos (om-make-point x y) :size (om-make-point (- x1 x) (- y1 y)))) | |
| 146 | (om-with-fg-color view *om-steel-blue-color* | |
| 147 | (om-with-line '(2 2) | |
| 148 | (loop for item in (markers self) do | |
| 149 | (setf pos (+ x (round (* w item) dur))) | |
| 150 | (om-draw-line pos y pos y1))))) | |
| 151 | ) | |
| 152 | ))) | |
| 153 | ||
| 154 | ||
| 155 | ||
| 156 | ; make-sound method ============= | |
| 157 | ||
| 158 | (defmethod! make-sound ((file pathname) (tracknum number) (vol number) (pan number) (player symbol)) | |
| 159 | (let ((mysound (make-instance 'sound :filename file))) | |
| 160 | (setf (tracknum mysound) tracknum) | |
| 161 | (setf (vol mysound) vol) | |
| 162 | (setf (pan mysound) pan) | |
| 163 | (setf (extent mysound) nil) | |
| 164 | mysound)) | |
| 165 | ||
