(load "/home/dlphilp/snd-5/snd-motif.scm")
;;; (load "/home/dlphilp/snd-5/effects.scm")
(load "/home/dlphilp/snd-5/examp.scm")
(load "/home/dlphilp/snd-5/extensions.scm")
(load "/home/dlphilp/snd-5/dsp.scm")
(load "/home/dlphilp/snd-5/draw.scm")
(load "/home/dlphilp/snd-5/env.scm")
(load "/home/dlphilp/snd-5/enved.scm")
(load "/home/dlphilp/snd-5/marks.scm")
(load "/home/dlphilp/snd-5/mix.scm")
(load "/home/dlphilp/snd-5/moog.scm")
(load "/home/dlphilp/snd-5/popup.scm")
(load "/home/dlphilp/snd-5/rubber.scm")
(load "/home/dlphilp/my_scm/special-menu.scm") 
;;; (load "/home/dlphilp/my_scm/my_popup.scm") 
(load "/home/dlphilp/my_scm/my_backgrounds.scm") 
(load "/home/dlphilp/my_scm/marks-menu.scm") 
(load "/home/dlphilp/my_scm/new-effects.scm") 
(load "/home/dlphilp/my_scm/panic.scm") 

(title-with-date)
(keep-file-dialog-open-upon-ok)
(make-hidden-controls-dialog)
(check-for-unsaved-edits #t)
(add-hook! after-open-hook show-disk-space)

(define wd (make-pixmap (|Widget (cadr (main-widgets))) rough))
(for-each-child (|Widget (cadr (main-widgets))) (lambda (w) (|XtSetValues w (list |XmNbackgroundPixmap wd))))

;;; (with-level-meters 2)

(add-mark-pane)

(add-sound-file-extension "sf")
(add-sound-file-extension "SF2")
(add-sound-file-extension "mp3")
(add-sound-file-extension "MP3")
(add-sound-file-extension "W01")
(add-sound-file-extension "W02")
(add-sound-file-extension "W03")
(add-sound-file-extension "W04")
(add-sound-file-extension "W05")
(add-sound-file-extension "W06")
(add-sound-file-extension "W07")
(add-sound-file-extension "W08")
(add-sound-file-extension "W09")

; (add-very-useful-icons)

;;;
;;; main menu additions
;;;

;;; -------- add delete and rename options to the file menu

(define (add-delete-option)
  (add-to-menu 0 "Delete" ; add Delete option to File menu
	       (lambda ()
		 ;; close current sound and delete it (after requesting confirmation)
		 (if (>= (selected-sound) 0)
		     (let ((filename (file-name)))
		       (close-sound)
		       (if (yes-or-no? (format #f "delete ~S?" filename))
			   (delete-file filename)))))
	       8)) ; place after File:New

(define (add-rename-option)
  (let ((rename-dialog #f)
	(rename-text #f))
    (add-to-menu 0 "Rename" 
      (lambda ()
	;; open dialog to get new name, save-as that name, open
	(if (not rename-dialog)
	    ;; make a standard dialog
	    (let* ((xdismiss (|XmStringCreate "Dismiss" |XmFONTLIST_DEFAULT_TAG))
		   (xhelp (|XmStringCreate "Help" |XmFONTLIST_DEFAULT_TAG))
		   (xok (|XmStringCreate "DoIt" |XmFONTLIST_DEFAULT_TAG))
		   (titlestr (|XmStringCreate "Rename" |XmFONTLIST_DEFAULT_TAG))
		   (new-dialog (|XmCreateTemplateDialog
				 (|Widget (cadr (main-widgets))) "Rename"
				 (list |XmNcancelLabelString   xdismiss
				       |XmNhelpLabelString     xhelp
				       |XmNokLabelString       xok
				       |XmNautoUnmanage        #f
				       |XmNdialogTitle         titlestr
				       |XmNresizePolicy        |XmRESIZE_GROW
				       |XmNnoResize            #f
				       |XmNbackground          (|Pixel (snd-pixel (basic-color)))
				       |XmNtransient           #f))))
	      (for-each
	       (lambda (button)
		 (|XtVaSetValues
		   (|XmMessageBoxGetChild new-dialog button)
		   (list |XmNarmColor   (|Pixel (snd-pixel (pushed-button-color)))
			 |XmNbackground (|Pixel (snd-pixel (basic-color))))))
	       (list |XmDIALOG_HELP_BUTTON |XmDIALOG_CANCEL_BUTTON |XmDIALOG_OK_BUTTON))
    
	      (|XtAddCallback new-dialog |XmNcancelCallback 
			      (lambda (w c i) (|XtUnmanageChild w)))
	      
	      (|XtAddCallback new-dialog |XmNhelpCallback 
			      (lambda (w c i)
				(help-dialog "Rename" "Give a new file name to rename the currently selected sound.")))

	      (|XtAddCallback new-dialog |XmNokCallback 
			      (lambda (w c i)
				(let ((new-name (|XmTextFieldGetString rename-text)))
				  (if (and (string? new-name)
					   (> (string-length new-name) 0)
					   (>= (selected-sound) 0))
				      (let ((current-name (file-name)))
					(save-sound-as new-name)
					(close-sound)
					(rename-file current-name new-name)
					(open-sound new-name)
					(|XtUnmanageChild w))))))
	      (|XmStringFree xhelp)
	      (|XmStringFree xok)
	      (|XmStringFree xdismiss)
	      (|XmStringFree titlestr)
	      (set! rename-dialog new-dialog)
	      (let* ((mainform (|XtCreateManagedWidget "formd" |xmRowColumnWidgetClass rename-dialog
				     (list |XmNleftAttachment      |XmATTACH_FORM
					   |XmNrightAttachment     |XmATTACH_FORM
					   |XmNtopAttachment       |XmATTACH_FORM
					   |XmNbottomAttachment    |XmATTACH_WIDGET
					   |XmNbottomWidget        (|XmMessageBoxGetChild rename-dialog |XmDIALOG_SEPARATOR)
					   |XmNorientation         |XmVERTICAL
					   |XmNbackground          (|Pixel (snd-pixel (basic-color))))))
		     (label (|XtCreateManagedWidget "new name:" |xmLabelWidgetClass mainform
				     (list |XmNleftAttachment      |XmATTACH_FORM
					   |XmNrightAttachment     |XmATTACH_NONE
					   |XmNtopAttachment       |XmATTACH_FORM
					   |XmNbottomAttachment    |XmATTACH_FORM
					   |XmNbackground          (|Pixel (snd-pixel (basic-color)))))))
		(set! rename-text 
		      (|XtCreateManagedWidget "newname" |xmTextFieldWidgetClass mainform
				     (list |XmNleftAttachment      |XmATTACH_WIDGET
					   |XmNleftWidget          label
					   |XmNrightAttachment     |XmATTACH_FORM
					   |XmNtopAttachment       |XmATTACH_FORM
					   |XmNbottomAttachment    |XmATTACH_FORM
					   |XmNbackground          (|Pixel (snd-pixel (basic-color))))))
		(|XtAddEventHandler rename-text |EnterWindowMask #f
				    (lambda (w context ev flag)
				      (|XmProcessTraversal w |XmTRAVERSE_CURRENT)
				      (|XtSetValues w (list |XmNbackground (white-pixel)))))
		(|XtAddEventHandler rename-text |LeaveWindowMask #f
				    (lambda (w context ev flag)
				      (|XtSetValues w (list |XmNbackground (|Pixel (snd-pixel (basic-color))))))))))
	(if (not (|XtIsManaged rename-dialog))
	    (|XtManageChild rename-dialog)
	    (raise-dialog rename-dialog)))
      8)))

(install-searcher-with-colors (lambda (file) #t))
(add-delete-option)
(add-rename-option)

;;;
;;; poup menu stuff
;;;

(change-graph-popup-color "pink")

;;;(add-selection-popup)


(define (change-selection-popup-color new-color)
  ;; new-color can be the color name, an xm Pixel, a snd color, or a list of rgb values (as in Snd's make-color)
  (let ((color-pixel
         (if (string? new-color) ; assuming X11 color names here
             (let* ((shell (|Widget (cadr (main-widgets))))
                    (dpy (|XtDisplay shell))
                    (scr (|DefaultScreen dpy))
                    (cmap (|DefaultColormap dpy scr))
                    (col (|XColor)))
               (if (= (|XAllocNamedColor dpy cmap new-color col col) 0)
                   (snd-error "can't allocate ~S" new-color)
                   (|pixel col)))
             (if (color? new-color)
                 (|Pixel (snd-pixel new-color))
                 (if (|Pixel? new-color)
                     new-color
                     ;; assume a list of rgb vals?
                     (|Pixel (snd-pixel (apply make-color new-color))))))))
    (for-each-child
     selection-popup-menu
     (lambda (n)
       (|XmChangeColor n color-pixel)))))
(change-selection-popup-color "coral")

(define (change-fft-popup-color new-color)
  (let ((color-pixel
         (if (string? new-color) ; assuming X11 color names here
             (let* ((shell (|Widget (cadr (main-widgets))))
                    (dpy (|XtDisplay shell))
                    (scr (|DefaultScreen dpy))
                    (cmap (|DefaultColormap dpy scr))
                    (col (|XColor)))
               (if (= (|XAllocNamedColor dpy cmap new-color col col) 0)
                   (snd-error "can't allocate ~S" new-color)
                   (|pixel col)))
             (if (color? new-color)
                 (|Pixel (snd-pixel new-color))
                 (if (|Pixel? new-color)
                     new-color
                     ;; assume a list of rgb vals?
                     (|Pixel (snd-pixel (apply make-color new-color))))))))
    (for-each-child
     fft-popup-menu
     (lambda (n)
       (|XmChangeColor n color-pixel)))))
(change-fft-popup-color "orange")

(change-listener-popup-color "red")

(add-to-menu 1 #f #f) ; separator

;;;
;;; additions to Edit menu
;;;

(define selctr 0)

;;; -------- cut selection -> new file

(define (cut-selection->new)
  (if (selection?)
      (let ((new-file-name (format #f "sel-~D.snd" selctr)))
	(set! selctr (+ selctr 1))
	(save-selection new-file-name)
	(delete-selection)
	(open-sound new-file-name))))

(add-to-menu 1 "Cut Selection -> New" cut-selection->new)

;;; -------- append sound (and append selection for lafs)

(define (append-sound name)
  ;; appends sound file
  (insert-sound name (frames)))

(define (append-selection)
  (if (selection?)
      (insert-selection (frames))))

(add-to-menu 1 "Append Selection" append-selection)

;;; Replace with selection
;;;

(define (replace-with-selection)
  (let ((beg (cursor))
        (len (selection-length)))
    (delete-samples beg len)
    (insert-selection beg)))

(add-to-menu 1 "Replace with Selection" replace-with-selection)

;;; (add-to-menu 1 #f #f)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; open and convert stereo MP3 files automatically
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(add-hook! open-raw-sound-hook
           (lambda (file choices)
             (list 2 44100 (if (little-endian?) mus-lshort mus-bshort))))

(add-hook! open-hook
           (lambda (filename)
             (if (= (mus-sound-header-type filename) mus-raw)
                 (let ((rawfile (string-append filename ".raw")))
                   (system (format #f "mpg123 -s ~A > ~A" filename rawfile))
                   rawfile)
                 #f)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; set up a region play list
;;; TODO: a GUI for this feature !
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (region-play-list data)
  ;; data is list of lists (list (list time region)...), time in secs
  (for-each
   (lambda (tone)
     (let ((time (* 1000 (car tone)))
           (region (cadr tone)))
       (if (region? region)
           (in time (lambda () (play-region region))))))
   data))

;;; (region-play-list (list (list 0.0 0) (list 0.5 1) (list 1.0 2) (list 1.0 0)))

;;; Deselect function
;;;

(define (deselect-all)
  (if (selection?)
      (set! (selection-member? #t) #f)))