;;; -*- package: ccl -*-
;*********************************************************************
;*                                                                   *
;*            P L A Y   Q U I C K T I M E   S O U N D                *
;*                                                                   *
;*********************************************************************
;* Author       : Alexander Repenning, alexander@agentsheets.com     *
;*                http://www.agentsheets.com                         *
;* Copyright    : (c) 1996-2005, AgentSheets Inc.                    *
;* Filename     : Play-QuickTime-Sound.lisp                          * 
;* Last Update  : 11/22/05                                           *
;* Version      :                                                    *
;*    1.0       : 01/16/04 synchronous QT sound                      *
;*    1.1       : 10/25/05 asynchronous sound                        *
;*    1.1.1     : 11/02/05 rewind-sound                              *
;*    1.1.2     : 11/22/05 *Secondary-File-Directory-Hook*           *
;* Systems      : G4, MCL 5.0, OS X 10.4.3                           *
;* License      : LGPL                                               *
;* Abstract     : Play QuickTime compatible sampled and midi sounds  *
;*   e.g., aif, wav, mp3, m4a (mpg4), mid                            *
;* Todos        : play loops, cache frequent sounds                  *
;*                                                                   *
;*********************************************************************


(in-package :ccl)


(export '(enter-movies play-quicktime-sound rewind-sound shut-up-sounds *Secondary-File-Directory-Hook*))


(defvar *Max-Number-of-Movie-Controllers* 10)

(defparameter *Movie-Controllers* (make-array *Max-Number-Of-Movie-Controllers* :initial-element nil))

(defvar *Next-Movie* 0)

(defvar *Sound-File-Directory* "ccl:resources;sounds")

(defvar *Secondary-File-Directory-Hook* nil "lambda (name) ->  returning pathname")

(defvar *Sound-Process* nil "process used to service QuickTime movies")


(defun ENTER-MOVIES ()
  (#_EnterMovies))


(defclass MOVIE-CONTROLLER ()
  ((name :accessor name :initform "" :initarg :name)
   (movie :accessor movie :initform nil :initarg :movie)
   (loop-flag :accessor loop-flag :initform nil))
  (:documentation "A controller for a movie sound track"))


(defmethod FIND-SOUND-PATHNAME ((Name string))
  (or (probe-file (format nil "~A;~A" *Sound-File-Directory* Name))
      (and *Secondary-File-Directory-Hook* (funcall *Secondary-File-Directory-Hook* Name))
      (error "cannot find sound file ~A" Name)))


(defmethod PLAY-QUICKTIME-SOUND ((Name string))
  (rlet ((Fsspec :fsspec))
    (with-pstrs ((&name (mac-namestring (find-sound-pathname Name))))
      (unless (zerop (#_FSMakeFSSpec 0 0 &name Fsspec))
        (error "Invalid file reference ~A" Name)))
    (rlet ((&fileRefNum :signed-integer))
      ;; open QT sound file
      (let ((Err (#_OpenMovieFile Fsspec &fileRefNum #$fsRdPerm)))
        (unless (= Err #$noErr) (error "cannot open sound file ~A, error: ~A" Name Err))
        ;; stop if needed
        (when (aref *Movie-Controllers* *Next-Movie*)
          (#_StopMovie (movie (aref *Movie-Controllers* *Next-Movie*)))
          (#_DisposeMovie (movie (aref *Movie-Controllers* *Next-Movie*))))
        (rlet ((&theSound :pointer)
               (&resId :signed-integer))
          (%put-word &resId #$movieInDataForkResID)
          (%put-ptr &theSound (%null-ptr))
          (setq Err (#_NewMovieFromFile
                     &theSound
                     (%get-word &fileRefNum)
                     &resId
                     (%null-ptr) 
                     #$newMovieActive
                     (%null-ptr)))
          (unless (= Err #$noErr) (error "cannot create sound from file ~A" Name))
          (#_CloseMovieFile (%get-word &fileRefNum)) ;; should be ok according to Ultimate Game Programming p.91
          (let ((Movie (%get-ptr &theSound)))
            (without-interrupts
             (setf (aref *Movie-Controllers* *Next-Movie*)
                   (make-instance 'movie-controller 
                     :movie Movie
                     :name Name))
             (#_GoToBeginningOfMovie Movie)
             (#_StartMovie Movie)))))))
  (setf *Next-Movie* (mod (1+ *Next-Movie*) *Max-Number-of-Movie-Controllers*)))


(defmethod REWIND-SOUND ((Name string)) "
  in: Name string.
  Go to beginning to movie"
  (dotimes (I *Max-Number-of-Movie-Controllers*)
    (let ((Controller (aref *Movie-Controllers* i)))
      (when (and Controller (string-equal Name (name Controller)))
        (let ((Movie (movie Controller)))
          (#_GoToBeginningOfMovie Movie))))))


(defun START-SOUNDS () "
  Service ongoing QuickTime sounds. Stop sounds that are done."
  (when (or (null *Sound-Process*) (process-exhausted-p *Sound-Process*))
    (setq *Sound-Process* 
          (process-run-function
           '(:name "QuickTime Movie Tasks" :priority 0)
           #'(lambda ()
               (loop
                 (dotimes (I *Max-Number-of-Movie-Controllers*)
                   (let ((Controller (aref *Movie-Controllers* i)))
                     (when Controller
                       (let ((Movie (movie Controller)))
                         (cond
                          ;; time to stop
                          ((#_IsMovieDone Movie) 
                           (#_StopMovie Movie)
                           (#_DisposeMovie Movie)
                           (setf (aref *Movie-Controllers* i) nil))
                          ;; time to service
                          (t
                           (#_MoviesTask (movie Controller) 0)))))))
                 (sleep 0.01))
               (process-allow-schedule))))))


(defun SHUT-UP-SOUNDS () "
  Stop all the sounds currently playing."
  (dotimes (I *Max-Number-of-Movie-Controllers*)
    (let ((Controller (aref *Movie-Controllers* i)))
      (when Controller
        (let ((Movie (movie Controller)))
          (#_StopMovie Movie)
          (#_DisposeMovie Movie)
          (setf (aref *Movie-Controllers* i) nil))))))





#| Examples:

(enter-movies)

(start-sounds)

(play-quicktime-sound "typing.wav")

(loop
  (when (command-key-p)
    (play-quicktime-sound "key.wav")))

(play-quicktime-sound "upgrades.wav")

(play-quicktime-sound "80s Pop Beat 08.aif")

(rewind-sound "80s Pop Beat 08.aif")

(play-quicktime-sound "1-02 Seven Ways.m4a")

(rewind-sound "1-02 Seven Ways.m4a")

(shut-up-sounds)

(defparameter *MP3-File* (choose-file-dialog))

(defparameter *Boing* (choose-file-dialog))




(play-quicktime-sound-file *MP3-File*)


(play-quicktime-sound-file *Boing*)
          

(#_ExitMovies)
          

|#