;;; -*- syntax: common-lisp; package: clm; base: 10; mode: lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; File: track-rms.ins ;;; ;;; Purpose: Prints out the rms of a soundfile at an interval of every ;;; seconds. Also prints decibel values on a ;;; scale up to 0 dB. ;;; ;;; Author: Michael Edwards - m@michael-edwards.org ;;; ;;; $$ Last modified: 10:29:12 Tue Jul 5 2011 BST ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; (def-clm-struct amps (scaled 0) (db 0)) (def-clm-struct extreme rms (time1 0.0) (time2 0.0)) (defvar *lowest-rms-period*) (defvar *highest-rms-period*) (defconstant +lowest-db-value+ -96.3296) (defmacro track-rms-amp-to-db (amp) `(if (zerop ,amp) +lowest-db-value+ (* 20 (log (abs ,amp) 10)))) (defmacro set-amps-struct (val struc) `(setf (amps-scaled ,struc) ,val (amps-db ,struc) (track-rms-amp-to-db ,val))) (defmacro calc-and-print (sum sumsq max min scount time1 time2 do-extremes rms-struc max-struc min-struc print) `(let* ((mean (/ ,sum ,scount)) (meansq (/ ,sumsq ,scount)) (var (- meansq (* mean mean))) (rms (sqrt var))) (set-amps-struct rms ,rms-struc) (set-amps-struct ,max ,max-struc) (set-amps-struct ,min ,min-struc) (when ,do-extremes (when (> rms (extreme-rms *highest-rms-period*)) (setf (extreme-rms *highest-rms-period*) rms (extreme-time1 *highest-rms-period*) time1 (extreme-time2 *highest-rms-period*) time2)) (when (and (> rms 0.0) (< rms (extreme-rms *lowest-rms-period*))) (setf (extreme-rms *lowest-rms-period*) rms (extreme-time1 *lowest-rms-period*) time1 (extreme-time2 *lowest-rms-period*) time2))) (when print (clm-print "~% *** Time ~,4f seconds to ~,4f seconds: ***~%" ,time1 ,time2) (clm-print "RMS = ~f (~f dB)~%" (amps-scaled rms-struc) (amps-db rms-struc)) (clm-print "Mean = ~f~%" mean) (clm-print "Max = ~f (limit = 1.0) (~f dB)~%" (amps-scaled max-struc) (amps-db max-struc)) (clm-print "Min = ~f (limit = -1.0) (~f dB)" (amps-scaled min-struc) (amps-db min-struc))))) (definstrument track-rms (file &key (print t) (time-interval 1.0)) (setq *lowest-rms-period* (make-extreme :rms 1.0) *highest-rms-period* (make-extreme :rms 0.0)) (let* ((f (open-input* file)) (samples (sound-samples f)) (srate (sound-srate f)) (dur (/ samples srate)) (ch (sound-chans f)) (stereo? (= ch 2)) (quad? (= ch 4)) (rda (make-readin :file f)) (rdb (when stereo? (make-readin :file f :channel 1))) (rdc (when quad? (make-readin :file f :channel 2))) (rdd (when quad? (make-readin :file f :channel 3))) (interval-samples (* time-interval srate)) (next-print interval-samples) (rms-struc (make-amps)) (max-struc (make-amps)) (min-struc (make-amps)) (max -1.0) (min 1.0) (all-max -1.0) (all-min 1.0) (sum 0.0) (sumsq 0.0) (all-sum 0.0) (all-sumsq 0.0) (time1 0.0) (time2 time-interval) temp1 temp2) (macrolet ;; macro to do the incrementing and checking for each sample, i.e. each ;; channel. ((do-incs (rd) `(progn (setq temp1 (readin ,rd) temp2 (* temp1 temp1)) (incf sum temp1) (incf all-sum temp1) (incf sumsq temp2) (incf all-sumsq temp2) (when (< max temp1) (setq max temp1)) (when (> min temp1) (setq min temp1))))) (run* (all-sum all-sumsq all-max all-min rms-struc max-struc min-struc *lowest-rms-period* *highest-rms-period*) (loop for i below samples do (do-incs rda) (when stereo? (do-incs rdb)) (when quad? (do-incs rdc) (do-incs rdd)) (when (= i next-print) (calc-and-print sum sumsq max min interval-samples time1 time2 t rms-struc max-struc min-struc print)) (setq time1 time2) (incf time2 time-interval) (when (< all-max max) (setq all-max max)) (when (> all-min min) (setq all-min min)) (incf next-print interval-samples) (setq sum 0.0 sumsq 0.0 max -1.0 min 1.0)))) (calc-and-print sum sumsq max min (- interval-samples (- next-print samples)) time1 dur (if (zerop (extreme-rms *highest-rms-period*)) t nil) rms-struc max-struc min-struc print) (when print (format t "~% ******** Overall values: **********")) (calc-and-print all-sum all-sumsq all-max all-min samples 0.0 dur nil rms-struc max-struc min-struc print) (when print (format t "~%*** Lowest RMS is ~f (~f dB) (between time ~,4f and time ~ ~,4f--silent sections and final section ignored)." (extreme-rms *lowest-rms-period*) (track-rms-amp-to-db (extreme-rms *lowest-rms-period*)) (extreme-time1 *lowest-rms-period*) (extreme-time2 *lowest-rms-period*)) (format t "~%*** Highest RMS is ~f (~f dB) (between time ~,4f and ~ time ~,4f).~%~%" (extreme-rms *highest-rms-period*) (track-rms-amp-to-db (extreme-rms *highest-rms-period*)) (extreme-time1 *highest-rms-period*) (extreme-time2 *highest-rms-period*))) (close-input f) (values (amps-scaled rms-struc) (amps-scaled rms-struc)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; #| (track-rms "/music/magda/magda-bmic.wav") |# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; EOF track-rms.ins