;;; Miscellaneous routines for use in a classroom demo.

(library (local aux)

  (export pi noise-clamp hann apply-hann-window
          extract-from-left-channel
          extract-from-right-channel
          samples->reals)

  (import (rnrs))

(define pi (acos -1.0))

(define eps 1e-6)

(define (noise-clamp z)
  (cond ((< (magnitude z) eps)
         0.0)
        ((< (abs (real-part z)) eps)
         (imag-part z))
        ((< (abs (imag-part z)) eps)
         (real-part z))
        (else z)))

(define (hann n N)
  (let ((x (sin (/ (* pi n) (- N 1)))))
    (* x x)))

(define (apply-hann-window v)
  (let* ((N (vector-length v))
         (v2 (make-vector N 0.0)))
    (do ((i 0 (+ i 1)))
        ((= i N)
         v2)
      (vector-set! v2 i (* (hann i N) (vector-ref v i))))))

(define (extract-from-left-channel bv start end)
  (extract-channel bv start end))

(define (extract-from-right-channel bv start end)
  (extract-channel bv (+ start 2) end))

(define (extract-channel bv0 start end)
  (let ((bv (make-bytevector (div (- end start) 2))))
    (do ((i 0 (+ i 2))
         (j start (+ j 4)))
        ((>= j end))
      (bytevector-s16-set! bv
                           i
                           (bytevector-s16-ref bv0 j 'little)
                           'little))
    bv))

(define (samples->reals bv)
  (let* ((n (bytevector-length bv))
         (v (make-vector (div n 2) 0.0)))
    (do ((i 0 (+ i 2))
         (j 0 (+ j 1)))
        ((>= i n))
      (let ((x (bytevector-s16-ref bv i 'little)))
        (vector-set! v j (/ x 32768.0))))
    v))

)