| commit | author | age | ||
| 92c40d | 1 | ;********************************************************************* |
| AN | 2 | ; OM-SoX, (c) 2011-2016 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 | ||
| 31 | ; Set OM Preferences | |
| 32 | (defmethod put-external-preferences ((module (eql 'sox)) moduleprefs) | |
| 33 | (when (get-pref moduleprefs :Sox-path) | |
| 34 | (setf *SOX-PATH* (find-true-external (get-pref moduleprefs :Sox-path))) | |
| 35 | (when (probe-file *SOX-PATH*) | |
| 36 | (om-cmd-line (format nil "chmod 777 ~s" (namestring *sox-path*)) t)) | |
| 37 | )) | |
| 38 | ||
| 39 | ; Set Normalization Module | |
| 40 | (unless (find :sox *loaded-normalizers*) | |
| 41 | (pushr :sox *loaded-normalizers*)) | |
| 42 | ||
| 43 | (defmethod get-def-normalize-value ((self (eql :sox))) 0.0) | |
| 44 | (defmethod get-module-name ((self (eql :sox))) "sox") | |
| 45 | (defmethod general-normalize ((norm (eql :sox)) inpath outpath val &optional resolution) | |
| 46 | (let ((normval (or val *normalize-level*))) | |
| 47 | (sox-process inpath (sox-normalize :level normval) :output outpath))) ; resolution could be added here: Or only if sox uses OM audio settings | |
| 48 | ||
| 49 | (defparameter *om-sox-lib-path* (make-pathname :directory (pathname-directory *load-pathname*))) | |
| 50 | (defparameter *om-sox-version* "1.0.1") | |
| 51 | ||
| 52 | (load (om-make-pathname :directory (x-append (pathname-directory *load-pathname*) "sources") :name "preferences" :type "lisp")) | |
| 53 | ||
| 54 | ; Load Classes | |
| 55 | (defparameter *sox-classes* '( | |
| 56 | "sox-input" | |
| 57 | "sox-concatenate" | |
| 58 | "sox-merge" | |
| 59 | "sox-mix-console" | |
| 60 | "sox-mix" | |
| 61 | "sox-multiply" | |
| 62 | "sox-pan" | |
| 63 | "sox-record" | |
| 64 | "sox-remix" | |
| 65 | "sox-splice" | |
| 66 | "sox-split" | |
| 67 | )) | |
| 68 | ||
| 69 | (defun load-sox-classes (subdir &optional pack) | |
| 70 | (loop for item in *sox-classes* do | |
| 71 | (let ((itempath (om-relative-path subdir item))) | |
| 72 | (compile&load itempath) | |
| 73 | (let ((classname (intern (string-upcase item)))) | |
| 74 | (when (and pack (find-class classname nil)) | |
| 75 | (unless (equal item "sox-input") | |
| 76 | (addclass2pack classname pack))))) | |
| 77 | ) | |
| 78 | ) | |
| 79 | ||
| 80 | (load-sox-classes '("sources" "classes") (find-library "OM-SoX")) | |
| 81 | ||
| 82 | ; Load Functions | |
| 83 | (defun recursive-load-files (dir &optional pack) | |
| 84 | (loop for item in (om-directory dir) do | |
| 85 | ;(print item) | |
| 86 | (if (directoryp item) | |
| 87 | (unless (equal (car (last (pathname-directory item))) "classes") ;don't load classes | |
| 88 | (let ((thepackage | |
| 89 | (or (and pack (find (car (last (pathname-directory item))) | |
| 90 | (subpackages pack) :key 'name :test 'string-equal)) | |
| 91 | pack))) | |
| 92 | (recursive-load-files item thepackage))) | |
| 93 | ||
| 94 | (cond ((and (>= *om-version* 6.07) (< *om-version* 6.08)) | |
| 95 | (when (string-equal (pathname-type item) "lisp") | |
| 96 | (unless (or (string-equal (pathname-name item) "player-om606") | |
| 97 | (string-equal (pathname-name item) "player-om608")) | |
| 98 | (compile&load item)))) | |
| 99 | ((>= *om-version* 6.08) | |
| 100 | (when (string-equal (pathname-type item) "lisp") | |
| 101 | (unless (or (string-equal (pathname-name item) "player-om606") | |
| 102 | (string-equal (pathname-name item) "player-om607")) | |
| 103 | (compile&load item)))) | |
| 104 | ((string-equal (pathname-type item) "lisp") | |
| 105 | (unless (or (string-equal (pathname-name item) "player-om607") | |
| 106 | (string-equal (pathname-name item) "player-om608")) | |
| 107 | (compile&load item)))) | |
| 108 | ))) | |
| 109 | ||
| 110 | (recursive-load-files (om-relative-path '("sources") nil) (find-library "OM-SoX")) | |
| 111 | ||
| 112 | ||
| 113 | ; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | |
| 114 | ||
| 115 | (om::fill-library '( | |
| 116 | ;(sub-pack-name subpack-lists class-list function-list class-alias-list) | |
| 117 | ||
| 118 | ("Main functions" nil nil (sox-process sox-analysis) nil) | |
| 119 | ("Statistics" ( | |
| 120 | ("Durations" nil nil (sox-samples sox-duration) nil) | |
| 121 | ("Amplitudes" nil nil (sox-peak-amplitude sox-max-positive-amplitude sox-max-negative-amplitude | |
| 122 | sox-mid-amplitude sox-mean-amplitude sox-mean-norm-amplitude sox-rms-amplitude) nil) | |
| 123 | ("Levels" nil nil (sox-peak-level sox-rms-level sox-rms-peak-level sox-rms-trough-level sox-headroom) nil) | |
| 124 | ("Descriptors" nil nil (sox-fundamental-frequency sox-dc-offset sox-crest-factor sox-flat-factor sox-peak-count sox-dft) nil) | |
| 125 | ("Deltas" nil nil (sox-max-delta-amplitude sox-min-delta-amplitude sox-mean-delta-amplitude sox-rms-delta-amplitude) nil) | |
| 126 | ("Bits" nil nil (sox-bit-depth-ratio sox-scale-factor) nil))) | |
| 127 | ||
| 128 | ("Effects" ( | |
| 129 | ("Editing" nil nil (sox-reverse sox-repeat sox-pad sox-trim sox-voicetrim sox-fade sox-trimsilence) nil) | |
| 130 | ("Modulation" nil nil (sox-tremolo sox-phaser sox-flanger sox-chorus) nil) | |
| 131 | ("Mastering" nil nil (sox-denoise sox-dcremove sox-riaa sox-invert sox-dither) nil ) | |
| 132 | ("Time-Frequency" nil nil (sox-transpose sox-multi-transpose sox-stretch sox-speed) nil) | |
| 133 | ("Delays&Reverbs" nil nil (sox-delay sox-tapdelay sox-reverb sox-convolve) nil) | |
| 134 | ("Filters" nil nil (sox-lowpass sox-highpass sox-band sox-allpass sox-sinc sox-fir sox-shelf-eq sox-peak-eq sox-biquad sox-hilbert) nil) | |
| 135 | ("Dynamics" nil nil (sox-normalize sox-amplitude sox-level sox-compand sox-contrast sox-loudness sox-overdrive) nil)) | |
| 136 | ) | |
| 137 | )) | |
| 138 | ||
| 139 | ||
| 140 | ; %%%%%%%% SPLASH SCREEN %%%%%%%%% | |
| 141 | ||
| 142 | (om-message-dialog (string+ | |
| 143 | "=========================== | |
| 144 | OM-SoX " *om-sox-version*" | |
| 145 | ||
| 146 | http://sourceforge.net/projects/omsox/ | |
| 147 | (c) Marlon Schumacher, 2011-2016 | |
| 148 | ") | |
| 149 | :window-title *om-sox-version* | |
| 150 | ||
| 151 | :size (om-make-point 335 200) | |
| 152 | :position (om-make-point 200 140) | |
| 153 | ) | |
| 154 | ||
| 155 | (format *om-stream* (string+ | |
| 156 | " | |
| 157 | ========================================= | |
| 158 | | OM-SoX "*om-sox-version* | |
| 159 | " | |
| 160 | | ---------------------- | |
| 161 | | Symbolic Multichannel Audio Manipulation and | |
| 162 | | Functional Batch Processing | |
| 163 | | http://sourceforge.net/projects/omsox/ | |
| 164 | | | |
| 165 | | (c) M. Schumacher, CIRMMT/McGill 2011-2016 | |
| 166 | | www.idmil.org/people/marlon_schumacher | |
| 167 | | ALL RIGHTS RESERVED | |
| 168 | | | |
| 169 | | dsp based on SoX - (c) C.Bagwell and Contributors | |
| 170 | | http://sourceforge.net/projects/sox/ | |
| 171 | ========================================= | |
| 172 | ")) | |
| 173 | ||
| 174 | ;%%%%%%%% URLs %%%%%%%%% | |
| 175 | (defmethod! developer-page () | |
| 176 | :icon 98 | |
| 177 | :numouts 0 | |
| 178 | (sys:open-url "http://www.idmil.org/people/marlon_schumacher") | |
| 179 | ) | |
| 180 | ||
| 181 | (defmethod! om-sox-mailing-list () | |
| 182 | :icon 98 | |
| 183 | :numouts 0 | |
| 184 | (sys:open-url "https://lists.sourceforge.net/lists/listinfo/omsox-users") | |
| 185 | ) | |
| 186 | ||
| 187 | (defmethod! gnu-gpl3 () | |
| 188 | :icon 96 | |
| 189 | :numouts 0 | |
| 190 | (sys:open-url "http://www.gnu.org/licenses/gpl-3.0.html") | |
| 191 | ) | |
| 192 | ||
| 193 | (defmethod! om-sox-page () | |
| 194 | :icon 99 | |
| 195 | :numouts 0 | |
| 196 | (sys:open-url "http://sourceforge.net/projects/omsox/") | |
| 197 | ) | |
| 198 | ||
| 199 | (defmethod! sox-html-documentation () | |
| 200 | :icon 08 | |
| 201 | :numouts 0 | |
| 202 | (sys:open-url "http://sox.sourceforge.net/sox.html") | |
| 203 | ) | |
| 204 | ||
| 205 | (defmethod! src.infinitewave.ca () | |
| 206 | :icon 96 | |
| 207 | :numouts 0 | |
| 208 | (sys:open-url "http://src.infinitewave.ca") | |
| 209 | ) | |
| 210 | ||
| 211 | ||
| 212 | ||
| 213 | ||
| 214 | ; Version control | |
| 215 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 216 | ; before committing | |
| 217 | ; (clean-sources *om-sox-lib-path*) | |
| 218 | ||
| 219 | ; Distribution | |
| 220 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 221 | ; generate html reference | |
| 222 | ; (gen-lib-reference "OM-SoX") | |
| 223 | ; before distribution | |
| 224 | ; (clean-repo *om-sox-lib-path*) | |
| 225 | ||
| 226 | (set-lib-release 1.0) | |
| 227 | ;(reset-lib-doc) | |
| 228 | ;(om::set-lib-release 1.0 (find-library "OM-Sox")) | |
| 229 | ||
| 230 | ||
| 231 | (defun clean-sources (&optional dir) | |
| 232 | (let ((src-root (or dir (make-pathname :directory (butlast (pathname-directory *load-pathname*) 2))))) | |
| 233 | (mapc #'(lambda (file) | |
| 234 | (if (system::directory-pathname-p file) | |
| 235 | (clean-sources file) | |
| 236 | (when (and (pathname-type file) | |
| 237 | (or (string-equal (pathname-type file) "xfasl") | |
| 238 | (string-equal (pathname-type file) "fasl") | |
| 239 | (string-equal (pathname-type file) "DS_STORE") | |
| 240 | (string-equal (pathname-type file) "nfasl") | |
| 241 | (string-equal (pathname-type file) "ofasl") | |
| 242 | (string-equal (pathname-type file) "ufasl") | |
| 243 | (string-equal (pathname-type file) "lisp~") | |
| 244 | ;(string-equal (pathname-type file) "html") | |
| 245 | )) ;removes html reference | |
| 246 | (print (concatenate 'string "Deleting " (namestring file) " ...")) | |
| 247 | (delete-file file) | |
| 248 | ))) | |
| 249 | (directory (namestring src-root) :directories t)) | |
| 250 | )) | |
| 251 | ||
| 252 | ||
| 253 | (defun clean-repo (&optional dir) | |
| 254 | (let ((src-root (or dir (make-pathname :directory (butlast (pathname-directory *load-pathname*) 2))))) | |
| 255 | (mapc #'(lambda (file) | |
| 256 | ||
| 257 | (if (system::directory-pathname-p file) | |
| 258 | (if (cond ( | |
| 259 | (string-equal ".git" (car (last (pathname-directory file)))) | |
| 260 | (string-equal ".dropbox" (car (last (pathname-directory file)))) | |
| 261 | (string-equal ".svn" (car (last (pathname-directory file)))) | |
| 262 | (system::call-system (concatenate 'string "rm -Rf \"" (namestring file) "\"")) | |
| 263 | (clean-repo file)) | |
| 264 | (when (and (pathname-type file) | |
| 265 | (or (string-equal (pathname-type file) "xfasl") | |
| 266 | (string-equal (pathname-type file) "fasl") | |
| 267 | (string-equal (pathname-type file) "DS_STORE") | |
| 268 | (string-equal (pathname-type file) "nfasl") | |
| 269 | (string-equal (pathname-type file) "ofasl") | |
| 270 | (string-equal (pathname-type file) "ufasl") | |
| 271 | (string-equal (pathname-type file) "lisp~"))) | |
| 272 | (print (concatenate 'string "Deleting " (namestring file) " ...")) | |
| 273 | (delete-file file) | |
| 274 | )) | |
| 275 | ))) | |
| 276 | (directory (namestring src-root) :directories t)) | |
| 277 | )) | |
| 278 | ||
| 279 | ||
| 280 | ||
| 281 | ||
| 282 | #| | |
| 283 | global audio variables: | |
| 284 | (defvar *audio-sr* 44100) samplerate | |
| 285 | (defvar *audio-res* 16) bitsize | |
| 286 | (defvar *automatic-rename* nil) auto-rename | |
| 287 | (defvar *delete-inter-file* t) | |
| 288 | (defvar *def-snd-format* 'aiff) | |
| 289 | (defvar *normalize* t) | |
| 290 | (defvar *normalize-level* 0.0) | |
| 291 | (defvar *normalizer* :csound) | |
| 292 | |# | |
| 293 | ||
| 294 | ||
