;;;-*- Mode: Lisp; Package: (qt-objects (ccl common-lisp)) -*-
;;; this is qt-objects.lisp, version 42
;;; Last changed: 04/05/05 Alexander Repenning
;;; OS X version: killed pre OS X StandardGetFile etc.
;;; works for OS X 10.3.8, MCL 5 except cannot show controller yet (will crash)

(defpackage :QT-OBJECTS 
  (:use :ccl :common-lisp)
  (:nicknames :qt))

(in-package :qt)


#|
DOCUMENTATION:

This code provides an object-oriented interface to QuickTime
movies.  It defines the basic classes movie and movie-view.
Movie-windows, movie-windoids, and movie-dialog-items are also defined
as specializations of movie-view.  Clicking on movie-dialog-items is
like pressing a play-pause button.  

To use qt-objects:
1) Make sure you have the QuickTime extension installed in your Extensions folder.
2) Load this file.
3) Evaluate (movie-test) to play a movie (you must have a movie on disk).

For best performance:
a.  Make sure you aren't scaling your movie.  Scaling slows down play.
    Use ":movie-scaling nil" as an initarg to movie-views to make sure your movies won't be scaled.
    By default "movie-scaling is set to T (for backward compatibility).
    See example in Examples.
b.  Don't use a controller.  
    i.e. ":show-controller nil" when a movie view is created
    By default :show-controller is T
    See example in Examples.
c.  Make sure there is enough Mac Heap space to play your movie smoothly.
    Large movies with more throughput will need more Mac Heap space to play smoothly.
    Experiment with giving *min-mac-heap-size* different values.  For example, I have
        a 30 frame a second, 320x240, very high quality movie that needs over 700K to 
        play smoothly.
    *min-mac-heap-size* is currently set at 300000.
    Just before a movie is played (play-movie/play-movie*/controller play button)
      this amount of mac heap memory is retrieved for Quicktime play.
d.  Use the method play-movie* to play your movie view.
    play-movie* locks out all event processing thus devoting the maximum processor
    capacity to the movie.
    Event processing is enabled whenever the mouse button is depressed.
    See Examples for a button-dialog-item that uses play-movie*
[e.  Try allocating enough Mac Heap space so that the movie will be loaded into ram (see
    the function set-mac-heap-size).  This ability is currently turned off.]
Send any other speedup hints to neves@ils.nwu.edu

;;;                 EXAMPLES
;(please send more examples to neves@ils.nwu.edu)
;1. A simple movie window
(movie-test) ; bring up a dialog to play a movie file
;2. A window with a movie view
(defvar *v*)
(defvar *w*)  ;create a window with a movie view
(setf *w*
      (make-instance 'window
        :color-p t
        :view-size #@(400 400) 
        :view-subviews
        (list
         (setf *v*
               (make-instance 'movie-view
                 :view-nick-name :movie-nick-name ;for use in Example #6
                 :view-position #@(10 10)
                   ;not using :view-size initarg tells qt-objects to size the movie view to the 
                   ;movie (if supplied)
                 :movie-scaling nil ;nil means don't ever scale the movie to the view. Default is T.
                                    ;This means the view will always be scaled to the movie.
                                    ;For example, when doing setf (view-movie <view>) <new movie>
                :show-controller nil 
                      ;if you don't want a controller, use nil.  Default is T.
                      ;You can then play the movie by double clicking on it or your program can
                      ;call play-movie* or play-movie.
                 :movie
                 (make-instance 'movie
                   :file (choose-movie-dialog)))))))
;3. Changing a movie
;change the movie in the view
;The following sizes the movie to the movie view if movie-scaling is set to T
(setf (view-movie *v*) (make-instance 'movie :file (choose-movie-dialog)))
;4. Hiding/showing a movie view (if you don't already have a view hide method)
;hide movie
(set-view-position *v* (add-points (view-position *v*) (make-point $qt-hide-h-offset 0)))
;show movie
(set-view-position *v* (subtract-points (view-position *v*) (make-point $qt-hide-h-offset 0)))
;5. Play a movie view with play-movie*
(play-movie* *v*)
;6. Using play-movie* with some interaction -- a play/pause button).
;play-movie* will stop the movie upon a button press on a dialog item.
;Can also click on "Help" while the movie is playing and the movie will stop.
(let* ((movie (view-movie *v*))
       (x-offset (point-h (view-position *v*)))
       (y-offset (point-v (view-position *v*)))
       (button-width 60)
       (button-x (floor (+ x-offset (- (/ (point-h (movie-size movie)) 2) (/ button-width 2)))))
       (button-y (+ 20 y-offset (point-v (movie-size movie)))))                
  (add-subviews *w*
               (make-instance 'button-dialog-item 
                :view-position (make-point button-x button-y)
                :view-size (make-point button-width 25)
                :dialog-item-text "Play"
                :dialog-item-action
                #'(lambda (item)
                    (let* ((movie (view-movie (find-named-sibling item :movie-nick-name)))
                           (current (get-movie-frame movie))
                           start)
                      (when (string-equal "play" (dialog-item-text item))
                        (if (or (zerop current) (is-movie-done movie))
                          (setq start 0)
                          (setq start current))
                        (eval-enqueue
                         `(progn
                            (set-dialog-item-text ',item "Stop")
                            ;;play-movie* stops the movie when the user clicks on a button
                            (play-movie* *v* :start-frame ,start)
                            (event-dispatch) ;process a possible click in play-movie* before executing next line
                            (set-dialog-item-text ',item "Play")))))
                    ))
               (make-instance 'button-dialog-item
                 :view-position (make-point button-x (+ button-y 50))
                 :view-size (make-point button-width 25)
                 :dialog-item-text "Help"
                 :dialog-item-action
                 #'(lambda (item)
                     (declare (ignore item))
                     (message-dialog "Click on Help while the movie is playing and see the movie stop."))
                 ))
  )
                                                
;;;                END EXAMPLES

Please send comments or improvements to current maintainer: neves@ils.nwu.edu

Authors:
Marc Davis (mdavis@media.mit.edu)
Mike Travers (mt@media.mit.edu)
Brian Williams (bwill@athena.mit.edu)
 
Media Laboratory
Learning and Common Sense Group
Massachusetts Institute of Technology
Cambridge, MA 02139

- and -

Kemi Jona (jona@ils.nwu.edu)
Mike Korcuska (korcuska@ils.nwu.edu)
Jeff Lind (lind@ils.nwu.edu)
David Neves (neves@ils.nwu.edu)

The Institute for the Learning Sciences
Northwestern Unversity
1890 Maple Ave
Evanston, IL 60201




New features/Changes
====================
  (version 41)
- fixed some bugs in how movie objects treated their :file initialization
  (version 40)
- Add controller action dispatch methods so that the user can attach methods to controller
  actions.  See MCAction-filter.
- Use play controller action dispatch method to make sure that there is enough free mac
  heap space to play a controller movie when the user clicks on the play button. -Neves
  (version 39)
- Fix call to newptr for MCL-PPC. -Neves
  (version 38)
- Fix package export problem with 3.7
  (version 3.7)
- 1. Wrap a with-focused-view around play-movie* by introducing a new movie view method
  of play-movie*.  "play-movie*" can be used on movie views with
  or without controllers and should be used instead of play-movie* on movies.  Currently 
  with non controllers play-movie* is called and with a controller play-movie is called.
  2. There is a new way for exiting play-movie*.  The default function notices when
  the user has clicked on a dialog item and it then stops the movie (which exits
  play-movie*).  The user can supply a different stop function to play-movie*. 
  See comments by play-movie* movie-view method.
  See Example 6 in examples.
  3. INCOMPATIBLE CHANGE WARNING.  qt-objects is now in its own package, called qt-objects
  (nickname qt).
  So preface qt-objects functions with "qt:", e.g. (qt:play-movie* ... ) 
  If you want the old behavior do a (use-package :qt :cl-user).
  Blame/congratulate Steve Feist for bugging me on this and supplying some code for
  making the transition easy.   -Neves
  (version 3.6)
- Put call to enhance-movie-playback in play-movie for controller movie views - Lind
  (version 3.5)
- Fix play-movie and stop-movie so they work for controllers. -Neves
  (version 3.4)
- This version works in MCL 2.0.1 and MCL 3.0 Beta
- Redo play-movie* to allow event processing when the mouse is depressed.
  An example of an interactive play-movie* is in the EXAMPLES section.
- Comment out ccl::editing-dialogs-p in eventhook as I don't understand what it is
  doing and it breaks in 3.0.
- Only define ccl::editing-dialogs-p if not already defined.
- Add "movie-scaling" slot to movie-views.
  When set to NIL the movie view will always be sized to the movie.
     Thus the movie will not be scaled -- this optimizes playback.
  When set to T the movie will be sized to the view (except in the
     case when a view is initially created with a movie and a size
     is not specified.)
- Fix set-movie-to-view for windows for MCL 3.0 - Neves
  (version 3.2)
- Fix bug where fsspecs with MCL pathname escape character (¶) were being created.
  This caused problems with file names that had more than one period. Neves&Korcuska
  (version 3.1)
- Take out unnecessary calls to update-for-new-movie. Neves&Feist
  (Version 3.0)
- Put call to MoviesTask in a with-focussed-view in update-for-new-movie to get rid of ghost.-Neves
- Resolve aliases in movie-fsspec-from-path - Feist
- Comment out ram-load in enhance-movie-playback for people with a lot of movies.
  Future version of code will make it an option.
- Comment out view-activate and deactive methods on movie views for people with lots
  of movie views.
- Check to see if movie-views are hidden in set-movie-to-view before changing the location
  of the movie. 
- Undo change made in 2.8 in dispose-current-movie that caused reinstallation of
  movie views to fail.  - Neves
- Fix for views covering movie movies.  - Mike K (note won't work for controllers, -Neves)
  (Version 2.9)
- Fixed 10k memory leak when new movies w/ controllers were created (multiple
  controllers were being created for a single movie and only 1 was disposed of).  
  Update-for-new-movie now checks to see if the view is within
  a window (otherwise with-focused-view doesn't do anything reasonable) and
  install-view-in-window on movie views is changed to an after method so that the
  initialization of a movie-view gets done when it is within a window. -Neves 
- wrap several methods in without-interrupts so that event-processing can't sneak in
  and cause problems. -Jeff L, Neves
  (Version 2.8)
- add simple-view specialization for add-child-movie-views
  (Version 2.7)
- Code from Bill St. Clair to keep track of movie-views so that they can be correctly
  positioned when their ancestor views are moved.  
  Changes to Bill's code. -Neves
- Set the minimum mac heap size in enhance-movie-playback so that movies play smoothly.
  Change zero's in enhance-movie-playback to calls to get-movie-time.
  Rewrite quicktime-event-hook
  Quicktime-event-hook now works with combinations of controller and non controller
  video views.
  Removied call to #_ExitMovies in end-quicktime.  Current Apple advice is to not to call
  #_ExitMovies in an application. -Neves
- now setting *idle-sleep-ticks* to optimize playback performance - Neves
- enhance-movie-playback now works properly - Neves
- use set-mac-heap-size to allocate memory for your movies in RAM to
  really increase performance - Neves
- movie-windows with controller and grow-icon now don't change movie
  box size (Kemi J- thanks to David N for pointing out the bug)
- handles to movies now made unpurgeable - this should help avoid crashes (Kemi J)
- checks for valid handles inserted - this should eradicate alot of
  crashes (Jeff L)
- filespec stuff cleaned up (major thanks to Mike K). Additional notes
  regarding this cleanup at end of this file
- creating a movie-view without installing it in a window is now
  kosher (thanks to Jeff L)
- "empty" movie-views now supported - supply nil for movie-pathname,
  or just don't pass movie-view a movie object (also due to Jeff L)
- new function that returns the time of a movie frame or range of frames
  in a human readable (SMPTE-format) string (by Kemi J)
- looping and palindrome play modes now supported (Kemi J)
- controller play/pause button now reflects current state of
  movie after call to play-movie - you must call play-movie on the
  movie-view, not on the movie itself.  See comments for play-movie
  methods (also by Kemi J) - this broke in QT 1.6
- slightly modified eventhook - this may prevent some crashes (?)
- new variable *signal-error-if-no-quicktime* [default T].  Set to nil if
  you don't want an error signalled at Lisp startup in images that are run
  on machines w/ no quicktime.
- code to get movie from a resource handle (Peter Stone) so movies can be stored
  in the resource fork of a saved application (for example) 

Known Problems/ stuff to do (but probably won't be done):
============================

- creating a movie off screen in MCL 3.0 currently takes too long (you may thing
  the program has crashed/hung).
  This is a problem with Quicktime 2.1.
- frames-per-second is a global; should be local
- would be nice to have a SMPTE time-format to frame conversion
  function so user can enter HH:MM:SS.FF and have the movie jump to the
  frame corresponding to that time
- add a movie-done-function slot to movie-views that would contain a function
  to be called when movie was finished playing - check for this in eventhook?
- more support for various options: drawing badge, suppressing volume/step keys, etc
- handling edit menu via trap calls (e.g. #_McSetUpEditMenu)? this may eliminate 
  some complexity in Lisp code but may make things more opaque to developers.

OUTLINE OF THIS FILE:
=====================

SUPPORT FUNCTIONS FROM QUICKDRAW.LISP

MOVIE CLASS

ROUTINES FOR GETTING AND PLAYING MOVIES
     Initializing the System
     Error Routines
     Movie File Routines
     Loading and Unloading Movies
     Saving Movies
     Controlling Movie Playback
     Movie Posters and Previews
     Movies and Your Event Loop
     Preferred Movie Settings
     Enhancing Movie Playback Performance
     Disabling Movies
     Generating QuickDraw Pictures From Movies
     Application-Defined Movie Routines

ROUTINES FOR EDITING MOVIES
     Editing Movies
     Low-Level Movie Editing Routines

ROUTINES THAT MODIFY MOVIE PROPERTIES
     Working With Movie Spatial Characteristics
     Working With Sound Volume
     Working With Movie Time
     Determining Movie Creation and Modification Time     
     Working With Movie User Data

MOVIE VIEW CLASS
     Movie View Size and Position Functions

MOVIE WINDOW MIXIN CLASSES
     Editing Interface for Movie Window Mixins
     Special modal-dialog call for windows containing movie-views

MOOV SCRAP HANDLER CLASS

FRAME-BASED INTERFACE TO MOVIES
     Converting Between Frames and Times
     Frame-Based Functions For Controlling Movie Playback
     Frame-Based Functions For Movie Posters and Previews
     Frame-Based Functions For Generating QuickDraw Pictures From Movies
     Frame-Based Functions For Editing Movies
     Frame-Based Functions For Low-Level Movie Editing
     Frame-Based Functions For Working With Movie Time

TEST CODE

START QUICKTIME

|#


;;;-----------------------------------------------------------------------------
;;; 
;;; SUPPORT FUNCTIONS FROM QUICKDRAW.LISP
;;; 
;;;-----------------------------------------------------------------------------

(defmacro WITH-RECTANGLE-ARG ((Var left &optional top right bottom) &body Body)
  "takes a rectangle, two points, or four coordinates and makes a rectangle.
body is evaluated with VAR bound to that rectangle."
  `(rlet ((,var :rect))
     (setup-rect ,var ,left ,top ,right ,bottom)
     ,@body))

(defun SETUP-RECT (Rect Left Top Right Bottom)
  (cond (bottom
         (setf (pref rect rect.topleft) (make-point left top))
         (setf (pref rect rect.bottomright) (make-point right bottom)))
        (right
         (error "Illegal rectangle arguments: ~s ~s ~s ~s"
                left top right bottom))
        (top
         (setf (pref rect rect.topleft) (make-point left nil))
         (setf (pref rect rect.bottomright) (make-point top nil)))
        (t (%setf-macptr rect left))))



;;;-----------------------------------------------------------------------------
;;; 
;;; MOVIE CLASS
;;; 
;;;-----------------------------------------------------------------------------

(defclass MOVIE ()
  ((mptr :initarg :mptr :initform nil :accessor mptr)
   (file :initarg :file :initform nil :accessor file)
   (file-resrefnum :accessor file-resrefnum)
   (resid :accessor resid)
   ))

;;; changed by KJ.  When user hits cancel used to get error.  Now if
;;; movie-fsspec-from-user returns NIL, that means user cancelled, so
;;; call (cancel)
(defmethod INITIALIZE-INSTANCE :after ((My-Movie movie) &rest Ignore)
  (declare (ignore ignore))
  (rlet ((fsSpec_p :fsspec))
    (with-slots (mptr file file-resrefnum resid) my-movie
      (unless mptr
        (multiple-value-bind (movie resref movie-resid)
                             (cond ((null file)
                                    (unless (movie-fsspec-from-user fsSpec_p :preview t)
                                      (cancel))
                                    (get-movie-from-fsspec fsSpec_p))
                                   ((probe-file file)
                                    (movie-fsspec-from-path fsSpec_p file)
                                    (get-movie-from-fsspec fsSpec_p))
                                   (t
                                    (movie-fsspec-from-path fsSpec_p file)      ;mt use the filename supplied!
                                    (create-movie-file-from-fsspec fsSpec_p)))
          (handle-set-unpurgeable movie)
          (setf mptr movie)
          (setf file (path-from-movie-fsspec fsSpec_p))
          (setf file-resrefnum resref)
          (setf resid movie-resid))))))

;;; for some reason non-handles were being passed in here and causing
;;; an error, so now just by bypass the error message and only let
;;; real handles thru to the code that matters
(defun HANDLE-SET-UNPURGEABLE (Handle)
  (unless (handlep handle)
    (error "~S is not a valid handle" handle))
  (let (Err)
    (#_HNoPurge handle)
    (setq err (#_MemError))
    (unless (zerop err) (error "HNoPurge: ~S -> ~S" handle err))))

(defun HANDLE-SET-PURGEABLE (Handle)
  ;(unless (handlep handle)
   ; (error "~S is not a valid handle" handle))
  (when (handlep handle)
    (let (Err)
      (#_HPurge handle)
      (setq err (#_MemError))
      (unless (zerop err) (error "HPurge: ~S -> ~S" handle err)))))

;;;-----------------------------------------------------------------------------
;;; 
;;; ROUTINES FOR GETTING AND PLAYING MOVIES
;;; 
;;;-----------------------------------------------------------------------------


;;;-----------------------------------------------------------------------------
;;; 
;;; Initializing the System
;;; 
;;;-----------------------------------------------------------------------------

;;; Commented out the following 2 defparamaters as no one seems to use them.

;(defparameter *movie-update-time-slice* 1000)   
;This parameter is measured in QuickTime units

;(defparameter *movie-task-interval* 1) 
;This parameter is measured in clock ticks

(defparameter *qt-views* nil)     
;The idea here is to keep a list of all views with movie objects to make updating more efficient.


;;; Hook

;;; IFT will add methods for this
;(eval-when (eval load compile)
;  (when (not (fboundp 'ccl::editing-dialogs-p ))
;    (defmethod ccl::editing-dialogs-p ((w t))
;      nil)))

;;; Eventhook
(defun QUICKTIME-EVENTHOOK ()
  (dolist (View *qt-views* nil) ;return nil if couldn't handle the event
    (when (view-movie view)
      (if (show-controller-p view)
        (when (and (view-movie-controller view) 
;                   (not (ccl::editing-dialogs-p view))
                   (not (zerop (#_MCIsPlayerEvent (view-movie-controller view) *current-event*))))
          (return-from quicktime-eventhook t)) ;handled MCIsPlayerEvent, return T
        (#_MoviesTask (slot-value (view-movie view) 'mptr) 0)))))

;;; Initialization
(defvar *qt-initialized?* nil)
(defvar *signal-error-if-no-quicktime* t
  "Whether to signal an error if Quicktime is not installed on startup.")
  
(defun QUICKTIME-INSTALLED? ()
  (rlet ((response :pointer))
    (zerop (#_Gestalt #$gestaltQuickTime response))))

(defun START-QUICKTIME ()
  (unless *qt-initialized?*
    (if (quicktime-installed?)
      (progn
        (#_EnterMovies)
        (push #'quicktime-eventhook *eventhook*)
        (setq *IDLE-SLEEP-TICKS* 0)
        (setf *qt-initialized?* t))
      (when *signal-error-if-no-quicktime*
        (error "QuickTime not installed!")))))

(defun END-QUICKTIME ()
  (when *qt-initialized?*
    (setf *eventhook* (delete 'quicktime-eventhook *eventhook* :key 'function-name))
    (setq *IDLE-SLEEP-TICKS* 5)
    (dolist (Mv *qt-views*)
      (dispose-current-movie mv))
;    (#_ExitMovies)
    (setf *qt-initialized?* nil)))

(defun INITIALIZE-QUICKTIME ()
  (start-quicktime)
  (unless (member 'start-quicktime *lisp-startup-functions*)
    (setf *lisp-startup-functions*
          (nconc *lisp-startup-functions* (list 'start-quicktime)))
    (pushnew 'end-quicktime *lisp-cleanup-functions*)))


;;;-----------------------------------------------------------------------------
;;; 
;;; Error Routines
;;; 
;;;-----------------------------------------------------------------------------

(defmacro ERRCHECK-MOVIE (Form)
  `(let ((Result ,form)
         (Error (#_GetMoviesError)))
     (assert (zerop error) () "~&~A had an error: ~A" ',(car form) error)
     result))


;;;-----------------------------------------------------------------------------
;;; 
;;; Movie File Routines
;;; 
;;;-----------------------------------------------------------------------------

(defmethod OPEN-MOVIE-FILE ((My-Movie movie))
  (with-slots (mptr file file-resrefnum)
              my-movie
    (if file-resrefnum
      file-resrefnum 
      (rlet ((fsSpec_p :fsspec)
             (resRefNum_p :integer))
        (movie-fsspec-from-path fsSpec_p file)
        (#_OpenMovieFile fsSpec_p resRefNum_p #$fsWrPerm)
        (setf file-resrefnum
              (%get-word resRefNum_p))))))

(defun CREATE-MOVIE-FILE (&optional Path)
  (let ((New-Movie-Filename (or path (new-movie-path))))
    (rlet ((fsSpec_p :fsspec))
      (movie-fsspec-from-path fsSpec_p new-movie-filename t)
      (create-movie-file-from-fsspec fsSpec_p))))

(defun CREATE-MOVIE-FILE-FROM-FSSPEC (Fsspec_P)
  (rlet ((ResRefNum_p :word) 
         (mptr_p :pointer))
    (unless (valid-fsspec-p fsspec_p) (error "Invalid file specification."))
    (errcheck-movie 
     (#_CreateMovieFile fsSpec_p #$MovieFileType 0 #$createmoviefileDeleteCurFile resrefnum_p mptr_p))
    (values (%get-ptr mptr_p) 
            (%get-signed-word resrefnum_p)
            (rref mptr_p :resourcespec.resid))))

(defun GET-MOVIE-FROM-FILE (Fsspec-Or-Path &optional (New-Movie-Flags #$newMovieActive))
  (if (pathnamep fsSpec-or-path)
    (rlet ((fsSpec_p :fsspec))
      (movie-fsspec-from-path fsSpec_p (truename fsSpec-or-path))
      (get-movie-from-fsspec fsSpec_p new-movie-flags))
    (get-movie-from-fsspec fsSpec-or-path new-movie-flags)))

(defun GET-MOVIE-FROM-FSSPEC (Fsspec_P &optional (New-Movie-Flags #$newMovieActive)) 
  (rlet ((movieResRefNum_p :word)
         (mptr_p :pointer)
         (actualResId_p :word))
    (unless (fsspec-exists-p fsSpec_p) (error "Not a valid file specification."))
    (errcheck-movie (#_OpenMovieFile fsSpec_p movieResRefNum_p #$fsRdPerm))
    (setf (%get-signed-word actualResId_p) #$DoTheRightThing)
    (errcheck-movie
     (#_NewMovieFromFile mptr_p (%get-signed-word movieResRefnum_p)
      actualResId_p (%null-ptr) new-movie-flags (%null-ptr)))
    (errcheck-movie (#_CloseMovieFile (%get-signed-word movieResRefNum_p)))
    (values (%get-ptr mptr_p) 
            (%get-signed-word movieResRefNum_p) 
            (%get-signed-word actualResId_p))))


(defun MOVIE-FSSPEC-FROM-PATH (Fsspec_P Path &optional New-File-Ok?)
  ;mt whose bright idea was this?
  ;mt  (let ((resolve-path (probe-file path))) ;for aliases
  ;    (when resolve-path
  (with-pstrs ((filename_p (mac-namestring path)))
    (let ((Result-Code (#_FSmakeFSSpec 0 0 filename_p fsspec_p)))
      (if (or (zerop result-code)
              (and new-file-ok? (= result-code #$fnfErr)))
        fsspec_p
        nil))))

(defun NEW-MOVIE-FSSPEC (Fsspec_P)
  (let ((New-Movie-Filename (new-movie-path)))
    (movie-fsspec-from-path fsSpec_p new-movie-filename t)))

(defmethod CLOSE-MOVIE-FILE ((My-Movie movie))
  (with-slots (file-resrefnum) my-movie
    (when file-resrefnum
      (#_CloseMovieFile file-resrefnum)
      (setf file-resrefnum nil))))

(defun NEW-MOVIE-PATH ()
  (choose-new-file-dialog 
   :prompt "Name for New Movie File..." 
   :button-string "Create"))

(defun PATH-FROM-MOVIE-FSSPEC (Fsspec)
  (%path-from-fsspec fsspec))

(defun FSSPEC-EXISTS-P (Fsspec_P)
  "Does the file described by fsSpec_p exist?"
  (rlet ((fndrInfo_p :finfo))
    (eq 0 (#_FSpGetFInfo fsSpec_p fndrInfo_p))))

(defun VALID-FSSPEC-P (Fsspec_P)
  "Is the fsSpec_p valid.  Note that an fsSpec can be valid
even if the file does not exist"
  (rlet ((fndrInfo_p :finfo))
    (let ((Err (#_FSpGetFInfo fsSpec_p fndrInfo_p)))
      (print err)
      (or (zerop err) (= err #$fnfErr)))))

;;; opens standard choose movie dialog with preview and returns
;;; pathname - useful for when you want to prompt for a movie but just
;;; keep the pathname around

(defun CHOOSE-MOVIE-DIALOG ()
  (rlet ((Fsspec :fsspec))
    (with-pstrs ((Name (mac-namestring (choose-file-dialog))))
      (unless (zerop (#_fsmakefsspec 0 0 Name Fsspec))
        (error "bad file")))
    (path-from-movie-fsspec Fsspec)))

#|
;;; contributed by Peter Stone (psto@cix.compulink.co.uk)
;;; Get movie from resource
;;; I removed some error checking when testing
 
(defun get-movie-from-resource (id &optional (new-movie-flags #$newMovieActive))
  (let ((movie-fsspec (make-empty-fsspec)))
    (unless movie-fsspec (error "No movie was found"))
    (rlet ((movieResRefNum :word)
           (mptr :pointer)
           (actualResId :word))
       (#_NewMovieFromHandle mptr (load-and-detach-resource "moov" id) 
        new-movie-flags (%null-ptr))
       (values (%get-ptr mptr) 
              movie-fsspec 
              (%get-signed-word movieResRefNum) 
              (%get-signed-word actualResId)))))
 
(defun make-empty-fsspec (&optional new-file-ok?)
  (with-pstrs ((filename (namestring "")))
    (let* ((fsspec (make-record (:fsspec :storage :pointer)))
           (result-code (#_FSmakeFSSpec 0 0 filename fsspec)))
      (if (or (zerop result-code)
           (and new-file-ok? (= result-code #$fnfErr)))
        fsspec
        nil))))
 
(defun load-and-detach-resource (type id)
  (let* ((res (#_get1resource type id)))
    (#_loadresource res)
    (#_detachresource res)
    res))

(make-instance 'movie-window
    :movie (make-instance 'movie 
             :file 1500)) ; integer = moov id
 
; Add test in initialize-instance:
 
(defmethod initialize-instance :after ((my-movie movie) &rest ignore)
  (declare (ignore ignore))
  (with-slots (mptr file file-resrefnum resid) my-movie
    (unless mptr
      (multiple-value-bind (movie fsspec resref movie-resid)
                           (cond ((integerp file)
                                  (get-movie-from-resource file))
                                 ((null file)
                                  (get-movie-from-file
                                   (movie-fsspec-from-user-with-preview)))
                                 ((probe-file file)
                                  (get-movie-from-file file))
                                 (t
                                  (create-movie-file file)))
        (setf mptr movie)
        (setf file (path-from-movie-fsspec fsspec))
        (setf file-resrefnum resref)
        (setf resid movie-resid)))))
|#

;;;-----------------------------------------------------------------------------
;;; 
;;; Loading and Unloading Movies
;;; 
;;;-----------------------------------------------------------------------------

;;; fix by KJ.  Check mptr non-nil before disposing
;;extra fix from JL--make sure that the ptr is a handle before disposing
(defmethod DISPOSE-MOVIE ((My-Movie movie))
  (without-interrupts
   (with-slots (mptr) my-movie
     (when (handlep mptr) 
       (handle-set-purgeable mptr)
       (#_DisposeMovie mptr))
     (setf mptr nil))))

(defun NEW-MOVIE (&optional (New-Movie-File-Flags 1))
  (let ((New-Movie (make-instance 'movie
                     :mptr (#_NewMovie new-movie-file-flags))))
    (setf (file-resrefnum new-movie) nil)
    (setf (resid new-movie) nil)
    new-movie))

(defmethod NEW-MOVIE-FROM-FILE ((My-Movie movie) &optional (New-Movie-Flags 1))
  (with-slots (resid file file-resrefnum) my-movie
    (open-movie-file my-movie)
    (rlet ((new-mptr :pointer (mptr (new-movie)))
           (resName :string)
           (resId :word 0)
           (dataRefWasChanged :boolean))
      (#_NewMovieFromFile new-mptr file-resrefnum resId resName new-movie-flags dataRefWasChanged)
      (let ((New-Movie (make-instance 'movie
                         :mptr (%get-ptr new-mptr)
                         :file file)))
        (setf (file-resrefnum new-movie) file-resrefnum)
        (setf (resid new-movie) (%get-signed-word resId))
        (close-movie-file my-movie)
        new-movie))))


;;;-----------------------------------------------------------------------------
;;; 
;;; Saving Movies
;;; 
;;;-----------------------------------------------------------------------------

(defmethod ADD-MOVIE-RESOURCE ((My-Movie movie) &optional (Fsspec-Or-Path (new-movie-path))
                               &key (New-Resid 0) (New-Resname ""))
  (if (pathnamep fsspec-or-path)
    (rlet ((fsSpec_p :fsspec))
      (movie-fsspec-from-path fsSpec_p fsspec-or-path t)
      (add-movie-resource-to-fsspec my-movie fsSpec_p :new-resid new-resid :new-resname new-resname))
    (add-movie-resource-to-fsspec my-movie fsspec-or-path :new-resid new-resid :new-resname new-resname)))


(defmethod ADD-MOVIE-RESOURCE-TO-FSSPEC ((My-Movie movie) Fsspec_P
                                         &key (New-Resid 0) (New-Resname ""))
  (with-slots (mptr resid file-resrefnum)
              my-movie
    (with-pstrs ((resName_p new-resname))
      (rlet ((resrefnum_p :word)
             (resId_p :word new-resid))
        (#_OpenMovieFile fsspec_p resrefnum_p #$fsWrPerm)
        (prog1
          (#_AddMovieResource mptr (%get-word resrefnum_p) resId_p resName_p)
          (when (= (%get-word resrefnum_p) file-resrefnum)
            (setf resid (%get-signed-word resId_p)))
          )))))

(defmethod REMOVE-MOVIE-RESOURCE ((My-Movie movie) &optional (Fsspec-Or-Path (file my-movie)))
  (if (pathnamep fsspec-or-path)
    (rlet ((fsSpec_p :fsspec))
      (movie-fsspec-from-path fsSpec_p fsspec-or-path t)
      (remove-movie-resource-from-fsspec my-movie fsSpec_p))
    (remove-movie-resource-from-fsspec my-movie fsspec-or-path)))

(defmethod REMOVE-MOVIE-RESOURCE-FROM-FSSPEC ((My-Movie movie) Fsspec_P)
  (with-slots (resid file-resrefnum file)
              my-movie
    (rlet ((resrefnum_p :word))
      (#_OpenMovieFile fsSpec_p resrefnum_p #$fsWrPerm)
      (prog1
        (#_RemoveMovieResource (%get-word resrefnum_p) resid)
        (when (= (%get-word resrefnum_p) file-resrefnum)
          (setf file nil)
          (setf file-resrefnum nil)
          (setf resid nil))))))

(defmethod UPDATE-MOVIE-RESOURCE ((My-Movie movie) &optional (Fsspec-Or-Path (file my-movie)))
  (if (pathnamep fsspec-or-path)
    (rlet ((fsSpec_p :fsspec))
      (movie-fsspec-from-path fsSpec_p fsspec-or-path t)
      (update-movie-resource-fsspec my-movie fsSpec_p))
    (update-movie-resource-fsspec my-movie fsspec-or-path)))

(defmethod UPDATE-MOVIE-RESOURCE-FSSPEC ((My-Movie movie) Fsspec_P)
  (with-slots (mptr resid) 
              my-movie
    (rlet ((resrefnum_p :word))
      (#_OpenMovieFile fsSpec_p resrefnum_p #$fsWrPerm)
      (#_UpdateMovieResource mptr (%get-word resrefnum_p) resid (%null-ptr)))))

(defmethod FLATTEN-MOVIE ((My-Movie movie) &optional (Fsspec-Or-Path (new-movie-path)))
  (if (pathnamep fsspec-or-path)
    (rlet ((fsSpec_p :fsspec))
      (movie-fsspec-from-path fsSpec_p fsspec-or-path t)
      (flatten-movie-fsspec my-movie fsSpec_p))
    (flatten-movie-fsspec my-movie fsspec-or-path)))

(defmethod FLATTEN-MOVIE-FSSPEC ((My-Movie movie) Fsspec_P)
  (with-slots (mptr)
              my-movie
    (let ((Creator #$MovieFileType)
          (Scripttag #$DoTheRightThing)
          (Movieflattenflags #$flattenAddMovieToDataFork)
          (Createmoviefileflags #$DoTheRightThing))
      (rlet ((resId_p :word 0)
             (resName_p :string))
        (#_FlattenMovie mptr
         movieFlattenFlags
         fsSpec_p creator scriptTag 
         createMovieFileFlags resId_p resName_p)))))

(defmethod SAVE-MOVIE ((My-Movie movie) &optional (Pathname (file my-movie)))
  (rlet ((fsSpec_p :fsspec))
    (movie-fsspec-from-path fsSpec_p pathname t)
    (open-movie-file my-movie)
    (update-movie-resource-fsspec my-movie fsSpec_p)
    (flatten-movie-fsspec my-movie fsSpec_p)
    (close-movie-file my-movie)
    (setf (file my-movie) pathname)))

(defmethod HAS-MOVIE-CHANGED ((My-Movie movie))
  (with-slots (mptr) my-movie
    (#_HasMovieChanged mptr)))

(defmethod CLEAR-MOVIE-CHANGED ((My-Movie movie))
  (with-slots (mptr) my-movie
    (#_ClearMovieChanged mptr)))


;;;-----------------------------------------------------------------------------
;;; 
;;; Controlling Movie Playback
;;; 
;;;-----------------------------------------------------------------------------

(defmethod GET-MOVIE-ACTIVE-SEGMENT ((My-Movie movie))
  (with-slots (mptr) my-movie
    (rlet ((start :long)
           (duration :long))
      (#_getmovieactivesegment mptr start duration)
      (values (%get-long start) (%get-long duration)))))

(defmethod SET-MOVIE-ACTIVE-SEGMENT ((My-Movie movie)
                                     Start-Time &optional (Duration 0))
  (#_SetMovieActiveSegment (mptr my-movie) start-time duration))

(defmethod GET-MOVIE-RATE ((My-Movie movie))
  (#_GetMovieRate (mptr my-movie)))

(defmethod SET-MOVIE-RATE ((My-Movie movie) Factor)
  (with-slots (mptr) my-movie
    (let ((Preferred-Rate (#_GetMoviePreferredRate mptr)))
      (#_SetMovieRate mptr (* factor preferred-rate)))))

(defmethod GO-TO-BEGINNING-OF-MOVIE ((My-Movie movie))
    (#_GoToBeginningofMovie (mptr my-movie)))

(defmethod GO-TO-END-OF-MOVIE ((My-Movie movie))
    (#_GoToEndofMovie (mptr my-movie)))

(defmethod START-MOVIE ((My-Movie movie))
  (#_StartMovie (mptr my-movie)))

;;; Note: if the movie has a controller attached, and you want the
;;; play/pause button to be updated to reflect the current play state
;;; of the movie, you should use the play-movie and stop-movie methods
;;; that are specialized on the movie-view class instead of the
;;; methods below.

(defmethod STOP-MOVIE ((My-Movie movie))
  (#_StopMovie (mptr my-movie)))

(defmethod PLAY-MOVIE ((My-Movie movie))
  (with-slots (mptr) my-movie
    (#_SetMovieActive mptr t)
    (enhance-movie-playback my-movie :ram-load t)
    (#_StartMovie mptr)))

;;; a synchronous version of play-movie that allows specification of
;;; start and end frames, and will call a function periodically during
;;; movie playback.  Written to maximize playback performance as much
;;; as possible.  Usually used for movie-views with no controller. 
;;; The function won't return until the movie is done.
;;; Event processing is locked out and controller will not update itself
#|

(defmethod play-movie* ((movie movie)
                        &key 
                        (start-frame 0)
                        (end-frame (get-movie-duration-in-frames movie))
                        play-hook)
  (declare (type integer start-frame end-frame)
           (function is-movie-done (movie) t)
           (function get-movie-frame (movie) integer)
           (inline is-movie-done get-movie-frame)
           (optimize (speed 3) (safety 0)))
  (let ((mptr (slot-value movie 'mptr)))
    (unwind-protect 
      (without-interrupts
         (set-movie-frame movie start-frame)
         (play-movie movie)
         (loop
           (cond
            ((is-movie-done movie) 
             (stop-movie movie)
             (return))
            ((and end-frame (>= (get-movie-frame movie) end-frame))
             (stop-movie movie)
             (return)))
           (#_MoviesTask mptr #$doTheRIghtThing)
           (when play-hook (funcall play-hook movie))))
      (stop-movie movie))))
|#

;;; Don't call directly -- it may cause an offset problem where the movie plays at a different position.  
;;; Use play-movie* on the movie-view instead.
(defmethod PLAY-MOVIE* ((Movie movie)
                        &key 
                        (Start-Frame 0)
                        End-Frame
                        Play-Hook
                        (Stop-On-Click t) ;t for backward compatibility
                        (Stop-Fn-P #'(lambda nil (event-dispatch) nil)) ;for backward compatibility
                        )
  (declare (type integer start-frame end-frame)
           (function get-movie-frame (movie) integer)
           (inline get-movie-frame)
           (optimize (speed 3) (safety 0)))
  (let ((Mptr (slot-value movie 'mptr)))
    (unwind-protect 
      (without-interrupts
         (set-movie-frame movie start-frame)
         (play-movie movie)
         (loop
           (when (or (#_IsMovieDone mptr) 
                     (zerop (#_GetMovieRate mptr)) ;someone else stopped the movie?
                     (and end-frame (>= (get-movie-frame movie) end-frame)))
             (stop-movie movie)
             (return))
           (#_MoviesTask mptr #$doTheRIghtThing)
           ;; if clicks are processed and the user has the mouse down and stop-fn-p returns T,
           ;; then stop the movie (and then this method will be exited).
           (when (and stop-on-click (#_button) (funcall stop-fn-p))
             (stop-movie movie))
           (when play-hook (funcall play-hook movie)
                 (#_MoviesTask mptr #$doTheRIghtThing))
           ))
      (stop-movie movie))))


(defmethod PLAY-MOVIE-BACKWARDS ((My-Movie movie))
  (set-movie-rate my-movie -1))

(defmethod FAST-FORWARD-MOVIE ((My-Movie movie) &optional (New-Rate 2))
  (set-movie-rate my-movie new-rate))

(defmethod FAST-REWIND-MOVIE ((My-Movie movie) &optional (New-Rate -2))
  (set-movie-rate my-movie new-rate))

(defmethod SCAN-FORWARD ((My-Movie movie))
  (set-movie-rate my-movie 10))

(defmethod SCAN-REVERSE ((My-Movie movie))
  (set-movie-rate my-movie -10))

(defmethod REWIND-MOVIE ((My-Movie movie))
  (with-slots (mptr) my-movie
    (#_GoToBeginningOfMovie mptr)
    (#_STOPMOVIE mptr)))

(defmethod WIND-TO-END-OF-MOVIE ((My-Movie movie))
  (with-slots (mptr) my-movie
    (#_GotoEndOfMovie mptr)
    (#_STOPMOVIE mptr)))

(defmethod SET-PLAY-MODE ((M movie) Mode)
   (let ((Mode-Flag (ecase mode
                      (:loop #$loopTimeBase)
                      (:palindrome 2)  ;const not defined apparently
                      (:normal 0))))
     (#_SETTIMEBASEFLAGS (get-movie-time-base m) mode-flag)))

(defmethod GET-PLAY-MODE ((M movie))
   (case (#_gettimebaseflags (get-movie-time-base m))
     (0 :normal)
     (1 :loop)
     (2 :palindrome)
     (otherwise :unknown)))


;;;-----------------------------------------------------------------------------
;;; 
;;; Movie Posters and Previews
;;; 
;;;-----------------------------------------------------------------------------

(defmethod GET-MOVIE-POSTER-TIME ((My-Movie movie))
  (#_GetMoviePosterTime (mptr my-movie)))

(defmethod SET-MOVIE-POSTER-TIME ((My-Movie movie) Time)
  (#_SetMoviePosterTime (mptr my-movie) time))

(defmethod GET-MOVIE-PREVIEW-MODE ((My-Movie movie))
  (#_GetMoviePreviewMode (mptr my-movie)))

(defmethod SET-MOVIE-PREVIEW-MODE ((My-Movie movie) Use-Preview)
  (#_SetMoviePreviewMode (mptr my-movie) use-preview))

(defmethod GET-MOVIE-PREVIEW-TIME ((My-Movie movie))
  (rlet ((preview-time :timevalue)
         (preview-duration :timevalue))
    (#_SetMoviePreviewTime (mptr my-movie) preview-time preview-duration)
    (values (%get-signed-long preview-time)
            (%get-signed-long preview-duration))))

(defmethod SET-MOVIE-PREVIEW-TIME ((My-Movie movie) Preview-Time Preview-Duration)
  (#_SetMoviePreviewTime (mptr my-movie) preview-time preview-duration))

(defmethod GET-POSTER-BOX ((My-Movie movie))
  (rlet ((poster-box :rect))
    (#_GetPosterBox (mptr my-movie) poster-box)
    (values (rref poster-box :rect.top) 
            (rref poster-box :rect.left) 
            (rref poster-box :rect.bottom) 
            (rref poster-box :rect.right))))

(defmethod SET-POSTER-BOX ((My-Movie movie) Left &optional Top Right Bot)
  (with-rectangle-arg (r left top right bot)
    (#_SetPosterBox (mptr my-movie) r)))

(defmethod PLAY-MOVIE-PREVIEW ((My-Movie movie) &optional (Callout-Proc nil)
                               (Refcon 0))
  (#_PlayMoviePreview (mptr my-movie) (or callout-proc (%null-ptr)) refcon))

(defmethod SHOW-MOVIE-POSTER ((My-Movie movie))
  (with-slots (mptr) my-movie
    (#_SetMovieTimeValue mptr (#_GetMoviePosterTime mptr))
    (#_MoviesTask mptr #$doTHeRIghtThing)))



;;;-----------------------------------------------------------------------------
;;; 
;;; Movies and Your Event Loop
;;; 
;;;-----------------------------------------------------------------------------


(defmethod IS-MOVIE-DONE ((My-Movie movie))
  (#_IsMovieDone (mptr my-movie)))

(defmethod POINT-IN-MOVIE ((My-Movie movie) Point)
  (#_PtInMovie (mptr my-movie) point))

(defmethod UPDATE-MOVIE ((My-Movie movie))
  (#_UpdateMovie (mptr my-movie)))



;;;-----------------------------------------------------------------------------
;;; 
;;; Preferred Movie Settings
;;; 
;;;-----------------------------------------------------------------------------


(defmethod GET-MOVIE-PREFERRED-RATE ((My-Movie movie))
  (#_GetMoviePreferredRate (mptr my-movie)))

(defmethod SET-MOVIE-PREFERRED-RATE ((My-Movie movie) Rate)
  (#_SetMoviePreferredRate (mptr my-movie) rate))

(defmethod GET-MOVIE-PREFERRED-VOLUME ((My-Movie movie))
  (#_GetMoviePreferredVolume (mptr my-movie)))

(defmethod SET-MOVIE-PREFERRED-VOLUME ((My-Movie movie) Volume)
  (#_SetMoviePreferredVolume (mptr my-movie) volume))



;;;-----------------------------------------------------------------------------
;;; 
;;; Enhancing Movie Playback Performance
;;; 
;;;-----------------------------------------------------------------------------

#|
Movies play better if there is enough Mac Heap allocated to load them into memory.  
If you have movie files less than 2 meg in size you might want to allocate 
2 meg by calling set-mac-heap-size.  e.g.
(set-mac-heap-size 2000000)
|#

;;; Try to set the mac heap to "size".  Useful so that one can specify the amount
;;; of Mac Heap space is available for loading movies
(defun SET-MAC-HEAP-SIZE (Size)
    (let (P)
      (when (> size (#_freemem))
        (setq p (#_newptr size))
;        (setq p (#_newptr             ;commented out for version 39
;                          :d0 size
;                          :a0))
        (if (%null-ptr-p p) nil (#_DisposePtr p)))))

(defmethod GET-MOVIE-DATA-SIZE ((My-Movie movie) 
                                &optional (Starttime 0) (Duration (get-movie-duration my-movie)))
  (#_getmoviedatasize (mptr my-movie) starttime duration))

(defmethod CAN-LOAD-MOVIE-INTO-RAM-P ((My-Movie movie))
  (> (#_freemem) (get-movie-data-size my-movie)))

(defconstant keepInRam 1)
(defconstant unkeepInRam 2)

;;; minimum mac heap space needed for movies not in ram to play smoothly.
;;; As a movie is playing it grabs mac heap space.  If there isn't enough it grabs some Lisp
;;; heap space which can be time consuming.
;;; Pick a number, any number :-)
(defvar *min-mac-heap-size* 300000)

(defmethod ENHANCE-MOVIE-PLAYBACK ((My-Movie movie) &key (Ram-Load t))
  (declare (ignore ram-load))
  (set-mac-heap-size *min-mac-heap-size*)
  (with-slots (mptr) my-movie
    (let ((Preferred-Rate (#_GetMoviePreferredRate mptr))
          (Movie-Time (get-movie-time my-movie)))
      (cond (nil ;ram-load 
             ;;turn this off for now for people with lots of small movies
             ;;and who want to keep the movies active.  Hi Steve.
            (when (can-load-movie-into-ram-p my-movie)
              (#_LoadMovieIntoRAM mptr movie-time (get-movie-duration my-movie) keepInRam))
            (#_PrerollMovie Mptr movie-time preferred-rate)) ;preroll not needed for controllers
            (t
             (#_PrerollMovie mptr movie-time preferred-rate))))))

;;;-----------------------------------------------------------------------------
;;; 
;;; Disabling Movies
;;; 
;;;-----------------------------------------------------------------------------

(defmethod GET-MOVIE-ACTIVE ((My-Movie movie))
  (#_getmovieactive (mptr my-movie)))

(defmethod SET-MOVIE-ACTIVE ((My-Movie movie) &optional (Active t))
  (#_setmovieactive (mptr my-movie) active))


;;;-----------------------------------------------------------------------------
;;; 
;;; Generating QuickDraw Pictures From Movies
;;; 
;;;-----------------------------------------------------------------------------

(defmethod GET-MOVIE-PICT ((My-Movie movie) Time)
  (#_GetMoviePict (mptr my-movie) time))

(defmethod GET-MOVIE-POSTER-PICT ((My-Movie movie))
  (#_GetMoviePosterPict (mptr my-movie)))

;;; a hint:  Use Mike Engber's oodles-of-utils PICT-SVM class in
;;; conjunction with the above calls to display PICTs from movies
;;; For example:
;;; (make-instance 'pict-svm :pict-handle (get-movie-poster-pict <movie>))

;;; util added by KJ 1/21/93
;;; given a variable name and a filename, creates a temporary movie
;;; object, executes user's forms, then disposes of the movie. 

(defmacro WITH-TEMP-MOVIE ((Var file) &body Body)
  (let ((Temp (gensym)))
    `(let ((,Temp (make-instance 'movie :file ,file)))
       (unwind-protect 
         (let ((,Var ,temp))
           ,@body)
         (dispose-movie ,temp)))))

#| example using above to display a pict of the movie poster

(oou::oou-dependencies :pict-di)

(with-temp-movie (movie (choose-file-dialog :mac-file-type :|MooV|))
  (make-instance 'dialog
    :window-title "WITH-TEMP-MOVIE Demo"
    :view-subviews (list (make-instance 'pict-di 
                           :pict-handle (get-movie-poster-pict movie)))))
|#

;;;-----------------------------------------------------------------------------
;;; 
;;; Application-Defined Movie Routines
;;; 
;;;-----------------------------------------------------------------------------

(defmethod SET-MOVIE-PROGRESS-PROC ((My-Movie movie) Proc Refcon)
  (#_SetMovieProgressProc (mptr my-movie) proc refcon))

(defmethod SET-MOVIE-COVER-PROCS ((My-Movie movie) Uncover-Proc Cover-Proc Refcon)
  (#_SetMovieCoverProcs (mptr my-movie) uncover-proc cover-proc refcon))


;;;-----------------------------------------------------------------------------
;;; 
;;; ROUTINES FOR EDITING MOVIES
;;; 
;;;-----------------------------------------------------------------------------


;;;-----------------------------------------------------------------------------
;;; 
;;; Editing Movies
;;; 
;;;-----------------------------------------------------------------------------

(defmethod GET-MOVIE-SELECTION ((My-Movie movie))
  (with-slots (mptr)
              my-movie
    (rlet ((selectionTime :long)
           (selectionDuration :long))
      (#_GetMovieSelection
       mptr
       selectionTime
       selectionDuration)
      (values (%get-long selectionTime) (%get-long selectionDuration)))))

(defmethod SET-MOVIE-SELECTION ((My-Movie movie) &optional
                                (Start-Time 0)
                                (Duration (get-movie-duration my-movie)))
  (with-slots (mptr) my-movie
    (#_SetMovieSelection mptr start-time duration)))

(defmethod ADD-MOVIE-SELECTION ((My-Source-Movie movie) 
                                (My-Destination-Movie movie))
  (#_AddMovieSelection
   (mptr my-destination-movie)
   (mptr my-source-movie)))

(defmethod CLEAR-MOVIE-SELECTION ((My-Movie movie))
  (#_ClearMovieSelection (mptr my-movie)))

(defmethod CUT-MOVIE-SELECTION ((My-Movie movie))
  (#_CutMovieSelection (mptr my-movie)))

(defmethod COPY-MOVIE-SELECTION ((My-Movie movie))
  (#_CopyMovieSelection (mptr my-movie)))

(defmethod PASTE-MOVIE-SELECTION ((My-Source-Movie movie) 
                                  (My-Destination-Movie movie))
  (let ((Movie-Containing-Selection 
         (#_copymovieselection (mptr my-source-movie))))
    (#_PasteMovieSelection
     (mptr my-destination-movie) movie-containing-selection)
    (#_disposemovie movie-containing-selection)))

(defmethod PASTE-SPECIFIED-SELECTION ((Source-Movie movie)
                                      Source-Start-Time
                                      Source-Duration
                                      (Destination-Movie movie))
  (set-movie-selection source-movie
                       source-start-time
                       source-duration)
  (paste-movie-selection source-movie
                         destination-movie))


;;;-----------------------------------------------------------------------------
;;; 
;;; Low-Level Movie Editing Routines
;;; 
;;;-----------------------------------------------------------------------------


(defmethod COPY-MOVIE-SETTINGS ((My-Source-Movie movie) 
                                (My-Destination-Movie movie))
  (#_CopyMovieSettings 
   (mptr my-source-movie)
   (mptr my-destination-movie)))

(defmethod DELETE-MOVIE-SEGMENT ((My-Movie movie) Start-Time Duration)
  (with-slots (mptr) my-movie
    (#_DeleteMovieSegment mptr start-time duration)))


(defmethod INSERT-EMPTY-MOVIE-SEGMENT ((My-Movie movie) Start-Time Duration)
  "Inserts empty space into a movie -- but cannot do this at the end of a movie"
  (with-slots (mptr) my-movie
    (#_InsertEmptyMovieSegment mptr start-time duration)))

(defmethod INSERT-MOVIE-SEGMENT ((My-Source-Movie movie) (My-Destination-Movie movie) 
                                 &key 
                                 Source-Movie-Segment-Start-Time
                                 Source-Movie-Segment-Duration
                                 Destination-Movie-Insert-Start-Time)
  (#_InsertMovieSegment
   (mptr my-source-movie)
   (mptr my-destination-movie)
   source-movie-segment-start-time
   source-movie-segment-duration 
   destination-movie-insert-start-time))

(defmethod SCALE-MOVIE-SEGMENT ((My-Movie movie) Start-Time Old-Duration New-Duration)
  (with-slots (mptr) my-movie
    (#_ScaleMovieSegment mptr start-time old-duration new-duration)))


;;;-----------------------------------------------------------------------------
;;; 
;;; ROUTINES THAT MODIFY MOVIE PROPERTIES
;;; 
;;;-----------------------------------------------------------------------------


;;;-----------------------------------------------------------------------------
;;; 
;;; Working With Movie Spatial Characteristics
;;; 
;;;-----------------------------------------------------------------------------

;;; returns 4 values: left, top, right, bottom of movie box
(defmethod GET-MOVIE-BOX ((My-Movie movie))
  (with-slots (mptr) my-movie
    (rlet ((movieBounds :rect))
      (#_GetMovieBox mptr movieBounds)
      (values (rref movieBounds :rect.left) 
              (rref movieBounds :rect.top) 
              (rref movieBounds :rect.right)
              (rref movieBounds :rect.bottom)))))

(defmethod SET-MOVIE-BOX ((My-Movie movie) Left &optional Top Right Bottom)
  (with-rectangle-arg (r left top right bottom)
    (#_SetMovieBox (mptr my-movie) r)))

;;; returns a point specifying width and height of movie box
(defmethod MOVIE-SIZE ((My-Movie movie))
  (multiple-value-bind (left top right bottom) (get-movie-box my-movie)
    (let  ((Rectwidth (- right left))
           (Rectheight (- bottom top)))
      (make-point rectwidth rectheight))))


;;;-----------------------------------------------------------------------------
;;; 
;;; Working With Sound Volume
;;; 
;;;-----------------------------------------------------------------------------

(defmethod GET-MOVIE-VOLUME ((My-Movie movie))
  (#_GetMovieVolume (mptr my-movie)))

(defmethod SET-MOVIE-VOLUME ((My-Movie movie) Volume)
  (#_SetMovieVolume (mptr my-movie) volume))


;;;-----------------------------------------------------------------------------
;;; 
;;; Working With Movie Time
;;; 
;;;-----------------------------------------------------------------------------

(defmethod GET-MOVIE-DURATION ((My-Movie movie))
  (#_GetMovieDuration (mptr my-movie)))

(defmethod GET-MOVIE-TIME ((My-Movie movie) &optional Time-Record)
  (#_GetMovieTime (mptr my-movie) (or time-record (%null-ptr))))

(defmethod SET-MOVIE-TIME ((My-Movie movie) Time &optional Time-Scale)
  (let* ((Time-Scale (if time-scale time-scale (get-movie-time-scale my-movie)))
         (Time-Record (create-time-record time time-scale)))
    (#_SetMovieTime (mptr my-movie) time-record)))

(defmethod GET-MOVIE-TIME-BASE ((My-Movie movie))
  (#_GetMovieTimeBase (mptr my-movie)))

(defmethod GET-MOVIE-TIME-SCALE ((My-Movie movie))
  (#_GetMovieTimeScale (mptr my-movie)))

(defmethod SET-MOVIE-TIME-SCALE ((My-Movie movie) Time-Scale)
  (#_SetMovieTimeScale (mptr my-movie) time-scale))

(defmethod SET-MOVIE-TIME-VALUE ((My-Movie movie) Time)
  (#_SetMovieTimeValue (mptr my-movie) time))


;;;-----------------------------------------------------------------------------
;;; 
;;; Determining Movie Creation and Modification Time
;;; 
;;;-----------------------------------------------------------------------------

(defmethod GET-MOVIE-CREATION-TIME ((My-Movie movie))
  (#_GetMovieCreationTime (mptr my-movie)))

(defmethod GET-MOVIE-MODIFICATION-TIME ((My-Movie movie))
  (#_GetMovieModificationTime (mptr my-movie)))


;;;-----------------------------------------------------------------------------
;;; 
;;; Working With Movie User Data
;;; 
;;;-----------------------------------------------------------------------------

(defmethod GET-MOVIE-USER-DATA ((My-Movie movie))
  (#_GetMovieUserData (mptr my-movie)))





;;;-----------------------------------------------------------------------------
;;; 
;;; MOVIE VIEW CLASS
;;; 
;;;-----------------------------------------------------------------------------

(defclass MOVIE-VIEW (simple-view)
  ((movie :initarg :movie :initform nil :accessor view-movie)
   (show-controller :initarg :show-controller :accessor show-controller-p)
   (enable-editing :initarg :enable-editing :accessor enable-editing-p)
   (movie-scaling :initarg :movie-scaling :initform t :accessor movie-scaling)
   (controller :initform nil :accessor view-movie-controller))
  (:default-initargs :show-controller t :enable-editing nil))

;;; for set-view-position in MCL 3.0 Beta
;(defmethod maybe-erase ((view simple-view)) t)

;;; check for quicktime before getting into trouble

(defmethod INITIALIZE-INSTANCE :around ((Mv movie-view) &rest Initargs)
  (declare (ignore initargs))
  (if (and *qt-initialized?* (quicktime-installed?))
    (call-next-method)
    (error "QuickTime is not available.  Make sure QuickTime is installed and (initialize-quicktime) has been evaluated.")))

(defmethod INITIALIZE-INSTANCE :after ((Mv movie-view) &rest Ignore)
  (declare (ignore ignore))
  (when (view-movie mv)         ;;JL--only update if there is a movie present
    (update-for-new-movie mv)))

#| old
(defmethod view-default-size ((mv movie-view))
  (with-slots (movie) mv
    (cond
     (movie (movie-size movie))
     (t #@(160 120))))) ;; this should perhaps change to 320x240
|#

(defparameter *controller-height* 16)
(defmethod VIEW-DEFAULT-SIZE ((Mv movie-view))
  (with-slots (movie) mv
    (cond
     ((and movie (show-controller-p mv))
      (add-points (movie-size movie) (make-point 0 *controller-height*)))
     (movie (movie-size movie))
     (t #@(160 120))))) ;; this should perhaps change to 320x240

;;; Get a movie
;;; can supply a pathname, a movie instance, or NIL for an "empty"
;;; movie view
;;; with modifications to allow a pathname to a file on the working volume only
#|

 Bug report - why without-interrupts is needed

Well, apparently when I set the view-movie from my app (not from the
listener) somehow the event manager decides to issue update events between
when the view-movie slot is set and when it is initialized. Thus, it tries
to view-draw-contents and dies because the mptr is nil. I don't know why it
should choose that time, consistently, to do it's redrawing, exactly, but
this without-interrupts fixed the problem. Go figure.
|#

(defmethod (SETF VIEW-MOVIE) (Pathname (View movie-view))
  (let ((Log-Path (if pathname (translate-logical-pathname pathname))))
    (unless (probe-file log-path)
      (error "~&Can't find file ~S" log-path))
    (without-interrupts
     (when (view-movie view)
       (dispose-current-movie view))
     (setf (slot-value view 'movie)
           (make-instance 'movie :file log-path))
     (when (wptr view)
       (initialize-movie-view view))
;     (update-for-new-movie view)
)
    (slot-value view 'movie)))

(defmethod (SETF VIEW-MOVIE) ((Movie movie) (View movie-view))
  (without-interrupts
   (when (view-movie view)
     (when (and (not (movie-scaling view))
                (not (point<= (movie-size (view-movie view)) (movie-size movie))))
      (invalidate-view view t))
     (dispose-current-movie view))
   (setf (slot-value view 'movie) movie)
   (when (wptr view)
     (initialize-movie-view view))
;   (update-for-new-movie view)  ;done in initialize-movie-view
   )
  movie)

;; JL--if the pathname is nil, then just set the view-movie slot to
;; nil and erase the view

(defmethod (SETF VIEW-MOVIE) ((Movie null) (View movie-view))
  (without-interrupts
   (when (view-movie view)
     (dispose-current-movie view))
   (setf (slot-value view 'movie) nil)
   (invalidate-view view t))
  nil)

;;; dont want to clobber movie object since may want to reinstall view
;;; at some point and want to keep around filename
;;;without-interrupts keeps redraw events or movie-updates
;;;from using a disposed mptr -JL

(defmethod DISPOSE-CURRENT-MOVIE ((Mv movie-view))
  (with-slots (movie controller) mv
    (without-interrupts
     (when controller
       (#_DisposeMovieController controller)
       (setq controller nil))
     (when movie
       (dispose-movie movie)
       ))))

;;; when no controller present, handle clicks on the movie as the
;;; controller does: double-click to start, single click to stop playing
(defmethod VIEW-CLICK-EVENT-HANDLER ((View movie-view) Where)
  (declare (ignore where))
  (unless (view-movie-controller view)
    (with-slots (movie) view
      (when movie
        (cond
         ((double-click-p)
          (when (is-movie-done movie) (rewind-movie movie))
          (play-movie movie))
         (t (stop-movie movie)))))))

;;;-----------------------------------------------------------------------------
;;; 
;;; Movie View Size and Position Functions
;;; 
;;;-----------------------------------------------------------------------------

;;; ----------- Thanks to Bill St. Clair for much of this
;;; To ensure that the movie gets moved when one of its ancestor views gets moved or removed.
;;; Each view keeps track of any movie-views contained within it in *movie-view-table*
(defvar *movie-view-table* (make-hash-table :test 'eq))

;;; Remove views from *movie-view-table* when a view or window is deleted.
;;; Replacement for weak hash tables below. -Neves
(defmethod REMOVE-VIEW-FROM-WINDOW :before ((View movie-view))
  (map-view-ancestors view 
                      #'(lambda (Ancestor)
                          (delete-movie-view-ancestor view ancestor))))
  
(defun ANCESTOR-MOVIE-VIEWS (Ancestor)
  (gethash ancestor *movie-view-table*))

(defun ADD-MOVIE-VIEW-ANCESTOR (View Ancestor)
  (pushnew view (gethash ancestor *movie-view-table*)))

(defun DELETE-MOVIE-VIEW-ANCESTOR (View Ancestor)
  (let ((Views (delete view (gethash ancestor *movie-view-table*))))
    (if views
      (setf (gethash ancestor *movie-view-table*) views)
      (remhash ancestor *movie-view-table*))))

(defun MAP-VIEW-ANCESTORS (View Function)
  (let ((Ancestor view))
    (loop
      (setq ancestor (view-container ancestor))
      (unless ancestor (return))
      (funcall function ancestor))))

;in case set-view-container is used to move a tree of views.  set-view-container calls
;remove-view-from-window so all the hash table information is destroyed.  These four methods
;will rebuild it.
(defmethod ADD-CHILD-MOVIE-VIEWS ((View movie-view))
  (map-view-ancestors view #'(lambda (Ancestor)
                                 (add-movie-view-ancestor view ancestor))))
(defmethod ADD-CHILD-MOVIE-VIEWS ((View view))
  (dovector (v (view-subviews view)) (add-child-movie-views v)))
(defmethod ADD-CHILD-MOVIE-VIEWS ((View simple-view)))
(defmethod SET-VIEW-CONTAINER :after ((View view) Parent)
  (declare (ignore parent))
  (add-child-movie-views view)
  )

(defmethod SET-VIEW-CONTAINER :before ((View view) Parent)
  (declare (ignore parent))
  (dolist (Movie-View (gethash view *movie-view-table*))
    (map-view-ancestors view #'(lambda (Ancestor)
                                 (delete-movie-view-ancestor movie-view ancestor)))))

(defmethod SET-VIEW-CONTAINER :before ((View movie-view) Parent)
  (declare (ignore parent))
  (map-view-ancestors view
                 #'(lambda (Ancestor)
                     (delete-movie-view-ancestor view ancestor))))

(defmethod SET-VIEW-CONTAINER :after ((View movie-view) Parent)
  (declare (ignore parent))
  (map-view-ancestors view #'(lambda (Ancestor)
                          (add-movie-view-ancestor view ancestor))))

(defmethod SET-VIEW-POSITION :after (View H &optional V)
  (declare (ignore h v))
  (dolist (Movie-View (ancestor-movie-views view))
    (set-movie-to-view movie-view)))
;;; ----------- end of Bill's code

(defmethod SET-VIEW-POSITION :after ((Mv movie-view) H &optional V)
  (declare (ignore h v))
  (set-movie-to-view mv))

(defmethod SET-VIEW-SIZE :after ((Mv movie-view) H &optional V)
  (declare (ignore h v))
  (set-movie-to-view mv))

(defmethod SET-MOVIE-BOX ((Movie movie) Left &optional Top Right Bot)
  (with-rectangle-arg (r left top right bot)
    (#_SetMovieBox (mptr movie) r)))

(defmethod SET-CONTROLLER-BOX ((Movie-View movie-view) Left &optional Top Right Bot)
  (with-rectangle-arg (r left top right bot)
    (#_MCSetControllerBoundsRect (view-movie-controller movie-view) r)))

;;; returns 4 values: top, left, bottom, right of movie box
(defmethod MOVIE-BOX ((M movie))
  (with-slots (mptr) m
    (rlet ((movieBounds :rect))
      (#_GetMovieBox mptr movieBounds)
      (values (rref movieBounds :rect.top) (rref movieBounds :rect.left) 
              (rref movieBounds :rect.bottom) (rref movieBounds :rect.right)))))

;;; returns a point specifying width and height of movie box
(defmethod MOVIE-SIZE ((M movie))
  (multiple-value-bind (top left bottom right) (movie-box m)
    (let  ((Rectwidth (- right left))
           (Rectheight (- bottom top)))
      (make-point rectwidth rectheight))))

(defun CONTROLLER-BOX (C)
  (rlet ((rect :rect))
    (#_MCGetControllerBoundsRect c rect)
    (values (rref rect :rect.top) (rref rect :rect.left) 
            (rref rect :rect.bottom) (rref rect :rect.right))))

(defmethod MOVIE-BOUNDS ((M movie-view))
  (if (view-movie-controller m)
    (multiple-value-bind (top left bottom right) (controller-box (view-movie-controller m))
      (make-point (- right left) (- bottom top)))
    (movie-size (view-movie m))))
    

(defmethod VIEW-ACTIVATE-EVENT-HANDLER :after ((Mv movie-view)) nil)
#|
  (when (view-movie mv)     ;;;;JL-- only activate if there is a movie in residence
    (#_SetMovieActive (slot-value (view-movie mv) 'mptr) t)
    (enhance-movie-playback (view-movie mv) :ram-load t)
    (when (view-movie-controller mv)
      (#_MCActivate (view-movie-controller mv)
       (wptr (view-window mv)) t))))
|#

(defmethod VIEW-DEACTIVATE-EVENT-HANDLER :after ((Mv movie-view)) nil)
#|
  ;; this will turn off background movie showing. uncomment if this is desired
  ;(#_SetMovieActive (slot-value (view-movie mv) 'mptr) nil)
  (when (view-movie-controller mv)
    (#_MCActivate (view-movie-controller mv)
     (wptr (view-window mv)) nil)))
|#

(defmethod SHOW-CONTROLLER ((Mv movie-view))
  (when (view-movie-controller mv)
    (#_MCSetVisible (view-movie-controller mv) t)))

(defmethod HIDE-CONTROLLER ((Mv movie-view))
  (when (view-movie-controller mv)
    (#_MCSetVisible (view-movie-controller mv) nil)))

(defmethod CONTROLLER-VISIBLE-P ((Mv movie-view))
  (when (view-movie-controller mv)
    (not (zerop (#_MCGetVisible (view-movie-controller mv))))))

#|
There's a redraw bug that allows views over QT views to become obscured by
the QT.  This is because the #_updatemovie call in view-draw-contents only
queues the update -- adding #_moviestask forces the redraw.  Here's
a fixed version: - MK
|#

(defmethod VIEW-DRAW-CONTENTS :after ((Movie-View movie-view))
  (with-slots (movie) movie-view
    (without-interrupts
     (when (and movie (handlep (mptr movie)))
       (with-focused-view (view-window movie-view)
         (#_SetMovieActive (slot-value movie 'mptr) t)
         (#_Updatemovie (slot-value movie 'mptr))
         (#_MoviesTask (slot-value movie 'mptr) 0)
         (when (view-movie-controller movie-view)
           (#_MCDraw (view-movie-controller movie-view) 
            (wptr (view-window movie-view)))))))))

#| old version
;;;JL 5/12 -- check to make sure the mptr is a valid handle
;;;sometimes recently disposed movies are still being drawn.
;;;this causes a crash.
(defmethod view-draw-contents :after ((movie-view movie-view))
  (with-slots (movie) movie-view
    (without-interrupts
     (when (and movie (handlep (mptr movie)))
       (with-focused-view (view-window movie-view)
         (#_SetMovieActive (slot-value movie 'mptr) t)
         (#_Updatemovie (slot-value movie 'mptr))
         (when (view-movie-controller movie-view)
           (#_MCDraw (view-movie-controller movie-view) 
            (wptr (view-window movie-view)))))))))
|#

(defmethod REMOVE-VIEW-FROM-WINDOW ((Mv movie-view))
  (without-interrupts
   (dispose-current-movie mv)
   (setq *qt-views* (remove mv *qt-views*)))
  (call-next-method))

;;; reinstall movie if filename exists but mptr is null
;;; this should support remove-subviews and then readding them later on.
(defmethod INSTALL-VIEW-IN-WINDOW :after ((Mv movie-view) (Win window))
  (initialize-movie-view mv)
  )

(defmethod INITIALIZE-MOVIE-VIEW ((Mv movie-view))
  (when (view-movie mv)
    (with-slots (mptr file) (view-movie mv)
      (when (and file (null mptr))
        (multiple-value-bind (movie)
                             (get-movie-from-file file)
          (setf mptr movie))
;        (update-for-new-movie mv)
        )
      (when (and file mptr)  ;;;JL -- if the view already has a valid movie in it,
        (update-for-new-movie mv)))      ;;;then update right away
  (pushnew mv *qt-views*)))

;;; MCAction-Filter:
;;; GENERIC function for attaching behavior to controller actions.
;;; see #$mcActionPlay method for an example of use.
;;; see Movies.lisp in library:interfaces or inside-mac Quicktime Components for
;;;   a list of things you can trap with controllers.
;;; Your method must return #$true or #$false as a result.
;;;   True means that your code has handled the controller action.
;;;   False means your code hasn't handled the action so the default
;;;     controller code will handle the action.
;;;   So if you want to turn off an action all you have to do is to
;;;     define a method that returns #$true.

;;; By default return false so default controller code handles action.
(defmethod MCACTION-FILTER (Action Mc Params)
  (declare (ignore Action mc params))
  #$false)

;;; Hitting the play button first makes sure there is enough free mac heap
;;;   space to play the movie well.
;;; For Quicktime 2.1 this should be #$mcActionPrerollAndPlay (55) but MCL doesn't
;;;   have that interface value yet.  mcActionPlay also gets called when
;;;   the user clicks on the movie but the movie doesn't seem to play then.
;;; Return false so the controller code will handle the play
(defmethod MCACTION-FILTER ((Action (eql #$mcactionplay)) Mc Params)
  (declare (ignore Action mc params))
  (set-mac-heap-size *min-mac-heap-size*)
  #$false)

;;; Dispatch the controller action to the appropriate MCL method (e.g. see above)
;;; Refcon is always going to be 0 (see _MCSetActionFilterWithRefCon in update-for-new-movie)
;;;   so we don't need to pass it into MCaction-filter.
(defpascal MCActionFilter-Dispatch (:ptr mc :word Action :ptr params :long refcon :word)
  (declare (ignore refcon))
  (MCaction-filter Action mc params))
           
(defmethod UPDATE-FOR-NEW-MOVIE ((View movie-view))
  (when (wptr view)
    (with-slots (movie) view
      (let ((Mptr (slot-value movie 'mptr)))
        (without-interrupts
         (when (not (movie-scaling view))
           (setf (slot-value view 'view-size) (movie-bounds view)))
         (with-focused-view view
           (errcheck-movie (#_SetMovieGWorld mptr (%null-ptr) (%null-ptr)))
           (when (and (show-controller-p view) (null (view-movie-controller view)))
             (with-rectangle-arg (r 0 (view-size view))
               (setf (view-movie-controller view)
                     (errcheck-movie (#_NewMovieController mptr r 
                                      (controller-creation-flags-value)))) ;#$mcTopLeftMovie
               (#_MCSetActionFilterWithRefCon (view-movie-controller view) MCActionFilter-Dispatch 0) ;we don't use refcon so pass in 0.
               (when (enable-editing-p view)
                 (#_MCEnableEditing (view-movie-controller view) t))
               ))) ;end with-focused-view
         (set-movie-to-view view)
         (invalidate-view view)
         (#_StopMovie mptr)
         (#_GoToBeginningOfMovie mptr)
         (with-focused-view (view-window view)
           (#_UpdateMovie mptr) ;MK
           (#_MoviesTask mptr #$doTHeRIghtThing)))))))

(defparameter *controller-creation-flags* (list #$mcTopLeftMovie))

(defun CONTROLLER-CREATION-FLAGS-VALUE ()
  (let ((Result 0))
    (dolist (Flag *controller-creation-flags* result)
      (setq result (boole boole-ior result flag)))))

;;; move the movie controller to the specified location
;;; the trick to doing this is to unattach the movie controller,
;;; however once this is done you must update the movie box manually
;;; when changing sizes

(defmethod POSITION-CONTROLLER ((Mv movie-view) Top Left Bottom Right)
  (with-slots (movie controller) mv
    (#_MCSetcontrollerAttached controller nil)
    (rlet ((movieBounds :rect)
           (mcBounds :rect
                     :top top
                     :left left
                     :bottom bottom
                     :right right))
      (#_GetMovieBox (slot-value movie 'mptr) movieBounds)
      (#_MCPositionController controller moviebounds mcbounds #$mcWithFrame))))

;;; if you want the play/pause button on the controller to reflect real play state of
;;; movie you need to use the following two methods instead of calling
;;; the same methods directly on the movie object (so we can access
;;; the controller)

(defmethod PLAY-MOVIE ((Movie-View movie-view))
  (with-focused-view (view-window movie-view)   ;; set up corrent window origin for movie
    (if (view-movie-controller movie-view)
      (progn
        (when (view-movie movie-view)
          (enhance-movie-playback (view-movie movie-view)))
        (#_McDoAction (view-movie-controller movie-view)
         #$mcActionPlay (%int-to-ptr 
                         (#_GetMoviePreferredRate (mptr (view-movie movie-view)))))
        )
      (play-movie (view-movie movie-view)))))

;;; Find the interface item at the current mouse position
;;; will return NIL if no item is there, otherwise will
;;; return the item (e.g. window, view, dialog item
(defun FIND-MCL-ITEM-UNDER-MOUSE ()
  (find-clicked-subview nil (view-mouse-position nil)))

;;; Return T if mouse is over a dialog item.
;;; This is used in play-movie* to decide when to stop the movie
(defun DEFAULT-STOP-FUNCTION nil
  (let ((Item (find-mcl-item-under-mouse))) ;find the item under the mouse
    (and item (typep item 'dialog-item))))  ;if it is a dialog-item return T

;;; a movie-view version of play-movie*
;;; stop-on-click - if true play-movie* will call stop-fn-p when the user clicks the mouse
;;;                 It is true by default.  If you don't want the user to interrupt the movie then
;;;                 set to nil.
;;; stop-fn-p - return true if the movie should be stopped.
;;;             It is called when the user clicks the mouse in movie method of play-movie*.
;;;             The default version stops the movie when the user clicks on a dialog item.
;;; e.g. (play-movie* view :stop-on-click nil) ;play the movie. Ignore all clicks
;;;      (play-movie* view) ;play the movie.  Stop when the user clicks on a dialog-item
;;;      (play-movie* view :stop-fn-p #@(lambda nil t)) ;play the movie.  Stop on any mouse click.
(defmethod PLAY-MOVIE*
           ((Movie-View movie-view)
            &key 
            (Start-Frame 0)
            End-Frame
            Play-Hook
            (Stop-On-Click t) ;by default process mouse clicks
            (Stop-Fn-P #'default-stop-function) ;by default stop when user clicks on dialog item
            )
  (with-focused-view (view-window movie-view)  ;make sure origin is set correctly
    (if (view-movie-controller movie-view)
      (play-movie movie-view)  ; controllers are just played with the regular event hook
      (play-movie* (view-movie movie-view) :start-frame start-frame :end-frame end-frame :play-hook play-hook
                   :stop-on-click stop-on-click :stop-fn-p stop-fn-p))))

(defmethod STOP-MOVIE ((Movie-View movie-view))
  (if (view-movie-controller movie-view)
    (#_McDoAction (view-movie-controller movie-view)
     #$mcActionPlay (%null-ptr))
    (#_StopMovie (mptr (view-movie movie-view)))))

;;;-----------------------------------------------------------------------------
;;; 
;;; MOVIE WINDOW MIXIN CLASSES
;;; 
;;;-----------------------------------------------------------------------------

;;; this is necessary because windoid defines a view-default-size method. 
;;; hide window until after initialize-instance to hide ugly intermediate
;;; drawing stages
(defclass MOVIE-WINDOW-MIXIN ()
  ((last-edit :initform nil :accessor last-edit))
  (:default-initargs :enable-editing t :window-show nil))

(defmethod INITIALIZE-INSTANCE :after ((Mw movie-window-mixin) &rest Ignore)
  (declare (ignore ignore))
  (when (and (string-equal (window-title mw) "Untitled")
             (view-movie mw))
    (set-window-title mw (pathname-name (file (view-movie mw)))))
  (initialize-movie-view mw)
  (window-select mw))

;;; for some reason the controller and the grow-icon don't line up
;;; it appears that the MCL grow icon is one pixel lower than the one
;;; in Movie Player window's.  Make default to no grow-icon - you can
;;; have one if you want by specifying the initarg.

(defclass MOVIE-WINDOW (movie-window-mixin movie-view window) ()
  (:default-initargs :grow-icon-p nil))

(defclass MOVIE-WINDOID (movie-window-mixin movie-view windoid) ())

(defmethod FIND-MOVIE-WINDOID ((Movie movie))
  (find movie (windows :class 'movie-windoid :include-windoids t)
        :key #'(lambda (X)
                 (let ((Mdi (car (subviews x 'movie-dialog-item))))
                   (when mdi (slot-value mdi 'movie))))))

(defclass MOVIE-DIALOG-ITEM (movie-view dialog-item) ()
  (:default-initargs
    :dialog-item-action #'(lambda (Mdi)
                            (let ((Movie (slot-value mdi 'movie)))
                              (if (command-key-p)
                                (print (slot-value movie 'file))
                                (cond ((is-movie-done movie)
                                       (rewind-movie movie)
                                       (play-movie movie))
                                      ((and (not (zerop (get-movie-rate movie)))
                                            (get-movie-active movie) 
                                            (not (is-movie-done movie)))
                                       (stop-movie movie))
                                      (t
                                       (play-movie movie))))))))

(defun STANDARD-POSITION (Window-Type)
  (cond ((equal window-type 'movie-windoid)
         #@(100 100))
        (t
         #@(40 40))))

(defmethod STAGGER-WINDOWS (Window-Type)
  (let ((Current-Windows (windows :class window-type :include-windoids t)))
    (if current-windows
      (add-points (standard-position window-type)
                  (make-point (* (length current-windows)
                                 15)
                              (* (length current-windows)
                                 15)))
      (standard-position window-type))))

;;; from oodles-of-utils
(defconstant $qt-hidden-const 8192)
(defconstant $qt-hide-h-offset 16384)
;;; assuming you are hiding things in the horizontal direction by adding
;;; $qt-hide-h-offset
;;; is-hidden-p.  Is the view (or one of its parents) hidden?
(defmethod IS-HIDDEN-P ((Mv simple-view))
  (if (> (point-h (view-position mv)) $qt-hidden-const) t
      (if (view-container mv) (is-hidden-p (view-container mv)) nil)))

(defmethod SET-MOVIE-TO-VIEW ((Mv movie-view))
  (when (view-movie mv)
    (when (not (movie-scaling mv))
      (setf (slot-value mv 'view-size) (movie-bounds mv)))
    ;; if the view (or parent) is hidden then put the movie off the screen somewhere
    ;; otherwise calculate its position relative to the topleft of the window
    (let* ((Topleft (if (is-hidden-p mv) (make-point $qt-hide-h-offset $qt-hide-h-offset)
                        (subtract-points #@(0 0) (view-origin mv))))
           (Bottomright (add-points topleft (view-size mv))))
      (if (view-movie-controller mv)
        (set-controller-box mv topleft bottomright)
        (set-movie-box (view-movie mv) topleft bottomright)))))
;  )

;;; a specialized version for movie windows with grow boxes and
;;; controllers- makes sure the grow box isn't clobbered
(defmethod SET-MOVIE-TO-VIEW ((Mw movie-window))
  (cond
   ;; grow box, movie, and controller?
   ((and (ccl::window-grow-icon-p mw)
         (view-movie mw)
         (view-movie-controller mw))
    (multiple-value-bind (tl br) (ccl::grow-icon-corners mw)
      (position-controller
       mw
       (point-v tl)
       0  ;left
       (point-v br)
       (point-h tl)
       )
      (let* ((Topleft (subtract-points #@(0 0) (view-origin mw)))
             (Bottomright (make-point (point-h (view-size mw))
                                      (1- (point-v tl))
                                      )))
        (set-movie-box (view-movie mw) topleft bottomright)))
    )
   ;; otherwise use the standard method for movie views
   (t (call-next-method))))

;;; this sometimes doesn't draw the controller when zooming up although
;;; it does draw it when zooming back to normal size.  Why?
(defmethod WINDOW-ZOOM-EVENT-HANDLER :after ((Mw movie-window) Message)
  (declare (ignore message))
  (set-movie-to-view mw))

;;;-----------------------------------------------------------------------------
;;; 
;;; Editing Interface for Movie Window Mixins
;;; 
;;;-----------------------------------------------------------------------------

;;; Window methods for cutting/pasting.  I'm not sure how to do this if there
;;; are multiple movie-views in a window, hence these methods are defined only
;;; for movie-windows.

(defmethod COPY ((W movie-window-mixin))
  (when (view-movie-controller w)
    (put-scrap :|moov| (#_MCCopy (view-movie-controller w)))))

(defmethod PASTE ((W movie-window-mixin))
  (when (view-movie-controller w)
    (#_MCPaste (view-movie-controller w) (get-scrap :|moov|))
    (setf (last-edit w) 'paste)))

(defmethod CUT ((W movie-window-mixin))
  (when (view-movie-controller w)
    (put-scrap :|moov| (#_MCCut (view-movie-controller w)))
    (setf (last-edit w) 'cut)))

(defmethod UNDO ((W movie-window-mixin))
  (when (view-movie-controller w)
    (#_MCUndo (view-movie-controller w))
    (setf (last-edit w) 'undo)))

(defmethod CLEAR ((W movie-window-mixin))
  (when (view-movie-controller w)
    (#_MCClear (view-movie-controller w))
    (setf (last-edit w) 'clear)))

(defmethod SELECT-ALL ((W movie-window-mixin))
  (when (view-movie-controller w)
    (set-movie-selection (view-movie w))
    (#_MCDraw (view-movie-controller w) (wptr w))))

(defmethod WINDOW-CAN-DO-OPERATION ((W movie-window-mixin) Operation &optional Menu-Item)
  (declare (ignore menu-item))
  (and (view-movie-controller w)
       (#_MCIsEditingEnabled (view-movie-controller w))
       (case operation
         (paste (get-scrap :|moov|))
         ((cut copy clear) 
          (multiple-value-bind (start dur) (get-movie-selection (view-movie w))
            (declare (ignore start))
            (not (zerop dur))))
         (undo (when (and (last-edit w) (member (last-edit w) '(paste cut undo clear)))
                 (set-menu-item-title (first (menu-items *edit-menu*)) 
                                      (format nil "Undo ~:(~A~)" (last-edit w)))
                 t))
         (select-all t)
         (t nil))))

;;; Saving movies

(defmethod WINDOW-SAVE ((Mw movie-window))
  (save-movie (view-movie mw)))

(defmethod WINDOW-SAVE-AS ((Mw movie-window))
  (let* ((Old-Filename (file (view-movie mw)))
         (New-Filename (choose-new-file-dialog
                        :directory old-filename
                        :prompt "Save Movie AsÉ")))
    (save-movie (view-movie mw) new-filename)
    (set-window-title mw (pathname-name new-filename))))

;;; QT MODAL DIALOG

;;; special modal-dialog call that adds quicktime eventhook to the
;;; modal dialog call so that the controller can be updated properly
;;; not necessary to use this unless a modal dialog contains a qt-view
;;; with a controller.

(defmethod QT-MODAL-DIALOG ((Dialog window) &optional (Close-On-Exit t)
                            (Eventhook 'quicktime-eventhook))
  (cond
   ;; if a list is supplied, make sure it contains eventhook, else add it
   ((and (consp eventhook)
         (not (member 'quicktime-eventhook eventhook
                      :key #'(lambda (Item) (or (function-name item) item)))))
    (push 'quicktime-eventhook eventhook))
   ;; if an atom is supplied and its not the quicktime-eventhook,
   ;; create a list that contains the quicktime-eventhook and the
   ;; supplied eventhook
   ((and (atom eventhook)
         (neq eventhook 'quicktime-eventhook))
    (setq eventhook (list 'quicktime-eventhook eventhook))))
  (modal-dialog dialog close-on-exit eventhook))
                            

;;;-----------------------------------------------------------------------------
;;; 
;;; MOOV SCRAP HANDLER CLASS
;;; 
;;;-----------------------------------------------------------------------------

(defclass MOOV-SCRAP-HANDLER (scrap-handler) ())

(defmethod SET-INTERNAL-SCRAP ((Self moov-scrap-handler) Scrap)
  (call-next-method self scrap)
  (when scrap (pushnew :|moov| *scrap-state*)))

(defmethod EXTERNALIZE-SCRAP ((H moov-scrap-handler))
  (let* ((Moov (slot-value h 'ccl::internal-scrap)))
    (when moov
      (#_PutMovieOnScrap moov 0))))

(defmethod INTERNALIZE-SCRAP ((H moov-scrap-handler))
  (let* ((Moov (#_NewMovieFromScrap 0)))
    (setf (slot-value h 'ccl::internal-scrap) moov)))

(defmethod GET-INTERNAL-SCRAP ((H moov-scrap-handler))
  (slot-value h 'ccl::internal-scrap))

(pushnew `(:|moov| . ,(make-instance 'moov-scrap-handler))
         *scrap-handler-alist*
         :test #'equal)





;;;-----------------------------------------------------------------------------
;;; 
;;; FRAME-BASED INTERFACE TO MOVIES
;;; 
;;;-----------------------------------------------------------------------------



;;;-----------------------------------------------------------------------------
;;; 
;;; Converting Between Frames and Times
;;; 
;;;-----------------------------------------------------------------------------

;;;Conversions between *frames-per-second*, time, time-scale, and current-frame

;;; current-frame       =  (floor (/ (* time *frames-per-second*) time-scale))
;;; time                =  (floor (* current-frame time-scale) *frames-per-second*)
;;; time-scale          =  (floor (/ time (floor (/ current-frame *frames-per-second*))))
;;; *frames-per-second* =  (floor (/ time (* current-frame time-scale)))

;To simulate dealing with video set *frames-per-second* to 30
;To simulate dealing with film set *frames-per-second* to 24

(defvar *frames-per-second* 30)

(defun CREATE-TIME-RECORD (Time Time-Scale)
  (make-record :timerecord
               :value.hi (num-to-hi64 time)
               :value.lo (num-to-lo64 time)
               :scale time-scale
               :base (#_NewTimeBase)))

(defun NUM-TO-HI64 (Num)
  (floor num 4294967296))

(defun NUM-TO-LO64 (Num)
  (logand num 4294967295))

(defmethod FRAME-TO-TIME ((My-Movie movie) Frame &key (Frames-Per-Second *frames-per-second*))
  (floor (* frame (get-movie-time-scale my-movie)) frames-per-second))

(defmethod TIME-TO-FRAME ((My-Movie movie) Time &key (Frames-Per-Second *frames-per-second*))
  (floor (/ (* time frames-per-second) (get-movie-time-scale my-movie))))

;;; this returns a string in H:MM:SS.FF format (H=hours, M=mins, S=secs, F=frames 0-29)
;;; it can also be used to calculate the duration of a selection.  just pass in results of
;;; get-movie-selection-in-frames and it return how long the selection is.  

(defmethod FRAME-TO-SMPTE-TIME-STRING ((M movie) Frame &key (Frames-Per-Second *frames-per-second*))
  (let* ((Time (frame-to-time m frame :frames-per-second frames-per-second))
         (Time-Scale (get-movie-time-scale m))
         (Seconds (/ time time-scale))
         (Secs+Remainder (multiple-value-list (floor seconds)))
         (Frames (time-to-frame m (* (second secs+remainder) time-scale)
                                :frames-per-second frames-per-second))
         (Second (mod (car secs+remainder) 60))
         (Minute (mod (floor seconds 60) 60))
         (Hour (floor seconds 3600)))
    (format nil "~D:~2,'0D:~2,'0D.~2,'0D" hour minute second frames)))
    

;;;-----------------------------------------------------------------------------
;;; 
;;; Frame-Based Functions For Controlling Movie Playback
;;; 
;;;-----------------------------------------------------------------------------

(defmethod GET-MOVIE-ACTIVE-SEGMENT-IN-FRAMES ((My-Movie movie) &key (Frames-Per-Second *frames-per-second*))
  (multiple-value-bind (start-time duration)
                       (get-movie-active-segment my-movie)
    (let* ((Start-Frame (time-to-frame my-movie start-time :frames-per-second frames-per-second))
           (End-Frame (+ start-frame (time-to-frame duration my-movie :frames-per-second frames-per-second))))
      (values start-frame end-frame))))
  
(defmethod SET-MOVIE-ACTIVE-SEGMENT-IN-FRAMES ((My-Movie movie) Start-Frame End-Frame &key (Frames-Per-Second *frames-per-second*))
  (let* ((Start-Time (frame-to-time my-movie start-frame :frames-per-second frames-per-second))
         (Duration (frame-to-time my-movie (- end-frame start-frame) :frames-per-second frames-per-second)))
    (set-movie-active-segment my-movie start-time duration)))
  
(defmethod FRAME-FORWARD-MOVIE ((Movie movie) &optional (Increment 1) &key (Frames-Per-Second *frames-per-second*))
  (with-slots (mptr) movie
    (let* ((Time-Scale (#_GetMovieTimeScale mptr))
           (Time 0)
           (Time-Record (create-time-record time time-scale)))
      (#_GetMovieTime mptr time-record)
      (let ((New-Time (+ (rref time-record :timerecord.value.lo)
                         (* increment (/ time-scale frames-per-second)))))
        (rset time-record :timerecord.value.lo new-time)
        (#_SetMovieTime mptr time-record)
        (dispose-record time-record)
        new-time))))

(defmethod FRAME-REVERSE-MOVIE ((Movie movie) &optional (Increment -1) &key (Frames-Per-Second *frames-per-second*))
  (frame-forward-movie movie increment :frames-per-second frames-per-second))


;;;-----------------------------------------------------------------------------
;;; 
;;;  Frame-Based Functions For Movie Posters and Previews
;;; 
;;;-----------------------------------------------------------------------------

(defmethod GET-MOVIE-POSTER-TIME-IN-FRAMES ((My-Movie movie) &key (Frames-Per-Second *frames-per-second*))
  (time-to-frame my-movie (get-movie-poster-time my-movie) :frames-per-second frames-per-second))

(defmethod SET-MOVIE-POSTER-TIME-IN-FRAMES ((My-Movie movie) Frame &key (Frames-Per-Second *frames-per-second*))
  (set-movie-poster-time my-movie (frame-to-time my-movie frame :frames-per-second frames-per-second)))

(defmethod GET-MOVIE-PREVIEW-TIME-IN-FRAMES ((My-Movie movie) &key (Frames-Per-Second *frames-per-second*))
  (multiple-value-bind (preview-time preview-duration)
                       (get-movie-preview-time my-movie)
    (let* ((Start-Frame (time-to-frame my-movie preview-time :frames-per-second frames-per-second))
           (End-Frame (+ start-frame (time-to-frame my-movie preview-duration :frames-per-second frames-per-second))))
      (values start-frame end-frame))))

(defmethod SET-MOVIE-PREVIEW-TIME-IN-FRAMES ((My-Movie movie) Start-Frame End-Frame &key (Frames-Per-Second *frames-per-second*))
  (let* ((Preview-Time (frame-to-time my-movie start-frame :frames-per-second frames-per-second))
         (Preview-Duration (frame-to-time my-movie (- end-frame start-frame) :frames-per-second frames-per-second)))
    (set-movie-preview-time my-movie preview-time preview-duration)))


;;;-----------------------------------------------------------------------------
;;; 
;;; Frame-Based Functions For Generating QuickDraw Pictures From Movies
;;; 
;;;-----------------------------------------------------------------------------

(defmethod GET-MOVIE-PICT-IN-FRAMES ((My-Movie movie) Frame &key (Frames-Per-Second *frames-per-second*))
  (get-movie-pict my-movie (frame-to-time my-movie frame :frames-per-second frames-per-second)))


;;;-----------------------------------------------------------------------------
;;; 
;;; Frame-Based Functions For Editing Movies
;;; 
;;;-----------------------------------------------------------------------------

(defmethod GET-MOVIE-SELECTION-IN-FRAMES ((My-Movie movie) &key (Frames-Per-Second *frames-per-second*))
  (multiple-value-bind (start-time duration)
                       (get-movie-selection my-movie)
    (let* ((Start-Frame (time-to-frame my-movie start-time :frames-per-second frames-per-second))
           (End-Frame (+ start-frame (time-to-frame my-movie duration :frames-per-second frames-per-second))))
      (values start-frame end-frame))))
 
(defmethod SET-MOVIE-SELECTION-IN-FRAMES ((My-Movie movie)
                                          Start-Frame
                                          End-Frame
                                          &key (Frames-Per-Second *frames-per-second*))
  (let* ((Start-Time (frame-to-time my-movie start-frame :frames-per-second frames-per-second))
         (Duration (frame-to-time my-movie (- end-frame start-frame) :frames-per-second frames-per-second)))
    (set-movie-selection my-movie start-time duration)))


(defmethod PASTE-SPECIFIED-SELECTION-IN-FRAMES ((Source-Movie movie)
                                                Source-Start-Frame
                                                Source-End-Frame
                                                (Destination-Movie movie)
                                                &key (Frames-Per-Second *frames-per-second*))
  (set-movie-selection-in-frames source-movie
                                 source-start-frame
                                 source-end-frame
                                 :frames-per-second frames-per-second)
  (paste-movie-selection source-movie
                         destination-movie))


;;;-----------------------------------------------------------------------------
;;; 
;;; Frame-Based Functions For Low-Level Movie Editing
;;; 
;;;-----------------------------------------------------------------------------

(defmethod DELETE-MOVIE-SEGMENT-IN-FRAMES ((My-Movie movie)
                                           Start-Frame
                                           End-Frame
                                           &key (Frames-Per-Second *frames-per-second*))
  (let* ((Start-Time (frame-to-time my-movie start-frame :frames-per-second frames-per-second))
         (Duration (frame-to-time my-movie (- end-frame start-frame) :frames-per-second frames-per-second)))
    (delete-movie-segment my-movie start-time duration)))

(defmethod INSERT-EMPTY-MOVIE-SEGMENT-IN-FRAMES ((My-Movie movie)
                                       Start-Frame
                                       End-Frame
                                       &key (Frames-Per-Second *frames-per-second*))
  "Inserts empty space into a movie -- but cannot do this at the end of a movie"
  (let* ((Start-Time (frame-to-time my-movie start-frame :frames-per-second frames-per-second))
         (Duration (frame-to-time my-movie (- end-frame start-frame) :frames-per-second frames-per-second)))
    (insert-empty-movie-segment my-movie start-time duration)))


(defmethod INSERT-MOVIE-SEGMENT-IN-FRAMES ((My-Source-Movie movie) (My-Destination-Movie movie) 
                                           &key
                                           Source-Movie-Segment-Start-Frame
                                           Source-Movie-Segment-End-Frame 
                                           Destination-Movie-Insert-Start-Frame
                                           (Frames-Per-Second *frames-per-second*))
  (let* ((Source-In-Time-Value (frame-to-time my-source-movie source-movie-segment-start-frame :frames-per-second frames-per-second))
         (Source-Duration (frame-to-time my-source-movie (- source-movie-segment-end-frame source-movie-segment-start-frame) :frames-per-second frames-per-second))
         (Destination-In-Time-Value (frame-to-time my-destination-movie destination-movie-insert-start-frame :frames-per-second frames-per-second)))
    (insert-movie-segment my-source-movie my-destination-movie 
                          :source-movie-segment-start-time source-in-time-value
                          :source-movie-segment-duration source-duration
                          :destination-movie-insert-start-time destination-in-time-value)))

(defmethod SCALE-MOVIE-SEGMENT-IN-FRAMES ((My-Movie movie) 
                                          Start-Frame
                                          Old-End-Frame 
                                          New-End-Frame
                                          &key (Frames-Per-Second *frames-per-second*))
  (let* ((Start-Time (frame-to-time my-movie start-frame :frames-per-second frames-per-second))
         (Old-Duration (frame-to-time my-movie (- old-end-frame start-frame) :frames-per-second frames-per-second))
         (New-Duration (frame-to-time my-movie (- new-end-frame start-frame) :frames-per-second frames-per-second)))
    (scale-movie-segment my-movie start-time old-duration new-duration)))


;;;-----------------------------------------------------------------------------
;;; 
;;; Frame-Based Functions For Working With Movie Time
;;; 
;;;-----------------------------------------------------------------------------

(defmethod GET-MOVIE-DURATION-IN-FRAMES ((My-Movie movie) &key (Frames-Per-Second *frames-per-second*))
  (time-to-frame my-movie (get-movie-duration my-movie) :frames-per-second frames-per-second))

(defmethod GET-MOVIE-TIME-IN-FRAMES ((My-Movie movie) &key (Frames-Per-Second *frames-per-second*))
  (time-to-frame my-movie (get-movie-time my-movie) :frames-per-second frames-per-second))

(defmethod GET-MOVIE-FRAME ((My-Movie movie) &key (Frames-Per-Second *frames-per-second*))
  (get-movie-time-in-frames my-movie :frames-per-second frames-per-second))

(defmethod SET-MOVIE-TIME-IN-FRAMES ((My-Movie movie) Frame &optional Time-Scale &key (Frames-Per-Second *frames-per-second*))
  (let* ((Time-Scale (if time-scale time-scale (get-movie-time-scale my-movie)))
         (Time (frame-to-time my-movie frame :frames-per-second frames-per-second)))
    (set-movie-time my-movie time time-scale)))

(defmethod SET-MOVIE-FRAME ((My-Movie movie) Frame &key (Frames-Per-Second *frames-per-second*))
  (set-movie-time-value-in-frames my-movie frame :frames-per-second frames-per-second))

(defmethod SET-MOVIE-TIME-VALUE-IN-FRAMES ((My-Movie movie) Frame &key (Frames-Per-Second *frames-per-second*))
  (set-movie-time-value my-movie (frame-to-time my-movie frame :frames-per-second frames-per-second)))



;;;-----------------------------------------------------------------------------
;;; 
;;; TEST CODE
;;; 
;;;-----------------------------------------------------------------------------

(defun MOVIE-TEST (&key (Show-Controller t))
  (make-instance 'movie-window
    :movie (make-instance 'movie)
    :show-controller show-controller))

;;; Show multiple movies.  Use the interface designer to move and scale...
(defun CLIP-LIBRARY (Paths)
  (let ((Window (make-instance 'dialog
                  :window-title "Clip Library"
                  :view-size #@(400 400))))
    (dolist (Path (directory paths))
      (make-instance 'movie-dialog-item
        :movie (make-instance 'movie :file path)
        :view-container window))))

(defun PLAY-ALL (Clip-Library-Window)
  (dolist (V (coerce (view-subviews clip-library-window) 'list))
    (when (typep v 'movie-view)
      (rewind-movie (slot-value v 'movie))
      (play-movie (slot-value v 'movie)))))


;;;-----------------------------------------------------------------------------
;;; 
;;; START QUICKTIME
;;; 
;;;-----------------------------------------------------------------------------

(initialize-quicktime)

;;;-----------------------------------------------------------------------------
(export
 '(
   $QT-HIDDEN-CONST
   $QT-HIDE-H-OFFSET
   *CONTROLLER-CREATION-FLAGS*
   *CONTROLLER-HEIGHT*
   *FRAMES-PER-SECOND*
   *MIN-MAC-HEAP-SIZE*
   *QT-INITIALIZED?*
   *QT-VIEWS*
   *SIGNAL-ERROR-IF-NO-QUICKTIME*
   ADD-MOVIE-RESOURCE
   ADD-MOVIE-RESOURCE-TO-FSSPEC
   ADD-MOVIE-SELECTION
   CAN-LOAD-MOVIE-INTO-RAM-P
   CHOOSE-MOVIE-DIALOG
   CLEAR-MOVIE-CHANGED
   CLEAR-MOVIE-SELECTION
   CLIP-LIBRARY
   CLOSE-MOVIE-FILE
   CONTROLLER
   CONTROLLER-BOX
   CONTROLLER-CREATION-FLAGS-VALUE
   CONTROLLER-VISIBLE-P
   COPY-MOVIE-SELECTION
   COPY-MOVIE-SETTINGS
   CREATE-MOVIE-FILE
   CREATE-MOVIE-FILE-FROM-FSSPEC
   CREATE-TIME-RECORD
   CUT-MOVIE-SELECTION
   DEFAULT-STOP-FUNCTION
   DELETE-MOVIE-SEGMENT
   DELETE-MOVIE-SEGMENT-IN-FRAMES
   DELETE-MOVIE-VIEW-ANCESTOR
   DISPOSE-CURRENT-MOVIE
   DISPOSE-MOVIE
   ENABLE-EDITING
   ENABLE-EDITING-P
   END-QUICKTIME
   ENHANCE-MOVIE-PLAYBACK
   ERRCHECK-MOVIE
   FAST-FORWARD-MOVIE
   FAST-REWIND-MOVIE
   FILE-RESREFNUM
   FIND-MCL-ITEM-UNDER-MOUSE
   FIND-MOVIE-WINDOID
   FLATTEN-MOVIE
   FLATTEN-MOVIE-FSSPEC
   FRAME-FORWARD-MOVIE
   FRAME-REVERSE-MOVIE
   FRAME-TO-SMPTE-TIME-STRING
   FRAME-TO-TIME
   FSSPEC-EXISTS-P
   GET-MOVIE-ACTIVE
   GET-MOVIE-ACTIVE-SEGMENT
   GET-MOVIE-ACTIVE-SEGMENT-IN-FRAMES
   GET-MOVIE-BOX
   GET-MOVIE-CREATION-TIME
   GET-MOVIE-DATA-SIZE
   GET-MOVIE-DURATION
   GET-MOVIE-DURATION-IN-FRAMES
   GET-MOVIE-FRAME
   GET-MOVIE-FROM-FILE
   GET-MOVIE-FROM-FSSPEC
   GET-MOVIE-MODIFICATION-TIME
   GET-MOVIE-PICT
   GET-MOVIE-PICT-IN-FRAMES
   GET-MOVIE-POSTER-PICT
   GET-MOVIE-POSTER-TIME
   GET-MOVIE-POSTER-TIME-IN-FRAMES
   GET-MOVIE-PREFERRED-RATE
   GET-MOVIE-PREFERRED-VOLUME
   GET-MOVIE-PREVIEW-MODE
   GET-MOVIE-PREVIEW-TIME
   GET-MOVIE-PREVIEW-TIME-IN-FRAMES
   GET-MOVIE-RATE
   GET-MOVIE-SELECTION
   GET-MOVIE-SELECTION-IN-FRAMES
   GET-MOVIE-TIME
   GET-MOVIE-TIME-BASE
   GET-MOVIE-TIME-IN-FRAMES
   GET-MOVIE-TIME-SCALE
   GET-MOVIE-USER-DATA
   GET-MOVIE-VOLUME
   GET-PLAY-MODE
   GET-POSTER-BOX
   GO-TO-BEGINNING-OF-MOVIE
   GO-TO-END-OF-MOVIE
   HANDLE-SET-PURGEABLE
   HANDLE-SET-UNPURGEABLE
   HAS-MOVIE-CHANGED
   HIDE-CONTROLLER
   INITIALIZE-MOVIE-VIEW
   INITIALIZE-QUICKTIME
   INSERT-EMPTY-MOVIE-SEGMENT
   INSERT-EMPTY-MOVIE-SEGMENT-IN-FRAMES
   INSERT-MOVIE-SEGMENT
   INSERT-MOVIE-SEGMENT-IN-FRAMES
   IS-HIDDEN-P
   IS-MOVIE-DONE
   LAST-EDIT
   MCAction-Filter
   MOOV-SCRAP-HANDLER
   MOVIE
   MOVIE-BOUNDS
   MOVIE-BOX
   MOVIE-DIALOG-ITEM
   MOVIE-FSSPEC-FROM-PATH
   MOVIE-FSSPEC-FROM-USER
   MOVIE-FSSPEC-FROM-USER-WITH-PREVIEW
   MOVIE-SCALING
   MOVIE-SIZE
   MOVIE-TEST
   MOVIE-VIEW
   MOVIE-WINDOID
   MOVIE-WINDOW
   MOVIE-WINDOW-MIXIN
   MPTR
   NEW-MOVIE
   NEW-MOVIE-FROM-FILE
   NEW-MOVIE-FSSPEC
   NEW-MOVIE-PATH
   OPEN-MOVIE-FILE
   PASTE-MOVIE-SELECTION
   PASTE-SPECIFIED-SELECTION
   PASTE-SPECIFIED-SELECTION-IN-FRAMES
   PATH-FROM-MOVIE-FSSPEC
   PLAY-ALL
   PLAY-MOVIE
   PLAY-MOVIE*
   PLAY-MOVIE-BACKWARDS
   PLAY-MOVIE-PREVIEW
   POINT-IN-MOVIE
   POSITION-CONTROLLER
   QT-MODAL-DIALOG
   QUICKTIME-EVENTHOOK
   QUICKTIME-INSTALLED?
   REMOVE-MOVIE-RESOURCE
   REMOVE-MOVIE-RESOURCE-FROM-FSSPEC
   RESID
   REWIND-MOVIE
   SAVE-MOVIE
   SCALE-MOVIE-SEGMENT
   SCALE-MOVIE-SEGMENT-IN-FRAMES
   SCAN-FORWARD
   SCAN-REVERSE
   SET-CONTROLLER-BOX
   SET-MAC-HEAP-SIZE
   SET-MOVIE-ACTIVE
   SET-MOVIE-ACTIVE-SEGMENT
   SET-MOVIE-ACTIVE-SEGMENT-IN-FRAMES
   SET-MOVIE-BOX
   SET-MOVIE-COVER-PROCS
   SET-MOVIE-FRAME
   SET-MOVIE-POSTER-TIME
   SET-MOVIE-POSTER-TIME-IN-FRAMES
   SET-MOVIE-PREFERRED-RATE
   SET-MOVIE-PREFERRED-VOLUME
   SET-MOVIE-PREVIEW-MODE
   SET-MOVIE-PREVIEW-TIME
   SET-MOVIE-PREVIEW-TIME-IN-FRAMES
   SET-MOVIE-PROGRESS-PROC
   SET-MOVIE-RATE
   SET-MOVIE-SELECTION
   SET-MOVIE-SELECTION-IN-FRAMES
   SET-MOVIE-TIME
   SET-MOVIE-TIME-IN-FRAMES
   SET-MOVIE-TIME-SCALE
   SET-MOVIE-TIME-VALUE
   SET-MOVIE-TIME-VALUE-IN-FRAMES
   SET-MOVIE-TO-VIEW
   SET-MOVIE-VOLUME
   SET-PLAY-MODE
   SET-POSTER-BOX
   SETUP-RECT
   SHOW-CONTROLLER
   SHOW-CONTROLLER-P
   SHOW-MOVIE-POSTER
   STAGGER-WINDOWS
   STANDARD-POSITION
   START-MOVIE
   START-QUICKTIME
   STOP-MOVIE
   TIME-TO-FRAME
   UPDATE-FOR-NEW-MOVIE
   UPDATE-MOVIE
   UPDATE-MOVIE-RESOURCE
   UPDATE-MOVIE-RESOURCE-FSSPEC
   VALID-FSSPEC-P
   VIEW-MOVIE
   VIEW-MOVIE-CONTROLLER
   WIND-TO-END-OF-MOVIE
   WITH-RECTANGLE-ARG
   WITH-TEMP-MOVIE   
   )
 )

(provide :qt-objects)


;;;-----------------------------------------------------------------------------
;;; 
;;; Debugging notes
;;; 
;;;-----------------------------------------------------------------------------

;; New and changed functions from qt-objects.lisp v2.0 (Wednesday, 12/9/92)
;; Mods by Michael Korcuska (12/30/92)
;;
;; New Functions:
;;   
;;    create-movie-file-from-fsspec
;;    get-movie-from-fsspec
;;    new-movie-path
;;    add-movie-resource-to-fsspec
;;    remove-movie-resource-from-fsspec
;;    update-movie-resource-fsspec
;;    flatten-movie-fsspec
;;    fsspec-exists-p
;;    valid-fsspec-p
;;
;; The changed functions are essentially those which created fsSpec records
;; and their callers.  It is now the responsibility of the caller to allocate
;; the fsSpec (with rlet in all cases)
;;
;; I've minimally tested all of these functions using movie-test, my own
;; application and individual calls to the resource functions.
;;
;; Comments:
;;   I think there's a problem with the class definitions, but I'm not sure.
;; When you create a movie from a file, the file information is no longer
;; important.  I don't think, therefore, that the file/refnum/id should be
;; part of the movie class.  Instead there should be a class movie-file with
;; that information.  This has many implications and would be a major rewrite,
;; which I certainly don't have time to do.
;;   I noticed the problem when working with the resource functions, which allow
;; me to create a new movie file and add an existing movie to it.  When I do this, 
;; the file info associated with the existing movie gets set to the new file and
;; I have no way of accessing the old file info, which means I can't close it.
;; I don't know if there is a quick fix to this except to comment the resource
;; code in the distribution.  Let me know what you think.
;;
;;  Cheers,    Michael
;;