;;; backwards compatibility for snd 11


;;; -------- with-mix --------
;;;
;;; weird syntax = with-mix (with-sound-args) file-name start-in-output &body body
;;;
;;; (with-sound () 
;;;   (with-mix () "section-1" 0 (fm-violin 0 1 440 .1)
;;;                              (fm-violin 1 2 660 .1))
;;; ...)

(define (with-mix-find-file-with-extensions file extensions)
  "(with-mix-find-file-with-extensions file extensions) helps the with-mix macro find checkpoint files"
  (if (file-exists? file)
      file
      (call-with-exit
       (lambda (found-one)
	 (for-each
	  (lambda (ext)
	    (let ((new-file (string-append file "." ext)))
	      (if (file-exists? new-file)
		  (found-one new-file))))
	  extensions)
	 #f))))

(define (with-mix-file-extension file default)
  "(with-mix-file-extension file default) is a helper function for the with-mix macro"
  (let ((len (string-length file)))
    (call-with-exit
     (lambda (ok)
       (do ((i (- len 1) (- i 1)))
	   ((= i 0))
	 (if (char=? (string-ref file i) #\.)
	     (ok (substring file (+ 1 i) len))))
       default))))

(defmacro with-mix (options ur-chkpt-file ur-beg . body)
  `(let ((chkpt-file ,ur-chkpt-file)
	 (beg-1 ,ur-beg))
     (if (not (list? ',options))
	 (throw 'with-sound-interrupt (format #f "with-mix options list (arg 1) is ~A?~%;" ',options))
	 (if (not (string? chkpt-file))
	     (throw 'with-sound-interrupt (format #f "with-mix file (arg 2) is ~A?~%;" ,ur-chkpt-file))
	     (if (not (number? beg-1))
		 (throw 'with-sound-interrupt (format #f "with-mix begin time (arg 3) for ~S = ~A?~%;" chkpt-file beg-1))
		 (let ((beg (round (* (mus-srate) beg-1))))
		   (if (null? ',body)
		       (mus-mix *output* chkpt-file beg)
		       (let* ((call-str (object->string ',body))
			      (option-str (object->string ',options))
			      (sndf (with-mix-find-file-with-extensions chkpt-file (list (with-mix-file-extension *clm-file-name* "snd") "snd")))
			      (revf (and sndf *reverb* (with-mix-find-file-with-extensions chkpt-file (list "rev"))))
			      (mix-values (and sndf
					       (or (not *reverb*)
						   revf)
					       (let ((comment (mus-sound-comment sndf)))
						 (and (string? comment)
						      (catch #t
							     (lambda ()
							       (eval-string comment))
							     (lambda args #f))))))) ; any error means we lost
			 (if (and sndf
				  (or (not *reverb*)
				      revf)
				  (list? mix-values)
				  (= (length mix-values) 2)
				  (string? (car mix-values))
				  (string? (cadr mix-values))
				  (string=? (car mix-values) option-str)
				  (string=? (cadr mix-values) call-str))
			     (begin
			       (if *clm-verbose* (snd-print (format #f "mix ~S at ~,3F~%" sndf beg)))
			       (mus-mix *output* sndf beg)
			       (if revf (mus-mix *reverb* revf beg)))
			     ;; else recompute
			     (let ((old-to-snd *to-snd*))
			       (set! *to-snd* #f)
			       (if *clm-verbose* (snd-print (format #f "remake ~S at ~,3F~%" chkpt-file beg)))
			       (let ((new-sound 
				      (apply with-sound-helper 
					     (lambda () ,@body) 
					     (append (list :output 
							   (string-append chkpt-file "." (with-mix-file-extension *clm-file-name* "snd")))
						     (list :comment 
							   (format #f "(begin~%;; written ~A (Snd: ~A)~%(list ~S ~S))~%"
								   (strftime "%a %d-%b-%Y %H:%M %Z" (localtime (current-time)))
								   (snd-version)
								   option-str
								   call-str))
						     (if (and (> (channels *output*) 1)
							      (not (member :channels ',options)))
							 (list :channels (channels *output*))
							 '())
						     ',options))))
				 (set! *to-snd* old-to-snd)
				 (mus-mix *output* new-sound beg)
				 (if revf (mus-mix *reverb* revf beg)))))))))))))


#|
;;; this is the with-mix documentation:

<br>
<table border=0 bordercolor="lightgreen" width=50% cellpadding=1 cellspacing=0><tr><td bgcolor="lightgreen">
<table width=100% border=0><tr><td bgcolor="#EEFDEE" valign="middle"><h4>with-mix</h4></td></tr></table>
</td></tr></table>

<p><a name="with-mix">with-mix</a> is a "checkpointing" version of with-sound, more useful in the bad old days when computers
were incredibly slow, but lingering on...
It is a macro, callable within <a href="#wsdoc">with-sound</a> or <a href="#clmload">clm-load</a>,
which saves the computation in its body in a separate file, and
then upon a subsequent recomputation, tries to tell (via a string comparison) when that file's data is up to date
and does not need to be recomputed.
</p>

<table border=0 hspace=40 cellpadding=8 cellspacing=3><tr><td>
<pre>
(<a class=quiet href="#wsdoc" onmouseout="UnTip()" onmouseover="Tip(sndscm_wsdoc_tip)">with-sound</a> () 
  (fm-violin 0 .1 440 .1)
  (<em class=red>with-mix</em> () "sec1" .5 
    (fm-violin 0 .1 550 .1)
    (fm-violin .1 .1 660 .1))
  (<em class=red>with-mix</em> (:reverb jc-reverb) "sec2" 1.0
    (fm-violin 0 .1 880 .1 :reverb-amount .2)
    (fm-violin .1 .1 1320 .1 :reverb-amount .2))
  (fm-violin 2 .1 220 .1)
  (<em class=red>mix</em> "/zap/slow.snd"))
</pre>
</td></tr></table>

<p>Now, if we change just the first note in the with-mix call, the
second with-mix section will not be recomputed, but will be mixed in from the
saved file "sec2.snd".
In the old days, when notes took hours to compute, this was a big deal,
but not anymore.
</p>

|#

;;; --------------------------------------------------------------------------------


(define (focus-follows-mouse) (set! (with-pointer-focus) #t))
(define (make-current-window-display) (set! (with-inset-graph) #t))
(define load-from-path load)
;(define def-optkey-fun define*)
;(define def-optkey-instrument definstrument)

(define spectro-cutoff spectrum-start)
(define spectro-end spectrum-end)



(define* (play-region reg wait stop-func)
  (play (if (integer? reg) (integer->region reg) reg) :wait wait :stop stop-func))

(define* (play-selection wait stop-func)
  (play (selection) :wait wait :stop stop-func))

(define* (play-mix id (beg 0))
  (play (if (integer? id) (integer->mix id) id) beg))

(define* (play-and-wait (start 0) snd chn syncd end (pos -1) stop-proc)
  (if (string? start)
      (play start (or snd 0) :end (or chn -1) :wait #t) 
      (play (if (integer? snd) (integer->sound snd)
		(if (sound? snd) snd
		    (or (selected-sound) (car (sounds)))))
	    :channel (or chn -1) :wait #t :with-sync syncd :start start :end (or end -1) 
	    :stop stop-proc :edit-position pos)))

(define* (old-play (start 0) snd chn syncd end (pos -1) stop-proc (out-chan -1))
  (play (if (integer? snd) (integer->sound snd)
	    (if (sound? snd) snd
		(or (selected-sound) (car (sounds)))))
	:channel (or chn -1) :with-sync syncd :start start :end (or end -1) 
	:stop stop-proc :out-channel out-chan :edit-position pos))

(define* (play-channel (beg 0) dur snd chn (pos -1) stop-proc (out-chan -1))
  (play (if (integer? snd) (integer->sound snd)
	    (if (sound? snd) snd
		(or (selected-sound) (car (sounds)))))
	:channel (or chn -1) :with-sync #f :start beg :end (if dur (+ beg dur) -1) 
	:stop stop-proc :out-channel out-chan :edit-position pos))

