;;; -*- 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
;;;                   <time-interval> 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
