;; My config file for snd.
;; -Kjetil S. Matheussen.


(set! (ladspa-dir) "/usr/lib/ladspa")

;(set! snd-remember-paths #t)

(set! (just-sounds) #t)

#!
(for-each (lambda (hook) (add-hook! hook (lambda args #t)))
	  (list mouse-click-hook
		mouse-enter-graph-hook
		mouse-leave-graph-hook
		mouse-drag-hook
		mouse-press-hook
		mouse-release-hook))
!#

#!
(add-hook! mouse-click-hook
	   (lambda (snd chn button state x y axis)
	     (snd-print (format #f "button: ~A" button))
	     (if (and (= button 2) (= axis time-graph) (selection?))
		 (begin
		   (play-selection)
		   #t)
		 #f)))
!#

;; Set various variables. See Snd documentation.
;(set! (temp-dir) "/lyd/local/tmp")
;(set! (save-dir) "/lyd/local/tmp")

(set! (default-output-srate) 44100)
(set! (default-output-type) mus-riff)
(set! (default-output-chans) 2)
(set! (default-output-format) mus-lfloat)

(set! (show-backtrace) #t)
(set! (show-indices) #t)

; Regions are created when needed when using the ctrl+y and ctrl+w keybindings.
(set! (selection-creates-region) #f)



;; This is the value for the loop-button.
(define islooping #t)


;; Keep track of whether we are playing or not.
;(define initfile-isplaying #f)
;(add-hook! stop-dac-hook (lambda x (set! initfile-isplaying #f) #f))
;(add-hook! dac-hook (lambda x (set! initfile-isplaying #t) #f))


(load-from-path "rgb.scm")

;; Set different color on the cursor for playing and not playing.
(define set-sound-cursor
  (lambda (snd shape)
    (do ((j 0 (1+ j)))
        ((= j (channels snd)) #f)
      (set! (cursor-style snd j) shape))))

(add-hook! start-playing-hook 
	   (lambda (snd) 
	     (set! (cursor-color) yellow)
	     #f))

(set! (cursor-color) blue)
(add-hook! stop-playing-hook
	   (lambda (snd) 
	     (set! (cursor-color) blue)
	     #f))

;; Set different color on the cursor when playing selection.
(add-hook! start-playing-selection-hook
	   (lambda ()
;;	     (display "Start playing selection")(newline)
	     (set! (cursor-color) green)
	     #f))


(add-hook! stop-playing-selection-hook
	   (lambda ()
;;	     (display "Stop playing selection")(newline)
	     (set! (cursor-color) blue)
	     #f))


;; Let the cursor move when playing.
(add-hook! after-open-hook 
	   (lambda (sp)
	     (set! (cursor-follows-play sp) #t)
	     (set-sound-cursor sp cursor-line)
	     #f))


;; Set graph-style to filled.
;(add-hook! after-open-hook (lambda (sp)
(set! (graph-style) graph-filled)


;; I want to remove the region-paste operation done with mouse-button 2, but
;; it doesnt seem to be possible. I also want to make a better selection function,
;; but I can't remove the old function. -Kjetil.
#!
(for-each (lambda (hook) (reset-hook! hook))
	  (list mouse-click-hook
		mouse-enter-graph-hook 
		mouse-leave-graph-hook
		mouse-drag-hook
		mouse-press-hook
		mouse-release-hook))
!#


;; Removes default mouse-click-hook handling. The possibility to paste with
;; mouse-button 2 is really annoying when using a wheel mouse.
(add-hook! mouse-click-hook (lambda (snd chn button state x y axis)
			      #t))




;; Moves the playing position when clicking in the editor if clicking button 1 or 4.
;; Moves cursor and stops playing if clicking buttton 5. (wheel down)
;; Moves cursor and starts playing if clicking button 4. (wheel up)
; -Kjetil.


(if #t

    (add-hook! mouse-click-hook
	       (lambda (snd chn button state x y axis)
		 (if (= axis time-graph)
		     (let ((samp (inexact->exact (* (srate snd) (position->x x snd chn)))))
		       (if (< samp 0) (set! samp 0))
		       (stop-playing)
		       (set! (cursor) samp)
		       (cond ((= button 4)
			      (set! (speed-control) 1)
			      (play samp))
			     ((= button 5)
			      (set! (speed-control) -1)
			      (play samp)))))
		 #f))

    (add-hook! mouse-click-hook
	       (lambda (snd chn button state x y axis)
		 (if (= axis time-graph)
		     (let ((samp (inexact->exact (* (srate snd) (position->x x snd chn)))))
		       (if (< samp 0) (set! samp 0))
		       (if initfile-isplaying
			   (if (or (= button 1) (= button 4) (= button 5))
			       (begin
				 (stop-playing)
				 (if (not (= button 5))
				     (play samp))))
			   (if (= button 4)
			       (begin
				 (play samp))))))
		 #f)))





;(define (play-selection-with-play)
;  (play (selection-position) #f #f #f (+ (selection-position) (selection-frames))))

(define (my-play-selection2)
  (if islooping
      (play-selection)
      (remove-hook! stop-playing-selection-hook my-play-selection2))
  #f)

(define (my-play-selection)
  (if islooping
      (add-hook! stop-playing-selection-hook my-play-selection2))
  (play-selection))

(define (my-play2 snd)
  (if islooping
      (play)
      (remove-hook! stop-playing-hook my-play2))
  #f)

(define (my-play pos)
  (if islooping
      (add-hook! stop-playing-hook my-play2))
  (play pos))

(define (my-stop-playing)
  (remove-hook! stop-playing-selection-hook my-play-selection2))


;; Replace the old space binding with one that starts playing from the current cursor position,
;; all channels. And stops playing if already playing. -Kjetil.
(bind-key (char->integer #\ ) 0 
	  (lambda ()
	    (if (dac-is-running)
		(begin
		  (remove-hook! stop-playing-selection-hook my-play-selection2)
		  (remove-hook! stop-playing-hook my-play2)
		  (stop-playing))
		(if (selection-member? (selected-sound))
		    (my-play-selection)
		    (my-play (cursor))))))
;		    (play-selection-with-play)
;		    (play (cursor))))))

;; Makes the P key a pause button. If playing, stops playing, but doesnt reset the cursor pos.
;; If not playing, starts playing from cursor. -Kjetil.
(bind-key (char->integer #\p) 0 
	  (lambda ()
	    (let ((cursor-pos (cursor)))
	      (if (dac-is-running)
		  (begin
		    (stop-playing)
		    (set! (cursor) cursor-pos)
		    (let ((syncnum (sync)))
		      (set! (sync) 0)
		      (set! (sync) syncnum))
		    (update-time-graph))
		  (play (cursor))))))


;; Let the "a" key be a "show-all" key.
(bind-key (char->integer #\a) 0
	  (lambda ()
	    (set! (x-bounds) (list 0.0 (/ (frames) (srate))))))


;; Let the "s" key be a "show-selection" key.
(bind-key (char->integer #\s) 0
	  (lambda ()
	    (set! (x-bounds) (list (/ (selection-position) (srate))
				   (/ (+ (selection-position) (selection-frames)) (srate))))))




(load-from-path "draw.scm")


;; ;;; Set some colors

;; Bacground
(let ((backgroundcolor  (make-color 0.8 0.8 0.78)))
  (set! (selected-graph-color) backgroundcolor)
  (set! (graph-color) backgroundcolor))

;; Selection
;;(set! (selection-color) (make-color 0.5 0.6 0.4))
;;(set! (selection-color) (make-color 0.78 0.87 0.85))
(set! (selection-color) white)

;(set! (cursor-color) green)

;(set! (basic-color) (make-color 0.95 0.95 0.92))



;; Replace the old C-y and C-w keybindings. These are equal, but writes
;; "Please wait" to the minibuffer, and colorize the inserted region.


(define iscolorized #f)

(define (color-samples-allchans chans color start end)
  (if (> chans 0)
      (begin
	(if (eq? color 'black)
	    (uncolor-samples (selected-sound) (- chans 1))
	    (color-samples color start end (selected-sound) (- chans 1)))
	(color-samples-allchans (- chans 1) color start end))))

;; Fix mouse-selection handling.

(define region-generation 0)
(define last-region-generation 0)

(begin
  (define selection-starting-point #f)

  (define (mouse-press-callback w context ev flag)
    (let* ((x (.x ev))
	   (snd (selected-sound))
	   (chn (selected-channel))
	   (samp (inexact->exact (* (srate snd) (position->x x snd chn)))))
      (if (< samp 0) (set! samp 0))
      (set! selection-starting-point samp)))
  
  (define (mouse-release-callback w context ev flag)
    (let* ((x (.x ev))
	   (snd (selected-sound))
	   (chn (selected-channel))
	   (samp (inexact->exact (* (srate snd) (position->x x snd chn)))))
      (if (< samp 0) (set! samp 0))
      (set! selection-starting-point #f)))
  
  (define (mouse-motion-callback w context ev flag)
    (let* ((x (.x ev))
	   (snd (selected-sound))
	   (chn (selected-channel))
	   (samp (inexact->exact (* (srate snd) (position->x x snd chn)))))
      (if (< samp 0) (set! samp 0))
      (if (not (= samp selection-starting-point))
	  (begin
	    (set! region-generation (+ region-generation 1))
	    (if (< samp selection-starting-point)
		(begin
		  (set! (selection-position) samp)
		  (set! (selection-frames) (- selection-starting-point samp)))
		(begin
		  (set! (selection-position) selection-starting-point)
		  (set! (selection-frames) (- samp selection-starting-point))))))))
  
  (add-hook! after-open-hook
	     (lambda (snd)
	       (XtAddEventHandler (list-ref (channel-widgets snd 0) 0) ButtonPressMask #f 
				  mouse-press-callback)
	       (XtAddEventHandler (list-ref (channel-widgets snd 0) 0) ButtonMotionMask #f 
				  mouse-motion-callback)
	       (XtAddEventHandler (list-ref (channel-widgets snd 0) 0) ButtonReleaseMask #f 
				  mouse-release-callback))))



(define (my-make-region)
  (if (not (selection-creates-region))
      (if (> region-generation last-region-generation)
	  (begin
	    (set! last-region-generation region-generation)
	    (make-region)))))

(bind-key (char->integer #\r) 0
	  my-make-region)

(bind-key (char->integer #\y) 4
	  (lambda ()
	    (if (selection-member? (selected-sound))
		(my-make-region))
	    (if (> (length (regions)) 0)
		(begin
		  (report-in-minibuffer "Please wait...")
		  (color-samples-allchans (channels) 'black 0 0)
		  (let ((length (region-frames))
			(curspos (cursor)))
		    (if (> length 5000000)
			(begin
			  (set! (with-background-processes) #f) ;; To prevent using horrible long time, and the little picture not to update properly.
			  (insert-region curspos)
			  (set! (with-background-processes) #t))
			(insert-region curspos)) ;; The little picture might not update properly. But turning off background-processes slows down pasting of small regions a lot.
		    (if (> (sync) 0)
			(color-samples-allchans (channels) green curspos (region-frames))
			(color-samples green curspos (region-frames)))
		    (set! iscolorized #t)
		    (update-time-graph)
		    (show-time-in-minibuffer curspos))))))

(bind-key (char->integer #\w) 4
	  (lambda ()
	    (report-in-minibuffer "Please wait...")
	    (let ((curspos (selection-position)))
	      (color-samples-allchans (channels) 'black 0 0)
	      (set! (cursor #t #t) curspos)
	      (my-make-region)
	      (delete-selection)
	      (set! iscolorized #f)
	      (show-time-in-minibuffer curspos))))

#!
(add-hook! mouse-click-hook
	   (lambda (snd chn button state x y axis)
	     (if iscolorized
		 (begin
		   (color-samples-allchans (channels) 'black 0 0)
		   (set! iscolorized #f)))
	     #f))
		 
!#

;; Show cursor position in minutes and seconds in the minibuffer. -Kjetil.
(define last-time-showed 0)
(define (show-time-in-minibuffer dastime)
  (if (>= (abs (- dastime last-time-showed)) (/ (srate (selected-sound)) 10))
      (let* ((time (/ (floor (* 10 (/ dastime (srate (selected-sound))))) 10))
	     (minutes (inexact->exact (floor (/ time 60))))
	     (seconds (/ (floor (* 10 (- time (* minutes 60)))) 10)))
	(if (< minutes 10)
	    (report-in-minibuffer (string-append " 0" (number->string minutes) ":" (number->string seconds)))
	    (report-in-minibuffer (string-append " " (number->string minutes) ":" (number->string seconds))))
	(set! last-time-showed dastime))))


;; Show the time in the minibuffer when playing
(add-hook! play-hook
	   (lambda (samples)
	     (show-time-in-minibuffer (cursor))
	     #f))

; Show the time in the minibuffer when clicking.
(add-hook! mouse-click-hook
	   (lambda args
	     (show-time-in-minibuffer (cursor))
	     #f))

; This one don't work.
;(add-hook! mouse-drag-hook
;	   (lambda (snd chn button state x y)
;	     (let ((samp (inexact->exact (* (srate snd) (position->x x snd chn)))))
;	       (display "asdf")(newline)
;	       (show-time-in-minibuffer samp)) #f))




;; Shows the full sound after opening.
(add-hook! after-open-hook
	   (lambda (n) (set! (x-bounds) (list 0.0 (/ (frames) (srate)))) #f))


;; Equalize panes if more than 3 channels. I think. Hmm, can't
;; remember where I got this one from. Nah, doesn't hurt. -Kjetil.
;;(add-hook! after-open-hook 
;;  (lambda (n) (if (> (channels n) 3) (equalize-panes)) #f))





;; Doing several things after opening a file.
;; -Sync and Unite newly loaded files by default.
;;  The sync value should be unique for each sound.
;; -Replace the sync button with a new one that uses get-unique-sync-num
;;  as the sync-number. Simply using (+ 1 snd) doesn't work when a sound is closed
;;  in certain situations.
;; -Remove the play button. Its useless now with the way p and space is configured.
;; -Added a loop button where the play button was.

(define unique-sync-num 0)
(define (get-unique-sync-num)
  (set! unique-sync-num (+ unique-sync-num 1))
  unique-sync-num)

(add-hook! after-open-hook
	   (lambda (snd)
	     (let* ((oldplay (find-child (list-ref (sound-widgets snd) 2) "play"))
		    (playpos (widget-position oldplay)))
	       
	       (let ((loop (XtCreateManagedWidget "loop" xmToggleButtonWidgetClass (XtParent oldplay)
						  (list XmNbackground       (basic-color)
							XmNset              islooping
							XmNx                (car playpos)
							XmNselectColor      (yellow-pixel)))))
		 (XtAddCallback loop
				XmNvalueChangedCallback
				(lambda (w c i)
				  (if (.set i)
				      (begin
					(set! islooping #t)
					(display "setting to 1++")(newline))
				      (begin 
					(set! islooping #f)
					(display "setting to 0")(newline)))
				  (for-each (lambda (s)
					      (if (not (= s snd))
						  (XtSetValues (find-child (list-ref (sound-widgets s) 2) "loop")
							       (list XmNset islooping))))
					    (sounds))
				  (focus-widget (list-ref (channel-widgets snd 0) 0)))))
	       (XtUnmanageChild oldplay))
	     
	     (if (> (channels snd) 1)
		 (set! (channel-style snd) channels-combined))
	     (set! (sync snd) (get-unique-sync-num))
	     
	     
	     (let* ((oldsync (find-child (list-ref (sound-widgets snd) 2) "sync"))
		    (syncpos (widget-position oldsync)))
	       
	       (let ((newsync (XtCreateManagedWidget "sync" xmToggleButtonWidgetClass (XtParent oldsync)
						     (list XmNbackground       (basic-color)
							   XmNset              #t
							   XmNx                (car syncpos)
							   XmNselectColor      (yellow-pixel)))))
		 (XtAddCallback newsync
				XmNvalueChangedCallback
				(lambda (w c i)
				  (if (.set i)
				      (begin
					(display "setting to 1++")(newline)
					(set! (sync snd) (get-unique-sync-num)))
				      (begin 
					(display "setting to 0")(newline)
					(set! (sync snd) 0)))
				  (focus-widget (list-ref (channel-widgets snd 0) 0)))))
	       (XtUnmanageChild oldsync))
	     #f))






;;"various generally useful Snd extensions". See source.
(load-from-path "extensions.scm")

;; When exiting.
(check-for-unsaved-edits #t)



;; "Easy edit". See source. -Kjetil.
;;(load-from-path "edit123.scm")



;;(load-from-path "dsp.scm")


;;(load-from-path "snd-motif.scm")

(define (Widget wid) (if (list? wid) wid (list 'Widget wid)))
(load-from-path "edit-menu.scm")

;; Shows an envelope editor for each channel. Didn't understand how to use it, and it segfaulted. -Kjetil.
;;(load-from-path "enved.scm")
;;(start-enveloping)



(load-from-path "examp.scm")


;;;;;;;;;;;;;;;;;
;; Makes the buffer-menu a bit more pleasent to use. -Kjetil.
;;;;;;;;;;;;;;;;
(set! last-height 800)
(set! last-width 800)

(define (my-open-buffer filename)
  "(open-buffer filename) adds a menu item that will select filename (use with open-hook)"
  (if (member filename (map (lambda (snd) (file-name snd))
			    (sounds)))
      #t
      (begin
	(add-to-menu buffer-menu 
		     filename 
		     (lambda () ((switch-to-buf) filename)))
	#f)))


(define buffer-menu (add-to-main-menu "Buffers"))
(add-hook! open-hook my-open-buffer)
(add-hook! close-hook close-buffer)
(bind-key (char->integer #\b) 0 (lambda (x) (switch-to-buf)))
(add-hook! close-hook xb-close)
(add-hook! after-open-hook xb-open)	    


(define (first-time-open-soundfile . args)
  (set! (window-width) 800)
  (set! (window-height) 800)
  (remove-hook! open-hook first-time-open-soundfile)
  #f)

(add-hook! open-hook first-time-open-soundfile)



;;Show the little picture of the whole sound in the upper right corner.
(load-from-path "draw.scm")
;;(load "/home/kjetil/snd/draw.scm")
(make-current-window-display)

;; The background-process slows things down when the little picture is active and loading large files.
;; Better turn off the background-process when loading. -Kjetil.
(add-hook! open-hook (lambda args (set! (with-background-processes) #f) #f))
(add-hook! after-open-hook (lambda args (set! (with-background-processes) #t) #f))




; Would be nice, perhaps, but prints out a lot of error messages. -Kjetil.
;;(if-cursor-follows-play-it-stays-where-play-stopped #t)





;; Adds a lot of things when pressing the right mouse button. Very nice. -Kjetil.
(load-from-path "popup.scm")


;; Adds the "Effects" menu. Very very Nice. -Kjetil.
;;(load-from-path "new-effects.scm")


;; My ladspa menu stuff. -Kjetil.
;;(load "/hom/kjetism/snd/ladspa2.scm")
(load-from-path "ladspa.scm")


; Lots of functions. But I Don't understand what they do. -Kjetil.
;;(load-from-path "marks.scm")


; "provide pop-up help in the Files viewer". Didn't see any pop-up help. -Kjetil.
;;(load-from-path "nb.scm")



;; Stores the peak information for sounds in the ~/peaks/ directory. Seems to work correctly. I have tried
;; to fool it in many ways, but it seems to be very intelligent. Extremely nice. -Kjetil.
;; The point is to decrease the loading time.
; First make sure the peaks directory is present
(system (string-append "mkdir " (getenv "HOME") "/peaks >/dev/null 2>/dev/null"))
; Then load
(load-from-path "peak-env.scm")


(load-from-path "snd-motif.scm")

;; Shows diskspace for the partition the opened sound was placed on. -Kjetil.
(add-hook! after-open-hook show-disk-space)

;; Add extra control for the controls dialog. -Kjetil.
(make-hidden-controls-dialog)

;; Add rename option to the file menu. -Kjetil.
(add-rename-option )


;; Dave Phillips fft-menu. (Loads an incompatible make-effect-dialog function)
;(load-from-path "dlp/fft-menu.scm")

;; Dave Phillips panic-menu
(load-from-path "dlp/panic.scm")

;; Dave Phillips special-menu
(load-from-path "dlp/special-menu.scm")

;;(load-from-path "dlp/plugins-menu.scm")


;; All of Dave Phillips nice things.
;; Uncomment to try. (Most of it is allready present)
;;(load-from-path "dlp/misc.scm")



(define (open-sounds-filename)
  (string-append (getenv "HOME") "/.snd_soundfilelist"))


;; Save all filenames when exiting.
(define (save-all-filenames filename)
  (let ((fd (open-file filename "w")))
    (for-each (lambda (snd)
		(write-line (file-name snd) fd))
	      (reverse (sounds)))
    (close fd)))

(add-hook! exit-hook (lambda args
		       (save-all-filenames (open-sounds-filename))
		       #f))
				   


;; Load files from previous session.

(system (string-append "touch " (open-sounds-filename) " >/dev/null 2>/dev/null"))
(let ((fd (open-file (open-sounds-filename) "r")))
  (define (myread)
    (let ((line (read-line fd)))
      (if (not (eof-object? line))
	  (begin
	    (open-sound line)
	    (myread)))))
  (myread))




;; Need to update the loop button when switching buffer. (Done in the callback-function instead)
;(add-hook! after-graph-hook
;	   (lambda (snd chn)
;	     (XtSetValues (find-child (list-ref (sound-widgets snd) 2) "loop")
;			  (list XmNset islooping))))