;;; -*- auto-recompile: t -*-

;;; csound-key.el --- interfacing Csound-X with KeyKit

;; Keywords: csound

;; This file is not part of GNU Emacs.
;; 
;; csound-key.el is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; csound-key.el is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Author: Stéphane Rollandin <hepta@zogotounga.net>
;;---------

;;; Commentary:
;;-------------

;;    full documentation here:
;;    http://www.zogotounga.net/comp/csoundx.html

;;
;;; Installation:
;;                  
;; ==========================================================
;; this file should be installed through the csound-x package
;; ==========================================================
;;

;; last modified March 13, 2008

;;; Code:

(require 'keykit-interaction nil t)

;; WARNING: lots of duplicate code here
;; Keykit support for MIDI data is being gently phased out
;; while µO support is growing. This is a work in progress !

;;;;;;;;; à généraliser: pas seulement Keykit, Squeak
;;;; et peut-être d'autres formats (abc ?)
;;;; en bref: rationaliser, modulariser


(defcustom cscsd-key-midi-options "-W -TF "
  "Options for processing a midi file generated by a <KeyPhrase> area"
  :type 'string
  :group 'csound-csd)

(defcustom cscsd-key-decay 3
  "Decay time in seconds to be added to the duration of a KeyPhrase-generated MIDI file"
  :type 'integer
  :group 'csound-csd)

(defun cscsd-insert-KeyPhrase (&optional name phrase)
  "Insert a <KeyPhrase> area at the beginning of the buffer, associated to keyword NAME"
  (interactive "sKeyPhrase name: ")
  (cscsd-go-before-cssynth)
  (save-excursion
    (unless (search-forward "MidiPhraseDuration" nil t)
      (goto-char
       (cscsd-define-macro "MidiPhraseDuration" 'sco ""))
      (insert ";f0 $MidiPhraseDuration.\n")
      (forward-line -2)
      (insert ";")))
  (insert "<KeyPhrase label=\"" name "\">\n"
	  "KeyPhrase=")
  (save-excursion 
    (insert (or phrase "''") "\n</KeyPhrase>\n\n"))
;  (when (and (boundp mmm-mode) mmm-mode)
;      (cscsd-turn-mmm-on))
)

(defun cscsd-insert-mphrase (&optional name phrase)
  "Insert a <MPhrase> area at the beginning of the buffer, associated to keyword NAME"
  (interactive "sMPhrase name: ")
  (cscsd-delete-mphrase name)
  (cscsd-go-before-cssynth)
  (save-excursion
    (unless (search-forward "MidiPhraseDuration" nil t)
      (goto-char
       (cscsd-define-macro "MidiPhraseDuration" 'sco ""))
      (insert ";f0 $MidiPhraseDuration.\n")
      (forward-line -2)
      (insert ";")))
  (insert "<MPhrase label=\"" name "\">\n"
	  "|mphrase| mphrase:=")
  (save-excursion 
    (insert (or phrase "''") "kmusic.\n</MPhrase>\n\n"))
;  (when (and (boundp mmm-mode) mmm-mode)
;      (cscsd-turn-mmm-on))
)

(defun cscsd-process-KeyPhrase (keyphrase &optional audioname)
  "Evaluate the KeyPhrase area, write its corresponding midifile
and process the CSD on it"
  (cscsd-process-phrase 'key keyphrase audioname)) 

(defun cscsd-process-mphrase (mphrase &optional audioname)
  "Evaluate the MPhrase area, write its corresponding midifile
and process the CSD on it"
  (cscsd-process-phrase 'mph mphrase audioname)) 

(defun cscsd-play-mphrase (mphrase)
  (let ((cscsd-key-midi-options "-dodac -TF"))
    (cscsd-process-mphrase mphrase)))

(defun cscsd-process-phrase (type phrase &optional audioname)
  "Evaluate the phrase area of TYPE 'key or 'mph named PHRASE, 
write its corresponding midifile and process the CSD on it"
  (let* ((rootname (make-temp-file "cscsd-"))
	 (midifile (concat rootname ".mid"))
	 (durfile (concat rootname ".txt"))
	 duration
	 (csdfile (concat rootname ".csd"))
	 audiofile ;; we need this since cscsd-latest-audio-file is buffer-local
	 (this-buffer (current-buffer))
	 (csdname (file-name-sans-extension 
		   (file-name-nondirectory (buffer-file-name)))))
    (with-temp-buffer
      (insert-buffer-substring this-buffer)
      (setq duration (cscsd-make-phrase type phrase midifile durfile))
      (cscsd-set-Options "\n" cscsd-key-midi-options midifile "\n")
      ;; f0 & co..
      (unless (cscsd-set-macro-def "MidiPhraseDuration" 
				   (with-temp-buffer 
				     (if duration
					 (insert (format "%s" duration))
				       (insert-file-contents durfile))
				     (buffer-string))
				   'sco) 
	(cscsd-goto-end-of-sco)
	(re-search-backward "^e" nil t) 
	(insert "\n\n")
	(forward-line -1)
	(insert "f0 ")
	(if duration
	    (insert (format "%s" duration))
	  (insert-file-contents durfile))) 
      (write-file csdfile)
      (set-cscsd-post-csound-log-action `(lambda () ;; nettoyage:
                                           (delete-file ,midifile)
                                           (if (file-exists-p ,durfile)
					       (delete-file ,durfile))
                                           (delete-file ,csdfile)
                                           (delete-file ,rootname)))
      (cscsd-process nil audioname)
      (setq audiofile cscsd-latest-audio-file))
    ;; informer le buffer source du nouveau fichier audio:
    (setq cscsd-latest-audio-file audiofile)))

(defun cscsd-edit-mphrase (&optional label)
  ""
  (interactive "sMPhrase label: ")
  (let ((ped (surmulot-widgets-add "Phrase Editor" "MusicalPhraseEditor new")))
    (surmulot-widget-do ped
			(format "Widget labelForMPhrase: '%s'" label))
    (surmulot-widget-do 
     ped 
     (format "Widget phrase: %s kmusic"
	     (cscsd-get-mphrase label (surmulot-widget-port ped))))))

(defun cscsd-process-midi-file (filename &optional audioname) ;; pas de contrôle de la durée ???
  ""
  (let* ((rootname (make-temp-file "cscsd-tmp"))
	 (csdfile (concat rootname ".csd"))
	 (this-buffer (current-buffer)))
    (with-temp-buffer
      (insert-buffer-substring this-buffer)
      (cscsd-set-Options "\n" cscsd-key-midi-options "\"" filename "\"\n")
      (write-file csdfile)
      (cscsd-process nil audioname)
      (delete-file csdfile)
      cscsd-latest-audio-file)))

(defun cscsd-make-phrase (type phrase &optional midi-file txt-file k-file port direct)
  (if (eq type 'key)
      (cscsd-make-KeyPhrase phrase midi-file txt-file k-file)
    (cscsd-make-mphrase phrase midi-file txt-file k-file port direct)))

(defun cscsd-make-KeyPhrase (keyphrase &optional midi-file txt-file k-file)
  "Invoke lowkey to process the KEYPHRASE area
if MIDI-FILE, save the resulting KeyPhrase in that file
if TXT-FILE, write KeyPhrase duration there
if K-FILE, save KeyPhrase there in KeyKit format"
  (save-excursion
    (goto-char (point-min))
    (copy-region-as-kill 
     (or (re-search-forward (concat "<KeyPhrase>[ \t]*#+" keyphrase "[ \t#]*$") nil t) ; backward compatibility
	 (re-search-forward (concat "<KeyPhrase label=\"" keyphrase "\">")))
     (progn
       (search-forward "</KeyPhrase>")
       (search-backward "</KeyPhrase>")))
    (with-temp-buffer
      (yank)
      (when midi-file
	(insert "\n\n"
		"writemf(KeyPhrase+'p0v0d" (number-to-string (* 192 cscsd-key-decay)) "',\"" midi-file "\")\n"))
      (when txt-file
	(insert "f=open(\"" txt-file "\",\"w\")\n"
		"put(f,string(" (number-to-string cscsd-key-decay) "+latest(KeyPhrase)/float(seconds(1))))\n"
		"close(f)\n"
		"\n"))
      (when k-file
	(insert "f=open(\"" k-file "\",\"w\")\n"
		"put(f,string(KeyPhrase))\n"
		"close(f)\n"
		"\n"))
      (kk-run-lowkey "" (point-min) (point-max))))
  nil)

(defun cscsd-make-mphrase (phrase &optional midi-file txt-file k-file port direct)
  "Invoke µO to process the PHRASE area
if MIDI-FILE, save the resulting mphrase in that file
TXT-FILE exact value is ignored: if non nil, PHRASE duration is returned 
if K-FILE, save mphrase there in KeyKit format
PORT tells which Squeak subprocess should do the job
if DIRECT is non-nil, return PHRASE as a string in Keykit syntax"
  (save-excursion
    (goto-char (point-min))
    (copy-region-as-kill 
     (re-search-forward (concat "<MPhrase label=\"" phrase "\">"))
     (progn
       (search-forward "</MPhrase>")
       (search-backward "</MPhrase>")))
    (with-temp-buffer
      (yank)
      (when midi-file
	(insert "\n\n "
		"(mphrase, 'p0v0d" (number-to-string (* 192 cscsd-key-decay)) "' kmusic) saveToMidiFile: '" midi-file "' asFileReference. \n"))
      (when k-file
	(insert " mphrase keyPrintString writeToFile: '" k-file "'. \n"))
      (when txt-file
	(insert (number-to-string cscsd-key-decay) " + mphrase duration asFloat. \n"))     
      (when direct
	(insert "mphrase"))
      (squeak-eval-buffer-string (point-min) (point-max) port))))

(defun cscsd-delete-mphrase (phrase)
  ""
  (save-excursion
    (goto-char (point-min))
    (let ((found (re-search-forward (concat "<MPhrase label=\"" phrase "\">") nil t)))
      (when found
	(kill-region (search-backward "<MPhrase")
		     (search-forward "</MPhrase>"))))))

(defun cscsd-KeyPhrase-to-CsMidifileB (keyphrase filename) ;;; pas besoin de filename !! voir avec temp
  (cscsd-make-KeyPhrase keyphrase filename)
  (cscsd-insert-midifile filename))

(defun cscsd-get-KeyPhrase (keyphrase)
  "Invoke lowkey and return the KEYPHRASE defined in the corresponding area,
as a string containing its representation in KeyKit format"
  (cscsd-get-phrase 'key keyphrase))

(defun cscsd-get-mphrase (mphrase &optional port)
  "Invoke Squeak and return the MPHRASE defined in the corresponding area,
as a string containing its representation in KeyKit format"
 (cscsd-get-phrase 'mph mphrase port t))

(defun cscsd-get-phrase (type phrase &optional port direct)
  "Return the phrase of TYPE 'key or 'mph defined in the PHRASE area,
as a string containing its representation in KeyKit format"
    (cscsd-make-phrase type phrase nil nil nil port direct))

(defun cscsd-get-MIDIfile (&optional file-name)
  (delete ?\n (lowkey-eval "print(onlynotes(readmf(\"" (or file-name (read-file-name "MIDI file: ")) "\")))")))
		    
(defun csound-csd-keyphrases-menu ()       
  "Dynamic \"CSD\" submenu handling <...Phrase> areas"
  (let (area keyphrases mphrases)
    (when (featurep 'keykit-mode)
      (save-excursion
	(goto-char (point-min))
	(while (re-search-forward "^[ \t]*<KeyPhrase label=\"\\(.*\\)\">" nil t)
	  (setq area (match-string 1))
	  (add-to-list 'keyphrases 		       
		       `(,area
			 "Process as MIDI input:"
			 ["With output to DAC"  (let ((cscsd-key-midi-options "-dodac -TF"))
                                                  (cscsd-process-KeyPhrase ,area)) t]
			 ["With default MIDI options"  (cscsd-process-KeyPhrase ,area) t]
			 "--"
			 "Keykit actions:"
			 ["Display phrase in Group tool"
			  (keykit-do (format "DisplayInWgroup(%s)" (cscsd-get-KeyPhrase ,area))) t]
			 ["Snarf it" 
			  (keykit-do (format "Snarf=%s" (cscsd-get-KeyPhrase ,area))) t]) t)))
      (if keyphrases (add-to-list 'keyphrases "KeyPhrases")))
    (when (featurep 'surmulot)
      (save-excursion
	(goto-char (point-min))
	(while (re-search-forward "^[ \t]*<MPhrase label=\"\\(.*\\)\">" nil t)
	  (setq area (match-string 1))
	  (add-to-list 'mphrases 		       
		       `(,area
			 "Process as MIDI input:"
			 ["With output to DAC"  (cscsd-play-mphrase ,area) t]
			 ["With default MIDI options"  (cscsd-process-mphrase ,area) t]
			 "--"
			 ["Edit phrase"  (cscsd-edit-mphrase ,area) (featurep 'surmulot)]
			 ) t)))
      (if mphrases (add-to-list 'mphrases "MPhrases")))
    (list keyphrases mphrases)))
	

;; === this is it.
(provide 'csound-key)

;; csound-key.el ends here




