;*********************************************************************
; OM-SoX, (c) 2011-2014 Marlon Schumacher (CIRMMT/McGill University) *
;             http://sourceforge.net/projects/omsox/                 *
;                                                                    *
;  Multichannel Audio Manipulation and Functional Batch Processing.  *
;        DSP based on SoX - (c) C.Bagwell and Contributors           *
;                  http://sox.sourceforge.net/                       *
;*********************************************************************
;
;This program 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
;of the License, or (at your option) any later version.
;
;See file LICENSE for further informations on licensing terms.
;
;This program 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 this program; if not, write to the Free Software
;Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307,10 USA.
;
;Authors: M. Schumacher

(in-package :om)

(print "loading OM-SoX player for OM version < 6.7")   

;######## SOX-PLAY ###########

; Logic:
; the keywords gain, pan, in-channels are ignored when sox-input classes are used. 
; For sound objects the keywords override the ones given by the sound obj's internal parameters


(defmethod! sox-play ((self string) &key clipping samplerate bitdepth gain pan)
            :icon 08
            :initvals '(nil nil nil nil nil nil)
            :doc "Play back a sound using the OM-SoX library"
            :numouts 1
            (sox-play-print self)
            (if (probe-file *sox-path*)
                (let* ((inpath self))             
                  (setf thestring (format nil "~s ~a ~s -q" (namestring *sox-path*) *sox-options* (namestring inpath)))
                  (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*))
                  (when clipping (setf thestring (string+ thestring 
                                                          (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping))))))                    
                  
                  ; pan means that a sound is going to be panned between the two adjacent channels determined by the scalar. 
                  ; E.g. a value of 4.5 means between ch4 and ch5 (producing a 5-channel file) --> like the mix-console

                  (if pan
                      (progn  
                        (sox-print "sox-play: Panning a sound")
                        (sox-play (sox-pan->sox-remix self gain pan) ;if both pan and gain it should go into the function directly, otherwise only gain
                                  :clipping clipping :samplerate samplerate :bitdepth bitdepth)
                        )

                    (progn
                      (when gain (setf thestring (string+ thestring (format nil " gain ~d " gain))))
                      ;(when *normalize* (setf thestring (string+ thestring " norm " (makestring *normalize-level*))))
                      
                      (setf localpid (om-cmd-line thestring nil nil))     
                  ;(print thestring)
                  ;(print localpid)
                      (setf *sox-running-processes* (x-append *sox-running-processes* localpid))
                      (om-run-process "remove-terminated-pid" sox-remove-pid 
                                      (if clipping (- (cadr clipping) (car clipping)) (sox-sound-duration self))
                                      localpid)
                      )))
                    (sox-not-found))
                  self
            )

(defmethod! sox-play ((self pathname) &key clipping samplerate bitdepth gain pan)
            (sox-play (namestring self) :clipping clipping :samplerate samplerate :bitdepth bitdepth :gain gain :pan pan)
            )

(defmethod! sox-play ((self list) &key clipping samplerate bitdepth gain pan)
            (sox-play-print self)
            (mapcar (lambda (thesound) 
                      (sox-play thesound :clipping clipping :samplerate samplerate :bitdepth bitdepth :gain gain :pan pan)) self))
                     ; (sox-play thesound :clipping clipping :samplerate samplerate :bitdepth bitdepth :gain gain :pan pan)) self))

(defmethod! sox-play ((self sound) &key clipping samplerate bitdepth gain pan)
            (sox-play-print self)
            (if (sound-path self)
                (let ((gain (or gain (sox-vol-convert (vol self)))))
                  (if (equal (tracknum self) 0)
                      (sox-play (pathname (sound-path self)) 
                                :clipping clipping ;(or clipping (markers self)) 
                                :samplerate samplerate 
                                :bitdepth bitdepth 
                                :gain gain
                                :pan pan)
                    (sox-play (make-instance 'sox-pan
                                             :sound self
                                             :gains gain
                                             :panning (or pan (+ (tracknum self) (* 0.01 (pan self))))
                                             :clipping clipping
                                             :samplerate samplerate
                                             :bitdepth bitdepth)
                              )
                    )
                  )
              (om-beep-msg (format nil "OM-SoX: Cannot play sound with path \"~s\"" (sound-path self)))
              )
            )

; ###### sox-mix #####
(defmethod! sox-play ((self sox-mix) &key clipping samplerate bitdepth gain pan)          
            (sox-play-print self)
            (if (probe-file *sox-path*)
                (let* ((pathlist (sound self))
                       (gainlist (db->lin (gains self))))             
                  (setf thestring (format nil "~s ~a -m " (namestring *sox-path*) *sox-options*))
                  (loop for path in pathlist 
                        for gain in gainlist do
                        (setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path))))) ; could also be a pipe
                  (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*))
                  (when clipping (setf thestring (string+ thestring 
                                                          (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping))))))
                 ; (when *normalize* (setf thestring (string+ thestring " norm " (makestring *normalize-level*))))
                  (setf localpid (om-cmd-line thestring nil nil))     
                  ;(print thestring)
                  ;(print localpid)
                  (setf *sox-running-processes* (x-append *sox-running-processes* localpid))
                  (om-run-process "remove-terminated-pid" sox-remove-pid 
                                  (if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self))))
                                  localpid)
                  )
              (sox-not-found))
            self
            )

; ###### sox-merge #####
(defmethod! sox-play ((self sox-merge) &key clipping samplerate bitdepth gain pan)          
            (sox-play-print self)
            (if (probe-file *sox-path*)
                (let* ((pathlist (sound self))
                       (gainlist (db->lin (gains self))))             
                  (setf thestring (format nil "~s ~a -M " (namestring *sox-path*) *sox-options*))
                  (loop for path in pathlist 
                        for gain in gainlist do
                        (setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path))))) ; could also be a pipe
                  (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*))
                  (when clipping (setf thestring (string+ thestring 
                                                          (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping))))))                    
                  (setf localpid (om-cmd-line thestring nil nil))  
                  ;(print thestring)
                  ;(print localpid)
                  (setf *sox-running-processes* (x-append *sox-running-processes* localpid))
                  (om-run-process "remove-terminated-pid" sox-remove-pid 
                                  (if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self))))
                                  localpid)
                  )
              (sox-not-found))
            self
            )

; ###### sox-concatenate #####
(defmethod! sox-play ((self sox-concatenate) &key clipping samplerate bitdepth gain pan)          
            (sox-play-print self)
            (if (probe-file *sox-path*)
                (let* ((pathlist (sound self))
                       (gainlist (db->lin (gains self))))             
                  (setf thestring (format nil "~s ~a " (namestring *sox-path*) *sox-options*))
                  (loop for path in pathlist 
                        for gain in gainlist do
                        (setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path)))))
                  (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*))
                  (when clipping (setf thestring (string+ thestring 
                                                          (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping))))))                    
                  (setf localpid (om-cmd-line thestring nil nil))     
                  ;(print thestring)
                  (print localpid)
                  (setf *sox-running-processes* (x-append *sox-running-processes* localpid))
                  (om-run-process "remove-terminated-pid" sox-remove-pid 
                                  (if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self))))
                                  localpid)
                  )
              (sox-not-found))
            self
            )

; ###### sox-splice #####
(defmethod! sox-play ((self sox-splice) &key clipping samplerate bitdepth gain pan)          
            (sox-play-print self)
            (if (probe-file *sox-path*)
                (let* ((pathlist (sound self))
                       (gainlist (db->lin (gains self))))             
                  (setf thestring (format nil "~s ~a " (namestring *sox-path*) *sox-options*))
                  (loop for path in pathlist 
                        for gain in gainlist do
                        (setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path)))))
                  (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*))
                  (when clipping (setf thestring (string+ thestring 
                                                          (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping))))))                    
                  (setf localpid (om-cmd-line thestring nil nil))     
                  ;(print thestring)
                  (print localpid)
                  (setf *sox-running-processes* (x-append *sox-running-processes* localpid))
                  (om-run-process "remove-terminated-pid" sox-remove-pid 
                                  (if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self))))
                                  localpid)
                  )
              (sox-not-found))
            self
            )

; ###### sox-pan #####
(defmethod! sox-play ((self sox-pan) &key clipping samplerate bitdepth gain pan)          
            (sox-play-print self)   
            (sox-play (sox-pan->sox-remix (sound self) (car (list! (gains self))) (car (list! (panning self))) (numchannels self)) ;(car (list! (gains self))) 
            ;the (car (list! (panning self))) should be taken care of at initialize-instance... but maybe the editors need lists...
                      :clipping clipping
                      :samplerate samplerate
                      :bitdepth bitdepth                   
                      ))

; ###### sox-remix #####
(defmethod! sox-play ((self sox-remix) &key clipping samplerate bitdepth gain pan)              
            (sox-play-print self)
            (if (probe-file *sox-path*)
                (let* ((inpath (sound self)))             
                  (setf thestring (format nil "~s ~a ~s -q" (namestring *sox-path*) *sox-options* (namestring inpath)))
                  (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*))
                  (setf thestring (string+ thestring (format nil " remix ~a" 
                                                   (sox-remixconc-no-norm (gain-matrix self) (channel-matrix self))
                                                   )))

                  (when clipping (setf thestring (string+ thestring 
                                                          (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping))))))                    
                 ; (when *normalize* (setf thestring (string+ thestring " norm " (makestring *normalize-level*))))

                  (setf localpid (om-cmd-line thestring nil nil))     
                  ;(print thestring)
                  ;(print localpid)
                  (setf *sox-running-processes* (x-append *sox-running-processes* localpid))
                  (om-run-process "remove-terminated-pid" sox-remove-pid 
                                   (if clipping (- (cadr clipping) (car clipping)) (sox-sound-duration (sound self))) 
                                  localpid)
                  )
              (sox-not-found))
            self
            )

; ###### sox-mix-console #####
(defmethod! sox-play ((self sox-mix-console) &key clipping samplerate bitdepth gain pan)          
            (sox-play-print self)
            (if (probe-file *sox-path*)                 
                  (sox-play (make-instance 'sox-mix
                                           :sound (sox-process (sox-pan->sox-remix (sound self) (gains self) (panning self)) ;(numchannels self))
                                                               ""
                                                               :output "pipe")
                                           )
                            :clipping clipping :samplerate samplerate :bitdepth bitdepth)
              (sox-not-found))
            self
            )


;##### helper functions ################## -> probably better in utilities.

; it should be possible to connect a sox-record to a sox-input class it should allow for doing this.

;; recording function
(defmethod! sox-rec (filepath &key duration filetype samplerate bitdepth gain channel) ;better call it fileformat? or audioformat?
            :icon 08
            :initvals '(nil nil nil nil)
            :menuins '((2 (("aif" "aif") ("wav" "wav") ("flac" "flac") ("ogg" "ogg")))) 
            :doc "records incoming audio through sox into a file"
            :numouts 1
            (if (probe-file *sox-path*)
                (let* ((outpath (or filepath (om-choose-new-file-dialog :prompt "Choose a name and location for the recorded audio file"
                                                                        :directory (outfile nil)))))
                  (when outpath
                    (setf outpath (om-make-pathname :directory (pathname-directory outpath) 
                                                  :name (pathname-name outpath) 
                                                  :type (or filetype (pathname-type outpath))));)
                  (setf thestring (format nil "~s -d" (namestring *sox-path*)))                    
                  (setf thestring (sox-samplebits thestring bitdepth samplerate outpath)) 

                  (when duration (setf thestring (string+ thestring (format nil " trim 0 ~d" duration))))                  
                  (when gain (setf thestring (string+ thestring (format nil " gain ~d " gain))))
                  (when channel (setf thestring (string+ thestring (format nil " remix ~a" channel))))

                  (setf localpid (om-cmd-line thestring nil nil))
                  ;(print thestring)
                  (setf *sox-running-processes* (x-append *sox-running-processes* localpid))
                  (when duration (om-run-process "remove-terminated-pid" sox-remove-pid duration localpid))                    
                  ; NB the soundobject throws an error if the soundfile is not there yet
                  outpath
                  ))
              (sox-not-found))
            )

; ######### command-line functions ##########
; sox-kill terminates running sox play/rec processes
(defmethod! sox-kill (process-ids)       
            :icon 01
            :initvals '(nil)
            :numouts 1
            #+win32(sys::call-system "taskkill /F /IM \"sox.exe\"")
            #|      some experiments to retrieve the pid from Windows DOS console
                    (sys::call-system "tasklist /v | find \"sox.exe\"")
                    (sys::call-system "tasklist /v | find \"sox.exe\" | taskkill /F /IM")
                    (om-cmd-line "tasklist /F /IM \"sox.exe\"" nil nil)
            |#
            #+macosx(let ((pid-list (list! (or process-ids *sox-running-processes*))))
                      (loop for pid in pid-list do (om-cmd-line (format nil "kill ~d" pid) *sys-console*))
                      (setf *sox-running-processes* nil)
                      ;(print (format nil "killed pids ~s" pid-list))
                      (when (om-find-process "remove-terminated-pid") (om-kill-process (om-find-process "remove-terminated-pid")))
                      )
            )

(defun sox-remove-pid (wait-time localpid)
  (sleep wait-time)
  (print (string+ "auto remove " (number-to-string localpid)))
  (delete localpid *sox-running-processes*))


;;;===========================================
;;; INTERFACE OM : USE SOX AS A SOUND PLAYER
;;;===========================================

(unless (find :soxplayer *audio-players*) (pushr :soxplayer *audio-players*))
(defmethod audio-player-name ((self (eql :soxplayer))) "Sox") ; should be spelled "SoX"
(defmethod audio-player-desc ((self (eql :soxplayer))) "Requires OM-SoX library")

(add-assoc-player *general-player* 'soxplayer)

(defvar *sox-play-list* nil)
(defvar *sox-play-temp* "sox-play.aiff")

(defmethod InitPlayingSeq ((player (eql 'soxplayer)) dur &key (port nil)) 
  (setf *sox-play-list* nil)
  (unless (probe-file *sox-path*) 
    (om-beep-msg "SoX-executable not found!")
    ))


;This is BEFORE playplayer
(defmethod FinalizePlayingSeq ((player (eql 'soxplayer)) dur &key (port nil))
  (when *sox-play-list* ;*sox-play-list* = sound, offset, interval
    (setf *sox-play-list*
          (if (= 1 (length *sox-play-list*))
              (let ((sound (first (car *sox-play-list*)))
                    (offset (ms->sec (second (car *sox-play-list*))))
                    (interval (ms->sec (third (car *sox-play-list*)))))
                (sox-print "FinalizePlayingSeq: single case")
                (if (zerop offset)
                    ;(sox-print (list sound interval)) ; = sox, interval, pan is accounted for in PlayPlayer (via the sound object)
                    (sox-print (list (sox-process sound "" :output "pipe") interval))
                    (progn 
                    (sox-print "this is with offset")
                    (sox-print (list (sox-process sound (string+ (sox-pad offset)) :output "pipe" ) interval)) ;what's this doing? converting into a path yes?
                    )
                  )
                )
            (progn ;this looks like the Maquette case
               (sox-print "FinalizePlayingSeq: list case")
                 (list 
                  (sox-process 
                   (make-instance 'sox-mix
                                  :sound (mapcar #'(lambda (pl-item)
                                                     (let* ((sound (car pl-item)))
                                                       (sox-process 
                                                        (if (equal (tracknum sound) 0) sound (make-instance 'sox-pan :sound sound)) ;sound
                                                        (if (zerop (cadr pl-item)) "" (sox-pad (ms->sec (cadr pl-item)))) ;offset
                                                        :samplerate *audio-sr* 
                                                        :output "pipe"))
                                                     )
                                                 *sox-play-list*)
                                  )
                   ""
                   :output *sox-play-temp*)
                  (ms->sec (third (car *sox-play-list*))))) ;interval
            )))
  (sox-print (string+ "Finalize END " (makestring *sox-play-list*))))
                                                                

(defmethod* PrepareToPlay ((player (eql 'soxplayer)) (self sound) at &key approx port interval voice)
   (declare (ignore approx))
   (push (list self at interval) *sox-play-list*))

; ========== = = = = =

(defmethod Play-player ((self (eql 'soxplayer)))
  (when (sox-print (string+ "Play Player BEGIN " (makestring *sox-play-list*)))
    (cond ((subtypep (type-of (car *sox-play-list*)) 'sound)
             (let* ((sound (car (sox-print *sox-play-list*)))
                    (clipping (cadr *sox-play-list*)))
               (sox-print "Play-player: Playing a sound object")
               (if (equal (tracknum (car *sox-play-list*)) 0)
                   (sox-play sound :clipping clipping)
                 (sox-play (make-instance 'sox-pan :sound sound) :clipping clipping))
               )
             )
          (t 
           (progn 
             (sox-print "Play-player: Playing not a sound object")
             (sox-play (car (sox-print *sox-play-list*)) :clipping (cadr *sox-play-list*))
             ))))
  )

(defmethod Stop-Player ((self (eql 'soxplayer)) &optional view)
   (declare (ignore view))
   (sox-kill nil))

(defmethod Pause-Player ((self (eql 'soxplayer))) (om-beep)) ;there's currently no good method for Pause-Player
(defmethod Continue-Player ((self (eql 'soxplayer))) nil)

(defmethod Reset-Player ((self (eql 'soxplayer)) &optional view)
  (declare (ignore view))
  (sox-print "resetting player")
  (when (and *delete-inter-file* (probe-file (outfile *sox-play-temp*))) (delete-file (outfile *sox-play-temp*)))
  (setf *sox-play-list* nil)
  t)

(defmethod audio-record-start ((self (eql 'soxplayer)))
  (setf *sox-temp-recorded-file* 
        (om-choose-new-file-dialog :prompt "Choose a name and location for the recorded audio file."
                                   :directory (outfile nil)))
  (when *sox-temp-recorded-file*
    (sox-rec *sox-temp-recorded-file*)))

(defmethod audio-record-stop ((self (eql 'soxplayer)))
  (sox-kill nil)
  (probe-file *sox-temp-recorded-file*))

#|
;;;=================================
;;; PLAYBACK FOR SOX-INPUT CLASSES
;;;=================================

(defmethod play-obj? ((self sox-input)) t)

(defmethod* PrepareToPlay ((player (eql 'soxplayer)) (self sound) at &key approx port interval voice)
   (declare (ignore approx))
   (push (list self at interval) *sox-play-list*))

;the new player method for the sox-input classes could just have a new method for 'sox-input'
(defmethod* PrepareToPlay ((player t) (self sox-input) at &key approx port interval voice)
   (declare (ignore approx))
   ;(print "bingo")
   (push (list self at interval) *sox-play-list*))
   ;(sox-play self))

(defmethod InitPlayingSeq ((player (eql 'soxplayer)) dur &key (port nil)) t)
    
(defmethod FinalizePlayingSeq ((player (eql 'soxplayer)) dur &key (port nil)) t)

(defmethod Play-player ((self (eql 'sox-input)))
  (print "Playing")
  (sox-play *sox-play-list*))
|#

; SPREAD FUNCTION
; Macro for multichannel files. 
; Where a 'spread' parameter determines how 'spread' the channels are - similar to vbap.
#|
(om-round (om+ 3.75 ;panning
               
               (arithm-ser 
                (om* 150 ; spread   
                     -0.005) 
                (om* 150  ;spread
                     0.005) 

                (om/ (om- (om+ 3.75 (om* 150
                           ; spread 
                           -0.005))
                          (om+ 3.75 (om* 150
                           ; spread 
                           0.005))) 
                     2))) 
          2)
|#      

;;; collect-ressources function from OM 6.7
(defun collect-resources (path)
 (loop for item in (om-directory path) append
       (cond ((directoryp item) (collect-resources item))
             ((om-persistant-p item) 
              (let ((fileres (get-resources item)))
                (loop for restype in fileres append
                      (loop for path in (cdr restype) collect
                            (let ((*relative-path-reference* item)
                                  (corrected-path (if (and (stringp path) (pathnamep (read-from-string path)))
                                                      (read-from-string path)
                                                    path)))
                              (list (car restype) (restore-path corrected-path))
                              )))))
             (t nil)
             )))