;;; examples of Guile extensions to Snd
;;;
;;;        contents
;;;
;;; snd.html examples made harder to break
;;; autocorrelation
;;; XEmacs-like "Buffers" menu
;;; edit history width via F2 and F3 (global-set-key example)
;;; set fft-size based on current time domain window size



;;; -------- snd.html examples made harder to break --------
;;; this mainly involves keeping track of the current sound/channel

(define region-rms
  (lambda (n)
    (let* ((data (region-samples 0 0 n))
	   (len (length data))
	   (sum 0.0))
      (do ((i 0 (1+ i))) ((= i len) (sqrt (/ sum len)))
	(set! sum (+ sum (* (vector-ref data i) (vector-ref data i))))))))

(define window-samples
  (lambda (snd chn)
    (let ((wl (left-sample snd chn))
	  (wr (right-sample snd chn)))
      (samples wl (+ 1 (- wr wl)) snd chn))))

;;; assume graph call here, so use graph-hook variables
(define display-energy
  (lambda ()
    (let* ((ls (left-sample graph-hook-sound graph-hook-channel))
	   (rs (right-sample graph-hook-sound graph-hook-channel))
	   (data (samples ls (+ 1 (- rs ls)) graph-hook-sound graph-hook-channel))
	   (len (length data))
	   (sr (srate graph-hook-sound)))
      (do ((i 0 (1+ i))) ((= i len))
	(vector-set! data i (* (vector-ref data i) (vector-ref data i))))
      (graph data "energy" (/ ls sr) (/ rs sr) 0.0 (* graph-hook-y1 graph-hook-y1) graph-hook-sound graph-hook-channel))))
      ;; the graph-hook-y1 use causes our energy graph to reflect the vertical sliders

(set! graph-hook "(display-energy)")


(define unsaved-edits?
  (lambda (ind)
    (and (< ind (max-sounds))
	 (or (and (ok? ind)
		  (> (vector-ref (edits ind) 0) 0)
		  (report-in-minibuffer "there are unsaved edits")
		  #t)
	     (unsaved-edits? (+ ind 1))))))

(define no-startup-file?
  (lambda (ind)
    (if (= ind (max-sounds))
	(begin
	  (write (string-append "can't open " open-hook-filename) (current-error-port))
	  (newline (current-error-port))
	  #t)
	(if (ok? ind)
	    #f
	    (no-startup-file? (+ ind 1))))))

(set! start-hook "(if (> (length open-hook-filename) 0)
			       (no-startup-file? 0)
			     #f)")


(define fft-peak
  (lambda ()
    (let ((samps (transform-samples fft-hook-sound fft-hook-channel)))
      (if samps
	  (let* ((len (length samps))
		 (mx (vector-ref samps 0))
		 (peak (do ((i 1 (+ i 1))) ((= i len) (/ (* 2 mx) (fft-size)))
			 (let ((val (abs (vector-ref samps i))))
			   (if (> val mx) (set! mx val))))))
	    (report-in-minibuffer (number->string peak) fft-hook-sound)))
      #f)))
	
(set! fft-hook "(fft-peak)")


;;; -------- Autocorrelation --------
(define window-samples
 (lambda ()
  (let ((wl (left-sample))
        (wr (right-sample)))
   (samples wl (+ 1 (- wr wl))))))

(define autocorrelation
 (lambda ()
  (let* ((data (window-samples))
         (len (length data))
	 (pow2 (ceiling (/ (log len) (log 2))))
	 (fftlen (inexact->exact (expt 2 pow2)))
	 (fftscale (/ 1.0 fftlen))
	 (rl (make-vector fftlen))
	 (im (make-vector fftlen)))
    (do ((i 0 (1+ i))) ((= i fftlen)) (vector-set! rl i 0.0) (vector-set! im i 0.0))
    (do ((i 0 (1+ i))) ((= i len)) (vector-set! rl i (vector-ref data i)))
    (fft rl im 1)
    (do ((i 0 (1+ i))) ((= i fftlen))
      (let ((tempr (vector-ref rl i))
	    (tempi (vector-ref im i)))
	(vector-set! rl i (+ (* tempr tempr) (* tempi tempi)))
	(vector-set! im i 0.0)))
    (fft rl im -1)
    (do ((i 0 (1+ i))) ((= i len)) (vector-set! data i (* (vector-ref rl i) fftscale)))
    (graph data "lag time" 0 len))))

(set! graph-hook "(autocorrelation)")


;;; -------- Buffers Menu --------
;;; patterned after the XEmacs Buffers menu

(define buffer-menu (add-to-main-menu "Buffers"))

(define open-buffer
  (lambda ()
    (add-to-menu buffer-menu 
		 open-hook-filename 
		 (string-append "(select-sound (find-sound " "\"" open-hook-filename "\"" "))"))))

(define close-buffer 
  (lambda ()
    (remove-from-menu buffer-menu (file-name close-hook-sound))))

;;; here we're adding this menu handling code to whatever is already happening at open/close-hook time

(set! open-hook (string-append "(begin " open-hook " (open-buffer))"))
(set! close-hook (string-append "(begin " close-hook " (close-buffer))"))


;;; -------- edit history width via F2 and F3
;;; since this variable is long-winded to type, we want to map F2 to decrement by 30 and F3 to increment by 30
;;; in X11 (/usr/include/X11/keysymdef.h), F2 is 0xFFBF and F3 is 0xFFC0 (F1 is trapped before we see it as "Help").

(global-set-key #xffbf 0 "(set-edit-history-width (max 40 (- (edit-history-width) 30)))")
(global-set-key #xffc0 0 "(set-edit-history-width (min (- (window-width) 30) (+ (edit-history-width) 30)))")


;;; -------- set fft-size based on current time domain window size

(set! graph-hook 
  (string-append 
    "(begin " 
    graph-hook 
    " (if (= (fft-style) normal-fft) 
          (set-fft-size
            (expt 2 (ceiling (/ (log (- (right-sample) (left-sample))) 
                                (log 2.0)))))))"))
